summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.fossil-settings/crnl-glob19
-rw-r--r--.fossil-settings/ignore-glob1
-rw-r--r--.github/ISSUE_TEMPLATE.md3
-rw-r--r--.github/PULL_REQUEST_TEMPLATE.md3
-rw-r--r--.project2
-rw-r--r--ChangeLog.20072
-rw-r--r--README8
-rw-r--r--changes56
-rw-r--r--compat/float.h14
-rw-r--r--compat/opendir.c2
-rw-r--r--compat/unistd.h76
-rw-r--r--compat/waitpid.c2
-rw-r--r--compat/zlib/contrib/minizip/crypt.h6
-rw-r--r--compat/zlib/contrib/minizip/minizip.c266
-rwxr-xr-xcompat/zlib/contrib/minizip/tinydir.h816
-rw-r--r--[-rwxr-xr-x]compat/zlib/win32/zdll.libbin17152 -> 17152 bytes
-rw-r--r--doc/AddErrInfo.32
-rw-r--r--doc/CallDel.32
-rw-r--r--doc/CmdCmplt.32
-rw-r--r--doc/Concat.32
-rw-r--r--doc/CrtFileHdlr.32
-rw-r--r--doc/CrtInterp.32
-rw-r--r--doc/CrtObjCmd.329
-rw-r--r--doc/CrtTimerHdlr.32
-rw-r--r--doc/DetachPids.32
-rw-r--r--doc/DictObj.32
-rw-r--r--doc/DoWhenIdle.32
-rw-r--r--doc/Environment.32
-rw-r--r--doc/Exit.33
-rw-r--r--doc/ExprLongObj.32
-rw-r--r--doc/FindExec.36
-rw-r--r--doc/GetCwd.32
-rw-r--r--doc/GetIndex.32
-rw-r--r--doc/GetInt.37
-rw-r--r--doc/GetOpnFl.32
-rw-r--r--doc/GetTime.32
-rw-r--r--doc/Hash.32
-rw-r--r--doc/Init.32
-rw-r--r--doc/InitStubs.38
-rw-r--r--doc/IntObj.32
-rw-r--r--doc/Interp.32
-rw-r--r--doc/Limit.32
-rw-r--r--doc/Load.32
-rw-r--r--doc/Method.344
-rw-r--r--doc/NRE.32
-rw-r--r--doc/Namespace.34
-rw-r--r--doc/OpenTcp.320
-rw-r--r--doc/Panic.319
-rw-r--r--doc/Preserve.32
-rw-r--r--doc/PrintDbl.32
-rw-r--r--doc/RecEvalObj.34
-rw-r--r--doc/RecordEval.32
-rw-r--r--doc/SaveResult.3107
-rw-r--r--doc/SetErrno.32
-rw-r--r--doc/SetRecLmt.32
-rw-r--r--doc/Signal.32
-rw-r--r--doc/Sleep.32
-rw-r--r--doc/SplitList.32
-rw-r--r--doc/SplitPath.32
-rw-r--r--doc/StaticPkg.35
-rw-r--r--doc/StdChannels.32
-rw-r--r--doc/StrMatch.32
-rw-r--r--doc/StringObj.35
-rw-r--r--doc/SubstObj.32
-rw-r--r--doc/TCL_MEM_DEBUG.34
-rw-r--r--doc/TclZlib.32
-rw-r--r--doc/Tcl_Main.32
-rw-r--r--doc/Thread.312
-rw-r--r--doc/ToUpper.36
-rw-r--r--doc/UniCharIsAlpha.32
-rw-r--r--doc/Utf.322
-rw-r--r--doc/abstract.n77
-rw-r--r--doc/append.n12
-rw-r--r--doc/array.n62
-rw-r--r--doc/break.n2
-rw-r--r--doc/callback.n88
-rw-r--r--doc/case.n2
-rw-r--r--doc/cd.n6
-rw-r--r--doc/classvariable.n78
-rw-r--r--doc/clock.n41
-rw-r--r--doc/close.n2
-rw-r--r--doc/concat.n2
-rw-r--r--doc/continue.n4
-rw-r--r--doc/cookiejar.n217
-rw-r--r--doc/copy.n6
-rw-r--r--doc/coroutine.n2
-rw-r--r--doc/define.n585
-rw-r--r--doc/dict.n35
-rw-r--r--doc/eof.n6
-rw-r--r--doc/eval.n2
-rw-r--r--doc/exit.n6
-rw-r--r--doc/expr.n390
-rw-r--r--doc/fblocked.n6
-rw-r--r--doc/file.n2
-rw-r--r--doc/fileevent.n4
-rw-r--r--doc/filename.n4
-rw-r--r--doc/flush.n6
-rw-r--r--doc/foreach.n6
-rw-r--r--doc/format.n29
-rw-r--r--doc/gets.n2
-rw-r--r--doc/global.n4
-rw-r--r--doc/history.n6
-rw-r--r--doc/http.n115
-rw-r--r--doc/idna.n88
-rw-r--r--doc/if.n2
-rw-r--r--doc/incr.n11
-rw-r--r--doc/info.n313
-rw-r--r--doc/interp.n4
-rw-r--r--doc/join.n6
-rw-r--r--doc/lappend.n12
-rw-r--r--doc/lassign.n2
-rw-r--r--doc/lindex.n2
-rw-r--r--doc/link.n124
-rw-r--r--doc/list.n2
-rw-r--r--doc/llength.n4
-rw-r--r--doc/load.n2
-rw-r--r--doc/lpop.n96
-rw-r--r--doc/lrange.n4
-rw-r--r--doc/lrepeat.n7
-rw-r--r--doc/lreverse.n2
-rw-r--r--doc/lsearch.n20
-rw-r--r--doc/msgcat.n205
-rw-r--r--doc/my.n93
-rw-r--r--doc/namespace.n2
-rw-r--r--doc/next.n7
-rw-r--r--doc/package.n12
-rw-r--r--doc/packagens.n6
-rw-r--r--doc/pid.n7
-rw-r--r--doc/platform.n4
-rw-r--r--doc/platform_shell.n8
-rw-r--r--doc/prefix.n14
-rw-r--r--doc/process.n150
-rw-r--r--doc/puts.n6
-rw-r--r--doc/pwd.n6
-rw-r--r--doc/re_syntax.n6
-rw-r--r--doc/refchan.n2
-rw-r--r--doc/registry.n2
-rw-r--r--doc/regsub.n74
-rw-r--r--doc/rename.n6
-rw-r--r--doc/seek.n2
-rw-r--r--doc/self.n7
-rw-r--r--doc/set.n4
-rw-r--r--doc/singleton.n99
-rw-r--r--doc/socket.n10
-rw-r--r--doc/source.n6
-rw-r--r--doc/split.n2
-rw-r--r--doc/string.n16
-rw-r--r--doc/switch.n2
-rw-r--r--doc/tailcall.n2
-rw-r--r--doc/tclsh.111
-rw-r--r--doc/tell.n8
-rw-r--r--doc/throw.n2
-rw-r--r--doc/time.n2
-rw-r--r--doc/tm.n2
-rw-r--r--doc/trace.n3
-rw-r--r--doc/unknown.n4
-rw-r--r--doc/update.n4
-rw-r--r--doc/uplevel.n4
-rw-r--r--doc/while.n4
-rw-r--r--doc/zipfs.3120
-rw-r--r--doc/zipfs.n255
-rw-r--r--generic/regc_lex.c6
-rw-r--r--generic/regc_locale.c2
-rw-r--r--generic/regc_nfa.c4
-rw-r--r--generic/regcomp.c12
-rw-r--r--generic/regcustom.h9
-rw-r--r--generic/regexec.c4
-rw-r--r--generic/regguts.h35
-rw-r--r--generic/tcl.decls255
-rw-r--r--generic/tcl.h404
-rw-r--r--generic/tclAlloc.c48
-rw-r--r--generic/tclAssembly.c92
-rw-r--r--generic/tclBasic.c753
-rw-r--r--generic/tclBinary.c404
-rw-r--r--generic/tclCkalloc.c98
-rw-r--r--generic/tclClock.c26
-rw-r--r--generic/tclCmdAH.c341
-rw-r--r--generic/tclCmdIL.c536
-rw-r--r--generic/tclCmdMZ.c787
-rw-r--r--generic/tclCompCmds.c12
-rw-r--r--generic/tclCompCmdsGR.c78
-rw-r--r--generic/tclCompCmdsSZ.c118
-rw-r--r--generic/tclCompExpr.c31
-rw-r--r--generic/tclCompile.c200
-rw-r--r--generic/tclCompile.h62
-rw-r--r--generic/tclConfig.c8
-rw-r--r--generic/tclDate.c1898
-rw-r--r--generic/tclDecls.h567
-rw-r--r--generic/tclDictObj.c290
-rw-r--r--generic/tclDisassemble.c116
-rw-r--r--generic/tclEncoding.c130
-rw-r--r--generic/tclEnsemble.c192
-rw-r--r--generic/tclEvent.c17
-rw-r--r--generic/tclExecute.c1611
-rw-r--r--generic/tclFCmd.c10
-rw-r--r--generic/tclFileName.c34
-rw-r--r--generic/tclGet.c2
-rw-r--r--generic/tclGetDate.y4
-rw-r--r--generic/tclHash.c66
-rw-r--r--generic/tclHistory.c5
-rw-r--r--generic/tclIO.c855
-rw-r--r--generic/tclIO.h4
-rw-r--r--generic/tclIOCmd.c157
-rw-r--r--generic/tclIOGT.c17
-rw-r--r--generic/tclIORChan.c145
-rw-r--r--generic/tclIORTrans.c93
-rw-r--r--generic/tclIOSock.c99
-rw-r--r--generic/tclIOUtil.c166
-rw-r--r--generic/tclIndexObj.c82
-rw-r--r--generic/tclInt.decls106
-rw-r--r--generic/tclInt.h564
-rw-r--r--generic/tclIntDecls.h308
-rw-r--r--generic/tclIntPlatDecls.h28
-rw-r--r--generic/tclInterp.c183
-rw-r--r--generic/tclLink.c42
-rw-r--r--generic/tclListObj.c953
-rw-r--r--generic/tclLiteral.c46
-rw-r--r--generic/tclLoad.c70
-rw-r--r--generic/tclMain.c29
-rw-r--r--generic/tclNamesp.c97
-rw-r--r--generic/tclOO.c594
-rw-r--r--generic/tclOO.decls7
-rw-r--r--generic/tclOO.h11
-rw-r--r--generic/tclOOBasic.c132
-rw-r--r--generic/tclOOCall.c969
-rw-r--r--generic/tclOODecls.h13
-rw-r--r--generic/tclOODefineCmds.c768
-rw-r--r--generic/tclOOInfo.c244
-rw-r--r--generic/tclOOInt.h97
-rw-r--r--generic/tclOOMethod.c104
-rw-r--r--generic/tclOOScript.h263
-rw-r--r--generic/tclOOScript.tcl456
-rw-r--r--generic/tclOOStubInit.c1
-rw-r--r--generic/tclObj.c1021
-rw-r--r--generic/tclOptimize.c4
-rw-r--r--generic/tclPanic.c5
-rw-r--r--generic/tclParse.c218
-rw-r--r--generic/tclParse.h2
-rw-r--r--generic/tclPathObj.c305
-rw-r--r--generic/tclPipe.c80
-rw-r--r--generic/tclPkg.c181
-rw-r--r--generic/tclPkgConfig.c4
-rw-r--r--generic/tclPort.h18
-rw-r--r--generic/tclPreserve.c10
-rw-r--r--generic/tclProc.c304
-rw-r--r--generic/tclProcess.c957
-rw-r--r--generic/tclRegexp.c68
-rw-r--r--generic/tclRegexp.h2
-rw-r--r--generic/tclResult.c76
-rw-r--r--generic/tclScan.c63
-rw-r--r--generic/tclStrToD.c132
-rw-r--r--generic/tclStringObj.c1541
-rw-r--r--generic/tclStringRep.h13
-rw-r--r--generic/tclStubInit.c313
-rw-r--r--generic/tclStubLib.c36
-rw-r--r--generic/tclTest.c997
-rw-r--r--generic/tclTestObj.c40
-rw-r--r--generic/tclThread.c35
-rw-r--r--generic/tclThreadAlloc.c47
-rw-r--r--generic/tclThreadStorage.c2
-rw-r--r--generic/tclThreadTest.c12
-rw-r--r--generic/tclTimer.c48
-rw-r--r--generic/tclTomMath.decls37
-rw-r--r--generic/tclTomMathDecls.h72
-rw-r--r--generic/tclTomMathInterface.c166
-rw-r--r--generic/tclTrace.c18
-rw-r--r--generic/tclUtf.c299
-rw-r--r--generic/tclUtil.c635
-rw-r--r--generic/tclVar.c1520
-rw-r--r--generic/tclZipfs.c5041
-rw-r--r--generic/tclZlib.c78
-rw-r--r--library/auto.tcl51
-rw-r--r--library/http/cookiejar.tcl745
-rw-r--r--library/http/effective_tld_names.txt.gzbin0 -> 39188 bytes
-rw-r--r--library/http/http.tcl121
-rw-r--r--library/http/idna.tcl292
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/http1.0/http.tcl377
-rw-r--r--library/http1.0/pkgIndex.tcl11
-rw-r--r--library/init.tcl69
-rw-r--r--library/install.tcl244
-rw-r--r--library/manifest.txt18
-rw-r--r--library/msgcat/msgcat.tcl314
-rw-r--r--library/msgcat/pkgIndex.tcl4
-rw-r--r--library/msgs/ar.msg84
-rw-r--r--library/msgs/ar_jo.msg62
-rw-r--r--library/msgs/ar_lb.msg62
-rw-r--r--library/msgs/ar_sy.msg62
-rw-r--r--library/msgs/be.msg80
-rw-r--r--library/msgs/bg.msg56
-rw-r--r--library/msgs/bn.msg80
-rw-r--r--library/msgs/ca.msg4
-rw-r--r--library/msgs/cs.msg34
-rw-r--r--library/msgs/da.msg8
-rw-r--r--library/msgs/de.msg2
-rw-r--r--library/msgs/de_at.msg8
-rw-r--r--library/msgs/de_be.msg4
-rw-r--r--library/msgs/el.msg80
-rw-r--r--library/msgs/eo.msg10
-rw-r--r--library/msgs/es.msg8
-rw-r--r--library/msgs/et.msg16
-rw-r--r--library/msgs/fa.msg76
-rw-r--r--library/msgs/fa_in.msg80
-rw-r--r--library/msgs/fa_ir.msg8
-rw-r--r--library/msgs/fi.msg8
-rw-r--r--library/msgs/fo.msg18
-rw-r--r--library/msgs/fr.msg12
-rw-r--r--library/msgs/ga.msg50
-rw-r--r--library/msgs/gl.msg12
-rw-r--r--library/msgs/he.msg80
-rw-r--r--library/msgs/hi.msg64
-rw-r--r--library/msgs/hr.msg12
-rw-r--r--library/msgs/hu.msg34
-rw-r--r--library/msgs/is.msg44
-rw-r--r--library/msgs/it.msg10
-rw-r--r--library/msgs/ja.msg68
-rw-r--r--library/msgs/ko.msg86
-rw-r--r--library/msgs/ko_kr.msg4
-rw-r--r--library/msgs/kok.msg66
-rw-r--r--library/msgs/lt.msg20
-rw-r--r--library/msgs/lv.msg22
-rw-r--r--library/msgs/mk.msg80
-rw-r--r--library/msgs/mr.msg62
-rw-r--r--library/msgs/mt.msg8
-rw-r--r--library/msgs/nb.msg8
-rw-r--r--library/msgs/nn.msg4
-rw-r--r--library/msgs/pl.msg22
-rw-r--r--library/msgs/pt.msg8
-rw-r--r--library/msgs/ro.msg8
-rw-r--r--library/msgs/ru.msg80
-rw-r--r--library/msgs/sh.msg4
-rw-r--r--library/msgs/sk.msg26
-rw-r--r--library/msgs/sl.msg6
-rw-r--r--library/msgs/sq.msg16
-rw-r--r--library/msgs/sr.msg80
-rw-r--r--library/msgs/sv.msg12
-rw-r--r--library/msgs/ta.msg66
-rw-r--r--library/msgs/te.msg76
-rw-r--r--library/msgs/te_in.msg4
-rw-r--r--library/msgs/th.msg84
-rw-r--r--library/msgs/tr.msg24
-rw-r--r--library/msgs/uk.msg80
-rw-r--r--library/msgs/vi.msg38
-rw-r--r--library/msgs/zh.msg92
-rw-r--r--library/msgs/zh_cn.msg2
-rw-r--r--library/msgs/zh_hk.msg42
-rw-r--r--library/msgs/zh_sg.msg4
-rw-r--r--library/msgs/zh_tw.msg4
-rw-r--r--library/opt/optparse.tcl4
-rw-r--r--library/opt/pkgIndex.tcl4
-rw-r--r--library/package.tcl20
-rw-r--r--library/safe.tcl47
-rw-r--r--library/tclIndex132
-rw-r--r--library/word.tcl24
-rw-r--r--libtommath/astylerc27
-rw-r--r--libtommath/bn_mp_get_long_long.c6
-rw-r--r--libtommath/tommath.h2
-rw-r--r--macosx/GNUmakefile4
-rw-r--r--macosx/README6
-rw-r--r--macosx/Tcl-Common.xcconfig6
-rw-r--r--macosx/Tcl.xcode/project.pbxproj19
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj22
-rw-r--r--macosx/configure.ac2
-rw-r--r--macosx/tclMacOSXFCmd.c44
-rw-r--r--macosx/tclMacOSXNotify.c110
-rw-r--r--tests/README6
-rw-r--r--tests/apply.test2
-rw-r--r--tests/assemble.test89
-rw-r--r--tests/assemble1.bench19
-rw-r--r--tests/async.test7
-rw-r--r--tests/autoMkindex.test2
-rw-r--r--tests/basic.test32
-rw-r--r--tests/binary.test60
-rw-r--r--tests/case.test5
-rw-r--r--tests/chan.test4
-rw-r--r--tests/chanio.test54
-rw-r--r--tests/cmdIL.test21
-rw-r--r--tests/cmdMZ.test2
-rw-r--r--tests/compExpr-old.test37
-rw-r--r--tests/compExpr.test12
-rw-r--r--tests/compile.test23
-rw-r--r--tests/config.test2
-rw-r--r--tests/coroutine.test8
-rw-r--r--tests/dict.test14
-rw-r--r--tests/encoding.test54
-rw-r--r--tests/env.test6
-rw-r--r--tests/event.test6
-rw-r--r--tests/exec.test5
-rw-r--r--tests/execute.test22
-rw-r--r--tests/expr-old.test66
-rw-r--r--tests/expr.test91
-rw-r--r--tests/fCmd.test16
-rw-r--r--tests/fileSystem.test4
-rw-r--r--tests/for.test78
-rw-r--r--tests/format.test86
-rw-r--r--tests/get.test26
-rw-r--r--tests/history.test2
-rw-r--r--tests/http.test459
-rw-r--r--tests/httpcookie.test876
-rw-r--r--tests/httpd9
-rw-r--r--tests/httpold.test300
-rw-r--r--tests/incr.test12
-rw-r--r--tests/indexObj.test2
-rw-r--r--tests/info.test198
-rw-r--r--tests/init.test10
-rw-r--r--tests/interp.test56
-rw-r--r--tests/io.test82
-rw-r--r--tests/ioCmd.test6
-rw-r--r--tests/ioTrans.test2
-rw-r--r--tests/iogt.test2
-rw-r--r--tests/lindex.test4
-rw-r--r--tests/link.test21
-rw-r--r--tests/lmap.test6
-rw-r--r--tests/lpop.test140
-rw-r--r--tests/lrange.test104
-rw-r--r--tests/lrepeat.test4
-rw-r--r--tests/lsearch.test166
-rw-r--r--tests/lsetComp.test506
-rw-r--r--tests/main.test4
-rw-r--r--tests/mathop.test30
-rw-r--r--tests/misc.test4
-rw-r--r--tests/msgcat.test300
-rw-r--r--tests/namespace.test34
-rw-r--r--tests/nre.test6
-rw-r--r--tests/obj.test71
-rw-r--r--tests/oo.test1372
-rw-r--r--tests/ooUtil.test563
-rw-r--r--tests/package.test177
-rw-r--r--tests/parse.test2
-rw-r--r--tests/parseExpr.test9
-rw-r--r--tests/pkgIndex.tcl2
-rw-r--r--tests/pkgMkIndex.test2
-rw-r--r--tests/platform.test20
-rw-r--r--tests/proc.test6
-rw-r--r--tests/process.test338
-rw-r--r--tests/reg.test6
-rw-r--r--tests/regexp.test77
-rw-r--r--tests/regexpComp.test14
-rw-r--r--tests/result.test4
-rw-r--r--tests/safe.test14
-rw-r--r--tests/scan.test14
-rw-r--r--tests/set-old.test6
-rw-r--r--tests/set.test2
-rw-r--r--tests/socket.test1101
-rw-r--r--tests/source.test11
-rw-r--r--tests/split.test2
-rw-r--r--tests/stack.test2
-rw-r--r--tests/string.test2683
-rw-r--r--tests/stringComp.test801
-rw-r--r--tests/stringObj.test9
-rw-r--r--tests/subst.test14
-rw-r--r--tests/tailcall.test12
-rw-r--r--tests/tcltests.tcl2
-rw-r--r--tests/thread.test7
-rw-r--r--tests/trace.test60
-rw-r--r--tests/unixFCmd.test14
-rw-r--r--tests/unixForkEvent.test2
-rw-r--r--tests/unixInit.test17
-rw-r--r--tests/unixNotfy.test13
-rw-r--r--tests/unknown.test2
-rw-r--r--tests/uplevel.test32
-rw-r--r--tests/upvar.test2
-rw-r--r--tests/utf.test63
-rw-r--r--tests/util.test122
-rw-r--r--tests/var.test438
-rw-r--r--tests/winFCmd.test70
-rw-r--r--tests/winFile.test18
-rw-r--r--tests/winPipe.test8
-rw-r--r--tests/zipfs.test284
-rwxr-xr-xtools/configure2949
-rw-r--r--tools/configure.ac (renamed from tools/configure.in)4
-rwxr-xr-x[-rw-r--r--]tools/encoding/ebcdic.txt0
-rwxr-xr-x[-rw-r--r--]tools/encoding/tis-620.txt0
-rwxr-xr-xtools/fix_tommath_h.tcl11
-rw-r--r--tools/installVfs.tcl54
-rwxr-xr-xtools/loadICU.tcl3
-rw-r--r--tools/makeHeader.tcl182
-rw-r--r--tools/mkVfs.tcl99
-rw-r--r--tools/tcl.hpj.in4
-rw-r--r--tools/tcltk-man2html-utils.tcl9
-rwxr-xr-xtools/tcltk-man2html.tcl11
-rw-r--r--tools/tsdPerf.c10
-rw-r--r--unix/Makefile.in701
-rw-r--r--unix/README2
-rwxr-xr-xunix/configure18943
-rw-r--r--unix/configure.ac (renamed from unix/configure.in)151
-rw-r--r--unix/dltest/pkga.c12
-rw-r--r--unix/dltest/pkgc.c16
-rw-r--r--unix/dltest/pkgd.c16
-rw-r--r--unix/dltest/pkge.c13
-rw-r--r--unix/dltest/pkgooa.c2
-rw-r--r--unix/dltest/pkgua.c29
-rwxr-xr-xunix/installManPage43
-rw-r--r--unix/tcl.m4475
-rw-r--r--unix/tcl.pc.in2
-rw-r--r--unix/tcl.spec2
-rw-r--r--unix/tclAppInit.c2
-rw-r--r--unix/tclConfig.h.in14
-rw-r--r--unix/tclConfig.sh.in8
-rw-r--r--unix/tclEpollNotfy.c835
-rw-r--r--unix/tclKqueueNotfy.c853
-rw-r--r--unix/tclLoadAix.c4
-rw-r--r--unix/tclSelectNotfy.c1114
-rw-r--r--unix/tclUnixChan.c189
-rw-r--r--unix/tclUnixCompat.c20
-rw-r--r--unix/tclUnixFCmd.c46
-rw-r--r--unix/tclUnixFile.c15
-rw-r--r--unix/tclUnixInit.c61
-rw-r--r--unix/tclUnixNotfy.c1390
-rw-r--r--unix/tclUnixPipe.c8
-rw-r--r--unix/tclUnixPort.h38
-rw-r--r--unix/tclUnixSock.c123
-rw-r--r--unix/tclUnixTest.c51
-rw-r--r--unix/tclUnixThrd.c306
-rw-r--r--unix/tclUnixThrd.h19
-rw-r--r--unix/tclUnixTime.c9
-rw-r--r--unix/tclXtNotify.c2
-rw-r--r--unix/tclXtTest.c2
-rw-r--r--unix/tclooConfig.sh2
-rw-r--r--win/Makefile.in250
-rw-r--r--win/README8
-rwxr-xr-x[-rw-r--r--]win/buildall.vc.bat4
-rw-r--r--win/coffbase.txt43
-rwxr-xr-xwin/configure6749
-rw-r--r--win/configure.ac (renamed from win/configure.in)62
-rw-r--r--win/makefile.vc50
-rw-r--r--win/nmakehlp.c12
-rw-r--r--win/rules.vc88
-rw-r--r--win/tcl.dsp34
-rw-r--r--win/tcl.hpj.in4
-rw-r--r--win/tcl.m4280
-rw-r--r--win/tcl.rc8
-rw-r--r--win/tclAppInit.c7
-rw-r--r--win/tclConfig.sh.in9
-rw-r--r--win/tclWin32Dll.c92
-rw-r--r--win/tclWinChan.c159
-rw-r--r--win/tclWinConsole.c12
-rw-r--r--win/tclWinError.c5
-rw-r--r--win/tclWinFCmd.c17
-rw-r--r--[-rwxr-xr-x]win/tclWinFile.c53
-rw-r--r--win/tclWinInit.c100
-rw-r--r--win/tclWinInt.h26
-rw-r--r--win/tclWinLoad.c2
-rw-r--r--win/tclWinNotify.c38
-rw-r--r--win/tclWinPanic.c88
-rw-r--r--win/tclWinPipe.c67
-rw-r--r--win/tclWinPort.h2
-rw-r--r--win/tclWinSerial.c12
-rw-r--r--win/tclWinSock.c751
-rw-r--r--win/tclWinTest.c10
-rw-r--r--win/tclWinThrd.c88
-rw-r--r--win/tclWinTime.c16
-rw-r--r--win/tclooConfig.sh2
-rw-r--r--win/tclsh.rc8
554 files changed, 54060 insertions, 38459 deletions
diff --git a/.fossil-settings/crnl-glob b/.fossil-settings/crnl-glob
deleted file mode 100644
index 56f3a03..0000000
--- a/.fossil-settings/crnl-glob
+++ /dev/null
@@ -1,19 +0,0 @@
-compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
-compat/zlib/contrib/vstudio/readme.txt
-compat/zlib/contrib/vstudio/*/zlib.rc
-compat/zlib/win32/*.txt
-compat/zlib/win64/*.txt
-libtommath/*.dsp
-libtommath/*.sln
-libtommath/*.vcproj
-tools/tcl.hpj.in
-tools/tcl.wse.in
-win/buildall.vc.bat
-win/coffbase.txt
-win/makefile.vc
-win/rules.vc
-win/rules-ext.vc
-win/targets.vc
-win/tcl.dsp
-win/tcl.dsw
-win/tcl.hpj.in \ No newline at end of file
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
index c85b488..08e405d 100644
--- a/.fossil-settings/ignore-glob
+++ b/.fossil-settings/ignore-glob
@@ -44,5 +44,6 @@ unix/pkgs/*
win/Debug*
win/Release*
win/pkgs/*
+win/coffbase.txt
win/tcl.hpj
win/nmhlp-out.txt
diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md
new file mode 100644
index 0000000..22d3860
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE.md
@@ -0,0 +1,3 @@
+Important Note
+==========
+Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md
new file mode 100644
index 0000000..da07cd2
--- /dev/null
+++ b/.github/PULL_REQUEST_TEMPLATE.md
@@ -0,0 +1,3 @@
+Important Note
+==========
+Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
diff --git a/.project b/.project
index 358cc74..eddd834 100644
--- a/.project
+++ b/.project
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
- <name>tcl8.6</name>
+ <name>tcl8</name>
<comment></comment>
<projects>
</projects>
diff --git a/ChangeLog.2007 b/ChangeLog.2007
index 5995956..34725e3 100644
--- a/ChangeLog.2007
+++ b/ChangeLog.2007
@@ -1426,7 +1426,7 @@
initialization assumptions of the TIP 280 code in CompileWord().
* generic/tclCompExpr.c: Suppress the attempt to convert to
- numeric when pre-compiling a constant expresion indicates an error.
+ numeric when pre-compiling a constant expression indicates an error.
2007-08-22 Miguel Sofer <msofer@users.sf.net>
diff --git a/README b/README
index dae0dda..30c6076 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
README: Tcl
- This is the Tcl 8.6.9 source distribution.
+ This is the Tcl 8.7a2 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
@@ -49,7 +49,7 @@ and selling it either in whole or in part. See the file
Extensive documentation is available at our website.
The home page for this release, including new features, is
- http://www.tcl-lang.org/software/tcltk/8.6.html
+ http://www.tcl-lang.org/software/tcltk/8.7.html
Detailed release notes can be found at the file distributions page
by clicking on the relevant version.
@@ -61,9 +61,9 @@ Information about Tcl itself can be found at
There have been many Tcl books on the market. Many are mentioned in the Wiki:
http://wiki.tcl-lang.org/_/ref?N=25206
-To view the complete set of reference manual entries for Tcl 8.6 online,
+To view the complete set of reference manual entries for Tcl 8.7 online,
visit the URL:
- http://www.tcl-lang.org/man/tcl8.6/
+ http://www.tcl-lang.org/man/tcl8.7/
2a. Unix Documentation
----------------------
diff --git a/changes b/changes
index eb18c72..f8a8f96 100644
--- a/changes
+++ b/changes
@@ -8894,3 +8894,59 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2018-11-16 (bug)[00d04c] Repair [binary encode base64] (sebres)
- Released 8.6.9, November 16, 2018 - details at http://core.tcl-lang.org/tcl/ -
+
+Changes to 8.7a1 include all changes to the 8.6 line through 8.6.7,
+plus the following, which focuses on the high-level feature changes
+in this changeset (new minor version) rather than bug fixes:
+
+2016-03-17 (bug)[0b8c38] socket accept callbacks always in global ns (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-07-01 Hack accommodations for legacy Itcl 3 disabled (porter)
+
+2016-07-12 Make TCL_HASH_TYPE build-time configurable (nijtmans)
+
+2016-07-19 (bug)[0363f0] Partial array search ID reform (porter)
+
+2016-07-19 (feature removed) Tcl_ObjType "array search" unregistered (porter)
+ *** POTENTIAL INCOMPATIBILITY for Tcl_GetObjType("array search") ***
+
+2016-10-04 Server socket on port 0 chooses port supporting IPv4 * IPv6 (max)
+
+2016-11-25 [array names -regexp] supports backrefs (goth)
+
+2017-01-04 (TIP 456) New routine Tcl_OpenTcpServerEx() (limeboy)
+
+2017-01-04 (TIP 459) New subcommand [package files] (nijtmans)
+
+2017-01-16 threaded allocator initialization repair (vasiljevic,nijtmans)
+
+2017-01-30 Add to Win shell builtins: assoc ftype move (ashok)
+
+2017-03-31 TCL_MEM_DEBUG facilities better support 64-bit memory (nijtmans)
+
+2017-04-13 \u escaped content in msg files converted to true utf-8 (nijtmans)
+
+2017-05-18 (TIP 458) New epoll or kqueue notifiers are default (alborboz)
+
+2017-05-31 Purge build support for SunOS-4.* (stu)
+
+2017-06-22 (TIP 463) New option [regsub ... -command ...] (fellows)
+
+2017-06-22 (TIP 470) Tcl_GetDefineContextObject();[oo::define [self]] (fellows)
+=> TclOO 1.2.0
+
+2017-06-23 (TIP 472) Support 0d as prefix of decimal numbers (iyer,griffin)
+
+2017-08-31 (bug)[2a9465] http state 100 continue handling broken (oehlmann)
+
+2017-09-02 (bug)[0e4d88] replace command, delete trace kills namespace (porter)
+
+--- Released 8.7a1, September 8, 2017 --- http://core.tcl.tk/tcl/ for details
+
+2018-03-12 (TIP 490) add oo support for msgcat => msgcat 1.7.0 (oehlmann)
+
+2018-03-12 (TIP 499) custom locale preference list (oehlmann)
+=> msgcat 1.7.0
+
+- Released 8.7a3, Nov 30, 2018 --- http://core.tcl-lang.org/tcl/ for details -
diff --git a/compat/float.h b/compat/float.h
deleted file mode 100644
index 411edbf..0000000
--- a/compat/float.h
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * float.h --
- *
- * This is a dummy header file to #include in Tcl when there
- * is no float.h in /usr/include. Right now this file is empty:
- * Tcl contains #ifdefs to deal with the lack of definitions;
- * all it needs is for the #include statement to work.
- *
- * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
diff --git a/compat/opendir.c b/compat/opendir.c
index 22e8a3a..7a49566 100644
--- a/compat/opendir.c
+++ b/compat/opendir.c
@@ -106,5 +106,5 @@ closedir(
close(dirp->dd_fd);
dirp->dd_fd = -1;
dirp->dd_loc = 0;
- ckfree((char *) dirp);
+ ckfree(dirp);
}
diff --git a/compat/unistd.h b/compat/unistd.h
deleted file mode 100644
index a8f14f2..0000000
--- a/compat/unistd.h
+++ /dev/null
@@ -1,76 +0,0 @@
-/*
- * unistd.h --
- *
- * Macros, constants and prototypes for Posix conformance.
- *
- * Copyright 1989 Regents of the University of California Permission to use,
- * copy, modify, and distribute this software and its documentation for any
- * purpose and without fee is hereby granted, provided that the above
- * copyright notice appear in all copies. The University of California makes
- * no representations about the suitability of this software for any purpose.
- * It is provided "as is" without express or implied warranty.
- */
-
-#ifndef _UNISTD
-#define _UNISTD
-
-#include <sys/types.h>
-
-#ifndef NULL
-#define NULL 0
-#endif
-
-/*
- * Strict POSIX stuff goes here. Extensions go down below, in the ifndef
- * _POSIX_SOURCE section.
- */
-
-extern void _exit(int status);
-extern int access(const char *path, int mode);
-extern int chdir(const char *path);
-extern int chown(const char *path, uid_t owner, gid_t group);
-extern int close(int fd);
-extern int dup(int oldfd);
-extern int dup2(int oldfd, int newfd);
-extern int execl(const char *path, ...);
-extern int execle(const char *path, ...);
-extern int execlp(const char *file, ...);
-extern int execv(const char *path, char **argv);
-extern int execve(const char *path, char **argv, char **envp);
-extern int execvpw(const char *file, char **argv);
-extern pid_t fork(void);
-extern char * getcwd(char *buf, size_t size);
-extern gid_t getegid(void);
-extern uid_t geteuid(void);
-extern gid_t getgid(void);
-extern int getgroups(int bufSize, int *buffer);
-extern pid_t getpid(void);
-extern uid_t getuid(void);
-extern int isatty(int fd);
-extern long lseek(int fd, long offset, int whence);
-extern int pipe(int *fildes);
-extern int read(int fd, char *buf, size_t size);
-extern int setgid(gid_t group);
-extern int setuid(uid_t user);
-extern unsigned sleep(unsigned seconds);
-extern char * ttyname(int fd);
-extern int unlink(const char *path);
-extern int write(int fd, const char *buf, size_t size);
-
-#ifndef _POSIX_SOURCE
-extern char * crypt(const char *, const char *);
-extern int fchown(int fd, uid_t owner, gid_t group);
-extern int flock(int fd, int operation);
-extern int ftruncate(int fd, unsigned long length);
-extern int ioctl(int fd, int request, ...);
-extern int readlink(const char *path, char *buf, int bufsize);
-extern int setegid(gid_t group);
-extern int seteuidw(uid_t user);
-extern int setreuid(int ruid, int euid);
-extern int symlink(const char *, const char *);
-extern int ttyslot(void);
-extern int truncate(const char *path, unsigned long length);
-extern int vfork(void);
-#endif /* _POSIX_SOURCE */
-
-#endif /* _UNISTD */
diff --git a/compat/waitpid.c b/compat/waitpid.c
index e03275a..d4473a8 100644
--- a/compat/waitpid.c
+++ b/compat/waitpid.c
@@ -100,7 +100,7 @@ waitpid(
} else {
prevPtr->nextPtr = waitPtr->nextPtr;
}
- ckfree((char *) waitPtr);
+ ckfree(waitPtr);
return result;
}
diff --git a/compat/zlib/contrib/minizip/crypt.h b/compat/zlib/contrib/minizip/crypt.h
index 1e9e820..c422c26 100644
--- a/compat/zlib/contrib/minizip/crypt.h
+++ b/compat/zlib/contrib/minizip/crypt.h
@@ -29,6 +29,12 @@
#define CRC32(c, b) ((*(pcrc_32_tab+(((int)(c) ^ (b)) & 0xff))) ^ ((c) >> 8))
+#ifdef Z_U4
+ typedef Z_U4 z_crc_t;
+#else
+ typedef unsigned long z_crc_t;
+#endif
+
/***********************************************************************
* Return the next byte in the pseudo-random sequence
*/
diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c
index aea6c83..2dd9f10 100644
--- a/compat/zlib/contrib/minizip/minizip.c
+++ b/compat/zlib/contrib/minizip/minizip.c
@@ -12,7 +12,6 @@
Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
*/
-
#if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
#ifndef __USE_FILE_OFFSET64
#define __USE_FILE_OFFSET64
@@ -28,7 +27,7 @@
#endif
#endif
-#ifdef __APPLE__
+#if defined(__APPLE__) || defined(IOAPI_NO_64)
// In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
#define FOPEN_FUNC(filename, mode) fopen(filename, mode)
#define FTELLO_FUNC(stream) ftello(stream)
@@ -39,8 +38,7 @@
#define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
#endif
-
-
+#include "tinydir.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
@@ -172,6 +170,7 @@ void do_banner()
void do_help()
{
printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
+ " -r Scan directories recursively\n" \
" -o Overwrite existing file.zip\n" \
" -a Append to existing file.zip\n" \
" -0 Store only\n" \
@@ -243,12 +242,153 @@ int isLargeFile(const char* filename)
return largeFile;
}
+void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
+ FILE * fin;
+ int size_read;
+ const char *savefilenameinzip;
+ zip_fileinfo zi;
+ unsigned long crcFile=0;
+ int zip64 = 0;
+ int err=0;
+ int size_buf=WRITEBUFFERSIZE;
+ unsigned char buf[WRITEBUFFERSIZE];
+ zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
+ zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
+ zi.dosDate = 0;
+ zi.internal_fa = 0;
+ zi.external_fa = 0;
+ filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
+
+/*
+ err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
+ NULL,0,NULL,0,NULL / * comment * /,
+ (opt_compress_level != 0) ? Z_DEFLATED : 0,
+ opt_compress_level);
+*/
+ if ((password != NULL) && (err==ZIP_OK))
+ err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
+
+ zip64 = isLargeFile(filenameinzip);
+
+ /* The path name saved, should not include a leading slash. */
+ /*if it did, windows/xp and dynazip couldn't read the zip file. */
+ savefilenameinzip = filenameinzip;
+ while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
+ {
+ savefilenameinzip++;
+ }
+
+ /*should the zip file contain any path at all?*/
+ if( opt_exclude_path )
+ {
+ const char *tmpptr;
+ const char *lastslash = 0;
+ for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
+ {
+ if( *tmpptr == '\\' || *tmpptr == '/')
+ {
+ lastslash = tmpptr;
+ }
+ }
+ if( lastslash != NULL )
+ {
+ savefilenameinzip = lastslash+1; // base filename follows last slash.
+ }
+ }
+
+ /**/
+ err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
+ NULL,0,NULL,0,NULL /* comment*/,
+ (opt_compress_level != 0) ? Z_DEFLATED : 0,
+ opt_compress_level,0,
+ /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
+ -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+ password,crcFile, zip64);
+
+ if (err != ZIP_OK)
+ printf("error in opening %s in zipfile\n",filenameinzip);
+ else
+ {
+ fin = FOPEN_FUNC(filenameinzip,"rb");
+ if (fin==NULL)
+ {
+ err=ZIP_ERRNO;
+ printf("error in opening %s for reading\n",filenameinzip);
+ }
+ }
+
+ if (err == ZIP_OK)
+ do
+ {
+ err = ZIP_OK;
+ size_read = (int)fread(buf,1,size_buf,fin);
+ if (size_read < size_buf)
+ if (feof(fin)==0)
+ {
+ printf("error in reading %s\n",filenameinzip);
+ err = ZIP_ERRNO;
+ }
+
+ if (size_read>0)
+ {
+ err = zipWriteInFileInZip (zf,buf,size_read);
+ if (err<0)
+ {
+ printf("error in writing %s in the zipfile\n",
+ filenameinzip);
+ }
+
+ }
+ } while ((err == ZIP_OK) && (size_read>0));
+
+ if (fin)
+ fclose(fin);
+
+ if (err<0)
+ err=ZIP_ERRNO;
+ else
+ {
+ err = zipCloseFileInZip(zf);
+ if (err!=ZIP_OK)
+ printf("error in closing %s in the zipfile\n",
+ filenameinzip);
+ }
+}
+
+
+void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
+ tinydir_dir dir;
+ int i;
+ char newname[512];
+
+ tinydir_open_sorted(&dir, filenameinzip);
+
+ for (i = 0; i < dir.n_files; i++)
+ {
+ tinydir_file file;
+ tinydir_readfile_n(&dir, &file, i);
+ if(strcmp(file.name,".")==0) continue;
+ if(strcmp(file.name,"..")==0) continue;
+ sprintf(newname,"%s/%s",dir.path,file.name);
+ if (file.is_dir)
+ {
+ addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
+ } else {
+ addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
+ }
+ }
+
+ tinydir_close(&dir);
+}
+
+
int main(argc,argv)
int argc;
char *argv[];
{
int i;
- int opt_overwrite=0;
+ int opt_recursive=0;
+ int opt_overwrite=1;
int opt_compress_level=Z_DEFAULT_COMPRESSION;
int opt_exclude_path=0;
int zipfilenamearg = 0;
@@ -285,7 +425,8 @@ int main(argc,argv)
opt_compress_level = c-'0';
if ((c=='j') || (c=='J'))
opt_exclude_path = 1;
-
+ if ((c=='r') || (c=='R'))
+ opt_recursive = 1;
if (((c=='p') || (c=='P')) && (i+1<argc))
{
password=argv[i+1];
@@ -392,117 +533,14 @@ int main(argc,argv)
((argv[i][1]=='o') || (argv[i][1]=='O') ||
(argv[i][1]=='a') || (argv[i][1]=='A') ||
(argv[i][1]=='p') || (argv[i][1]=='P') ||
+ (argv[i][1]=='r') || (argv[i][1]=='R') ||
((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
(strlen(argv[i]) == 2)))
{
- FILE * fin;
- int size_read;
- const char* filenameinzip = argv[i];
- const char *savefilenameinzip;
- zip_fileinfo zi;
- unsigned long crcFile=0;
- int zip64 = 0;
-
- zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
- zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
- zi.dosDate = 0;
- zi.internal_fa = 0;
- zi.external_fa = 0;
- filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
-
-/*
- err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
- NULL,0,NULL,0,NULL / * comment * /,
- (opt_compress_level != 0) ? Z_DEFLATED : 0,
- opt_compress_level);
-*/
- if ((password != NULL) && (err==ZIP_OK))
- err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
-
- zip64 = isLargeFile(filenameinzip);
-
- /* The path name saved, should not include a leading slash. */
- /*if it did, windows/xp and dynazip couldn't read the zip file. */
- savefilenameinzip = filenameinzip;
- while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
- {
- savefilenameinzip++;
- }
-
- /*should the zip file contain any path at all?*/
- if( opt_exclude_path )
- {
- const char *tmpptr;
- const char *lastslash = 0;
- for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
- {
- if( *tmpptr == '\\' || *tmpptr == '/')
- {
- lastslash = tmpptr;
- }
- }
- if( lastslash != NULL )
- {
- savefilenameinzip = lastslash+1; // base filename follows last slash.
- }
- }
-
- /**/
- err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
- NULL,0,NULL,0,NULL /* comment*/,
- (opt_compress_level != 0) ? Z_DEFLATED : 0,
- opt_compress_level,0,
- /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
- -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
- password,crcFile, zip64);
-
- if (err != ZIP_OK)
- printf("error in opening %s in zipfile\n",filenameinzip);
- else
- {
- fin = FOPEN_FUNC(filenameinzip,"rb");
- if (fin==NULL)
- {
- err=ZIP_ERRNO;
- printf("error in opening %s for reading\n",filenameinzip);
- }
- }
-
- if (err == ZIP_OK)
- do
- {
- err = ZIP_OK;
- size_read = (int)fread(buf,1,size_buf,fin);
- if (size_read < size_buf)
- if (feof(fin)==0)
- {
- printf("error in reading %s\n",filenameinzip);
- err = ZIP_ERRNO;
- }
-
- if (size_read>0)
- {
- err = zipWriteInFileInZip (zf,buf,size_read);
- if (err<0)
- {
- printf("error in writing %s in the zipfile\n",
- filenameinzip);
- }
-
- }
- } while ((err == ZIP_OK) && (size_read>0));
-
- if (fin)
- fclose(fin);
-
- if (err<0)
- err=ZIP_ERRNO;
- else
- {
- err = zipCloseFileInZip(zf);
- if (err!=ZIP_OK)
- printf("error in closing %s in the zipfile\n",
- filenameinzip);
+ if(opt_recursive) {
+ addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
+ } else {
+ addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
}
}
}
diff --git a/compat/zlib/contrib/minizip/tinydir.h b/compat/zlib/contrib/minizip/tinydir.h
new file mode 100755
index 0000000..eb34399
--- /dev/null
+++ b/compat/zlib/contrib/minizip/tinydir.h
@@ -0,0 +1,816 @@
+/*
+Copyright (c) 2013-2017, tinydir authors:
+- Cong Xu
+- Lautis Sun
+- Baudouin Feildel
+- Andargor <andargor@yahoo.com>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+ list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+ this list of conditions and the following disclaimer in the documentation
+ and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*/
+#ifndef TINYDIR_H
+#define TINYDIR_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if ((defined _UNICODE) && !(defined UNICODE))
+#define UNICODE
+#endif
+
+#if ((defined UNICODE) && !(defined _UNICODE))
+#define _UNICODE
+#endif
+
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#ifdef _MSC_VER
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# include <tchar.h>
+# pragma warning(push)
+# pragma warning (disable : 4996)
+#else
+# include <dirent.h>
+# include <libgen.h>
+# include <sys/stat.h>
+# include <stddef.h>
+#endif
+#ifdef __MINGW32__
+# include <tchar.h>
+#endif
+
+
+/* types */
+
+/* Windows UNICODE wide character support */
+#if defined _MSC_VER || defined __MINGW32__
+# define _tinydir_char_t TCHAR
+# define TINYDIR_STRING(s) _TEXT(s)
+# define _tinydir_strlen _tcslen
+# define _tinydir_strcpy _tcscpy
+# define _tinydir_strcat _tcscat
+# define _tinydir_strcmp _tcscmp
+# define _tinydir_strrchr _tcsrchr
+# define _tinydir_strncmp _tcsncmp
+#else
+# define _tinydir_char_t char
+# define TINYDIR_STRING(s) s
+# define _tinydir_strlen strlen
+# define _tinydir_strcpy strcpy
+# define _tinydir_strcat strcat
+# define _tinydir_strcmp strcmp
+# define _tinydir_strrchr strrchr
+# define _tinydir_strncmp strncmp
+#endif
+
+#if (defined _MSC_VER || defined __MINGW32__)
+# include <windows.h>
+# define _TINYDIR_PATH_MAX MAX_PATH
+#elif defined __linux__
+# include <limits.h>
+# define _TINYDIR_PATH_MAX PATH_MAX
+#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
+# include <sys/param.h>
+# if defined(BSD)
+# include <limits.h>
+# define _TINYDIR_PATH_MAX PATH_MAX
+# endif
+#endif
+
+#ifndef _TINYDIR_PATH_MAX
+#define _TINYDIR_PATH_MAX 4096
+#endif
+
+#ifdef _MSC_VER
+/* extra chars for the "\\*" mask */
+# define _TINYDIR_PATH_EXTRA 2
+#else
+# define _TINYDIR_PATH_EXTRA 0
+#endif
+
+#define _TINYDIR_FILENAME_MAX 256
+
+#if (defined _MSC_VER || defined __MINGW32__)
+#define _TINYDIR_DRIVE_MAX 3
+#endif
+
+#ifdef _MSC_VER
+# define _TINYDIR_FUNC static __inline
+#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
+# define _TINYDIR_FUNC static __inline__
+#else
+# define _TINYDIR_FUNC static inline
+#endif
+
+/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */
+#ifdef TINYDIR_USE_READDIR_R
+
+/* readdir_r is a POSIX-only function, and may not be available under various
+ * environments/settings, e.g. MinGW. Use readdir fallback */
+#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\
+ _POSIX_SOURCE
+# define _TINYDIR_HAS_READDIR_R
+#endif
+#if _POSIX_C_SOURCE >= 200112L
+# define _TINYDIR_HAS_FPATHCONF
+# include <unistd.h>
+#endif
+#if _BSD_SOURCE || _SVID_SOURCE || \
+ (_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700)
+# define _TINYDIR_HAS_DIRFD
+# include <sys/types.h>
+#endif
+#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\
+ defined _PC_NAME_MAX
+# define _TINYDIR_USE_FPATHCONF
+#endif
+#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\
+ !(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX)
+# define _TINYDIR_USE_READDIR
+#endif
+
+/* Use readdir by default */
+#else
+# define _TINYDIR_USE_READDIR
+#endif
+
+/* MINGW32 has two versions of dirent, ASCII and UNICODE*/
+#ifndef _MSC_VER
+#if (defined __MINGW32__) && (defined _UNICODE)
+#define _TINYDIR_DIR _WDIR
+#define _tinydir_dirent _wdirent
+#define _tinydir_opendir _wopendir
+#define _tinydir_readdir _wreaddir
+#define _tinydir_closedir _wclosedir
+#else
+#define _TINYDIR_DIR DIR
+#define _tinydir_dirent dirent
+#define _tinydir_opendir opendir
+#define _tinydir_readdir readdir
+#define _tinydir_closedir closedir
+#endif
+#endif
+
+/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */
+#if defined(_TINYDIR_MALLOC) && defined(_TINYDIR_FREE)
+#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE)
+#else
+#error "Either define both alloc and free or none of them!"
+#endif
+
+#if !defined(_TINYDIR_MALLOC)
+ #define _TINYDIR_MALLOC(_size) malloc(_size)
+ #define _TINYDIR_FREE(_ptr) free(_ptr)
+#endif /* !defined(_TINYDIR_MALLOC) */
+
+typedef struct tinydir_file
+{
+ _tinydir_char_t path[_TINYDIR_PATH_MAX];
+ _tinydir_char_t name[_TINYDIR_FILENAME_MAX];
+ _tinydir_char_t *extension;
+ int is_dir;
+ int is_reg;
+
+#ifndef _MSC_VER
+#ifdef __MINGW32__
+ struct _stat _s;
+#else
+ struct stat _s;
+#endif
+#endif
+} tinydir_file;
+
+typedef struct tinydir_dir
+{
+ _tinydir_char_t path[_TINYDIR_PATH_MAX];
+ int has_next;
+ size_t n_files;
+
+ tinydir_file *_files;
+#ifdef _MSC_VER
+ HANDLE _h;
+ WIN32_FIND_DATA _f;
+#else
+ _TINYDIR_DIR *_d;
+ struct _tinydir_dirent *_e;
+#ifndef _TINYDIR_USE_READDIR
+ struct _tinydir_dirent *_ep;
+#endif
+#endif
+} tinydir_dir;
+
+
+/* declarations */
+
+_TINYDIR_FUNC
+int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path);
+_TINYDIR_FUNC
+int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path);
+_TINYDIR_FUNC
+void tinydir_close(tinydir_dir *dir);
+
+_TINYDIR_FUNC
+int tinydir_next(tinydir_dir *dir);
+_TINYDIR_FUNC
+int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file);
+_TINYDIR_FUNC
+int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i);
+_TINYDIR_FUNC
+int tinydir_open_subdir_n(tinydir_dir *dir, size_t i);
+
+_TINYDIR_FUNC
+int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path);
+_TINYDIR_FUNC
+void _tinydir_get_ext(tinydir_file *file);
+_TINYDIR_FUNC
+int _tinydir_file_cmp(const void *a, const void *b);
+#ifndef _MSC_VER
+#ifndef _TINYDIR_USE_READDIR
+_TINYDIR_FUNC
+size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp);
+#endif
+#endif
+
+
+/* definitions*/
+
+_TINYDIR_FUNC
+int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path)
+{
+#ifndef _MSC_VER
+#ifndef _TINYDIR_USE_READDIR
+ int error;
+ int size; /* using int size */
+#endif
+#else
+ _tinydir_char_t path_buf[_TINYDIR_PATH_MAX];
+#endif
+ _tinydir_char_t *pathp;
+
+ if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+
+ /* initialise dir */
+ dir->_files = NULL;
+#ifdef _MSC_VER
+ dir->_h = INVALID_HANDLE_VALUE;
+#else
+ dir->_d = NULL;
+#ifndef _TINYDIR_USE_READDIR
+ dir->_ep = NULL;
+#endif
+#endif
+ tinydir_close(dir);
+
+ _tinydir_strcpy(dir->path, path);
+ /* Remove trailing slashes */
+ pathp = &dir->path[_tinydir_strlen(dir->path) - 1];
+ while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/')))
+ {
+ *pathp = TINYDIR_STRING('\0');
+ pathp++;
+ }
+#ifdef _MSC_VER
+ _tinydir_strcpy(path_buf, dir->path);
+ _tinydir_strcat(path_buf, TINYDIR_STRING("\\*"));
+#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP)
+ dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0);
+#else
+ dir->_h = FindFirstFile(path_buf, &dir->_f);
+#endif
+ if (dir->_h == INVALID_HANDLE_VALUE)
+ {
+ errno = ENOENT;
+#else
+ dir->_d = _tinydir_opendir(path);
+ if (dir->_d == NULL)
+ {
+#endif
+ goto bail;
+ }
+
+ /* read first file */
+ dir->has_next = 1;
+#ifndef _MSC_VER
+#ifdef _TINYDIR_USE_READDIR
+ dir->_e = _tinydir_readdir(dir->_d);
+#else
+ /* allocate dirent buffer for readdir_r */
+ size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */
+ if (size == -1) return -1;
+ dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size);
+ if (dir->_ep == NULL) return -1;
+
+ error = readdir_r(dir->_d, dir->_ep, &dir->_e);
+ if (error != 0) return -1;
+#endif
+ if (dir->_e == NULL)
+ {
+ dir->has_next = 0;
+ }
+#endif
+
+ return 0;
+
+bail:
+ tinydir_close(dir);
+ return -1;
+}
+
+_TINYDIR_FUNC
+int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path)
+{
+ /* Count the number of files first, to pre-allocate the files array */
+ size_t n_files = 0;
+ if (tinydir_open(dir, path) == -1)
+ {
+ return -1;
+ }
+ while (dir->has_next)
+ {
+ n_files++;
+ if (tinydir_next(dir) == -1)
+ {
+ goto bail;
+ }
+ }
+ tinydir_close(dir);
+
+ if (tinydir_open(dir, path) == -1)
+ {
+ return -1;
+ }
+
+ dir->n_files = 0;
+ dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files);
+ if (dir->_files == NULL)
+ {
+ goto bail;
+ }
+ while (dir->has_next)
+ {
+ tinydir_file *p_file;
+ dir->n_files++;
+
+ p_file = &dir->_files[dir->n_files - 1];
+ if (tinydir_readfile(dir, p_file) == -1)
+ {
+ goto bail;
+ }
+
+ if (tinydir_next(dir) == -1)
+ {
+ goto bail;
+ }
+
+ /* Just in case the number of files has changed between the first and
+ second reads, terminate without writing into unallocated memory */
+ if (dir->n_files == n_files)
+ {
+ break;
+ }
+ }
+
+ qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp);
+
+ return 0;
+
+bail:
+ tinydir_close(dir);
+ return -1;
+}
+
+_TINYDIR_FUNC
+void tinydir_close(tinydir_dir *dir)
+{
+ if (dir == NULL)
+ {
+ return;
+ }
+
+ memset(dir->path, 0, sizeof(dir->path));
+ dir->has_next = 0;
+ dir->n_files = 0;
+ _TINYDIR_FREE(dir->_files);
+ dir->_files = NULL;
+#ifdef _MSC_VER
+ if (dir->_h != INVALID_HANDLE_VALUE)
+ {
+ FindClose(dir->_h);
+ }
+ dir->_h = INVALID_HANDLE_VALUE;
+#else
+ if (dir->_d)
+ {
+ _tinydir_closedir(dir->_d);
+ }
+ dir->_d = NULL;
+ dir->_e = NULL;
+#ifndef _TINYDIR_USE_READDIR
+ _TINYDIR_FREE(dir->_ep);
+ dir->_ep = NULL;
+#endif
+#endif
+}
+
+_TINYDIR_FUNC
+int tinydir_next(tinydir_dir *dir)
+{
+ if (dir == NULL)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (!dir->has_next)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+
+#ifdef _MSC_VER
+ if (FindNextFile(dir->_h, &dir->_f) == 0)
+#else
+#ifdef _TINYDIR_USE_READDIR
+ dir->_e = _tinydir_readdir(dir->_d);
+#else
+ if (dir->_ep == NULL)
+ {
+ return -1;
+ }
+ if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0)
+ {
+ return -1;
+ }
+#endif
+ if (dir->_e == NULL)
+#endif
+ {
+ dir->has_next = 0;
+#ifdef _MSC_VER
+ if (GetLastError() != ERROR_SUCCESS &&
+ GetLastError() != ERROR_NO_MORE_FILES)
+ {
+ tinydir_close(dir);
+ errno = EIO;
+ return -1;
+ }
+#endif
+ }
+
+ return 0;
+}
+
+_TINYDIR_FUNC
+int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file)
+{
+ if (dir == NULL || file == NULL)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+#ifdef _MSC_VER
+ if (dir->_h == INVALID_HANDLE_VALUE)
+#else
+ if (dir->_e == NULL)
+#endif
+ {
+ errno = ENOENT;
+ return -1;
+ }
+ if (_tinydir_strlen(dir->path) +
+ _tinydir_strlen(
+#ifdef _MSC_VER
+ dir->_f.cFileName
+#else
+ dir->_e->d_name
+#endif
+ ) + 1 + _TINYDIR_PATH_EXTRA >=
+ _TINYDIR_PATH_MAX)
+ {
+ /* the path for the file will be too long */
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+ if (_tinydir_strlen(
+#ifdef _MSC_VER
+ dir->_f.cFileName
+#else
+ dir->_e->d_name
+#endif
+ ) >= _TINYDIR_FILENAME_MAX)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+
+ _tinydir_strcpy(file->path, dir->path);
+ _tinydir_strcat(file->path, TINYDIR_STRING("/"));
+ _tinydir_strcpy(file->name,
+#ifdef _MSC_VER
+ dir->_f.cFileName
+#else
+ dir->_e->d_name
+#endif
+ );
+ _tinydir_strcat(file->path, file->name);
+#ifndef _MSC_VER
+#ifdef __MINGW32__
+ if (_tstat(
+#else
+ if (stat(
+#endif
+ file->path, &file->_s) == -1)
+ {
+ return -1;
+ }
+#endif
+ _tinydir_get_ext(file);
+
+ file->is_dir =
+#ifdef _MSC_VER
+ !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
+#else
+ S_ISDIR(file->_s.st_mode);
+#endif
+ file->is_reg =
+#ifdef _MSC_VER
+ !!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) ||
+ (
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) &&
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) &&
+#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) &&
+#endif
+#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) &&
+#endif
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) &&
+ !(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY));
+#else
+ S_ISREG(file->_s.st_mode);
+#endif
+
+ return 0;
+}
+
+_TINYDIR_FUNC
+int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i)
+{
+ if (dir == NULL || file == NULL)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (i >= dir->n_files)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+
+ memcpy(file, &dir->_files[i], sizeof(tinydir_file));
+ _tinydir_get_ext(file);
+
+ return 0;
+}
+
+_TINYDIR_FUNC
+int tinydir_open_subdir_n(tinydir_dir *dir, size_t i)
+{
+ _tinydir_char_t path[_TINYDIR_PATH_MAX];
+ if (dir == NULL)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (i >= dir->n_files || !dir->_files[i].is_dir)
+ {
+ errno = ENOENT;
+ return -1;
+ }
+
+ _tinydir_strcpy(path, dir->_files[i].path);
+ tinydir_close(dir);
+ if (tinydir_open_sorted(dir, path) == -1)
+ {
+ return -1;
+ }
+
+ return 0;
+}
+
+/* Open a single file given its path */
+_TINYDIR_FUNC
+int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path)
+{
+ tinydir_dir dir;
+ int result = 0;
+ int found = 0;
+ _tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX];
+ _tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX];
+ _tinydir_char_t *dir_name;
+ _tinydir_char_t *base_name;
+#if (defined _MSC_VER || defined __MINGW32__)
+ _tinydir_char_t drive_buf[_TINYDIR_PATH_MAX];
+ _tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX];
+#endif
+
+ if (file == NULL || path == NULL || _tinydir_strlen(path) == 0)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
+ {
+ errno = ENAMETOOLONG;
+ return -1;
+ }
+
+ /* Get the parent path */
+#if (defined _MSC_VER || defined __MINGW32__)
+#if ((defined _MSC_VER) && (_MSC_VER >= 1400))
+ _tsplitpath_s(
+ path,
+ drive_buf, _TINYDIR_DRIVE_MAX,
+ dir_name_buf, _TINYDIR_FILENAME_MAX,
+ file_name_buf, _TINYDIR_FILENAME_MAX,
+ ext_buf, _TINYDIR_FILENAME_MAX);
+#else
+ _tsplitpath(
+ path,
+ drive_buf,
+ dir_name_buf,
+ file_name_buf,
+ ext_buf);
+#endif
+
+/* _splitpath_s not work fine with only filename and widechar support */
+#ifdef _UNICODE
+ if (drive_buf[0] == L'\xFEFE')
+ drive_buf[0] = '\0';
+ if (dir_name_buf[0] == L'\xFEFE')
+ dir_name_buf[0] = '\0';
+#endif
+
+ if (errno)
+ {
+ errno = EINVAL;
+ return -1;
+ }
+ /* Emulate the behavior of dirname by returning "." for dir name if it's
+ empty */
+ if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0')
+ {
+ _tinydir_strcpy(dir_name_buf, TINYDIR_STRING("."));
+ }
+ /* Concatenate the drive letter and dir name to form full dir name */
+ _tinydir_strcat(drive_buf, dir_name_buf);
+ dir_name = drive_buf;
+ /* Concatenate the file name and extension to form base name */
+ _tinydir_strcat(file_name_buf, ext_buf);
+ base_name = file_name_buf;
+#else
+ _tinydir_strcpy(dir_name_buf, path);
+ dir_name = dirname(dir_name_buf);
+ _tinydir_strcpy(file_name_buf, path);
+ base_name =basename(file_name_buf);
+#endif
+
+ /* Open the parent directory */
+ if (tinydir_open(&dir, dir_name) == -1)
+ {
+ return -1;
+ }
+
+ /* Read through the parent directory and look for the file */
+ while (dir.has_next)
+ {
+ if (tinydir_readfile(&dir, file) == -1)
+ {
+ result = -1;
+ goto bail;
+ }
+ if (_tinydir_strcmp(file->name, base_name) == 0)
+ {
+ /* File found */
+ found = 1;
+ break;
+ }
+ tinydir_next(&dir);
+ }
+ if (!found)
+ {
+ result = -1;
+ errno = ENOENT;
+ }
+
+bail:
+ tinydir_close(&dir);
+ return result;
+}
+
+_TINYDIR_FUNC
+void _tinydir_get_ext(tinydir_file *file)
+{
+ _tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.'));
+ if (period == NULL)
+ {
+ file->extension = &(file->name[_tinydir_strlen(file->name)]);
+ }
+ else
+ {
+ file->extension = period + 1;
+ }
+}
+
+_TINYDIR_FUNC
+int _tinydir_file_cmp(const void *a, const void *b)
+{
+ const tinydir_file *fa = (const tinydir_file *)a;
+ const tinydir_file *fb = (const tinydir_file *)b;
+ if (fa->is_dir != fb->is_dir)
+ {
+ return -(fa->is_dir - fb->is_dir);
+ }
+ return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX);
+}
+
+#ifndef _MSC_VER
+#ifndef _TINYDIR_USE_READDIR
+/*
+The following authored by Ben Hutchings <ben@decadent.org.uk>
+from https://womble.decadent.org.uk/readdir_r-advisory.html
+*/
+/* Calculate the required buffer size (in bytes) for directory *
+* entries read from the given directory handle. Return -1 if this *
+* this cannot be done. *
+* *
+* This code does not trust values of NAME_MAX that are less than *
+* 255, since some systems (including at least HP-UX) incorrectly *
+* define it to be a smaller value. */
+_TINYDIR_FUNC
+size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp)
+{
+ long name_max;
+ size_t name_end;
+ /* parameter may be unused */
+ (void)dirp;
+
+#if defined _TINYDIR_USE_FPATHCONF
+ name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX);
+ if (name_max == -1)
+#if defined(NAME_MAX)
+ name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
+#else
+ return (size_t)(-1);
+#endif
+#elif defined(NAME_MAX)
+ name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
+#else
+#error "buffer size for readdir_r cannot be determined"
+#endif
+ name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1;
+ return (name_end > sizeof(struct _tinydir_dirent) ?
+ name_end : sizeof(struct _tinydir_dirent));
+}
+#endif
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+# if defined (_MSC_VER)
+# pragma warning(pop)
+# endif
+
+#endif
diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib
index a3e9a39..a3e9a39 100755..100644
--- a/compat/zlib/win32/zdll.lib
+++ b/compat/zlib/win32/zdll.lib
Binary files differ
diff --git a/doc/AddErrInfo.3 b/doc/AddErrInfo.3
index caba125..0b59349 100644
--- a/doc/AddErrInfo.3
+++ b/doc/AddErrInfo.3
@@ -119,7 +119,7 @@ retrieve the stack trace when script evaluation returns
\fBTCL_ERROR\fR, like so:
.PP
.CS
-int code = Tcl_Eval(interp, script);
+int code = Tcl_EvalEx(interp, script, -1, 0);
if (code == TCL_ERROR) {
Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);
Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1);
diff --git a/doc/CallDel.3 b/doc/CallDel.3
index 766621a..33b8afc 100644
--- a/doc/CallDel.3
+++ b/doc/CallDel.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_CallWhenDeleted 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3
index 25b372e..bb7532c 100644
--- a/doc/CmdCmplt.3
+++ b/doc/CmdCmplt.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Concat.3 b/doc/Concat.3
index 58a0fb6..e853fc3 100644
--- a/doc/Concat.3
+++ b/doc/Concat.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/CrtFileHdlr.3 b/doc/CrtFileHdlr.3
index c1bc1fa..f1b8df7 100644
--- a/doc/CrtFileHdlr.3
+++ b/doc/CrtFileHdlr.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_CreateFileHandler 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/CrtInterp.3 b/doc/CrtInterp.3
index 679795e..1d49158 100644
--- a/doc/CrtInterp.3
+++ b/doc/CrtInterp.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_CreateInterp 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 6714bd7..2cd9222 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -8,7 +8,7 @@
.so man.macros
.BS
.SH NAME
-Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj, Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -42,6 +42,14 @@ void
.sp
Tcl_Command
\fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
+.sp
+.VS "info cmdtype feature"
+void
+\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR)
+.sp
+const char *
+\fBTcl_GetCommandTypeName\fR(\fItoken\fR)
+.VE "info cmdtype feature"
.SH ARGUMENTS
.AS Tcl_CmdDeleteProc *deleteProc in/out
.AP Tcl_Interp *interp in
@@ -65,6 +73,9 @@ Pointer to structure containing various information about a
Tcl command.
.AP Tcl_Obj *objPtr in
Value containing the name of a Tcl command.
+.AP "const char" *typeName in
+Indicates the name of the type of command implementation associated
+with a particular \fIproc\fR, or NULL to break the association.
.BE
.SH DESCRIPTION
.PP
@@ -296,6 +307,22 @@ is appended to the value specified by \fIobjPtr\fR.
specified by the name in a \fBTcl_Obj\fR.
The command name is resolved relative to the current namespace.
Returns NULL if the command is not found.
+.PP
+.VS "info cmdtype feature"
+\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the
+\fItypeName\fR argument) with a particular implementation function so that it
+can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is
+called with a command token that information is wanted for and which returns
+the name of the type that was registered for the implementation function used
+for that command. (The lookup functionality is surfaced virtually directly in Tcl via
+\fBinfo cmdtype\fR.) If there is no function registered for a particular
+function, the result will be the string literal
+.QW \fBnative\fR .
+The registration of a name can be undone by registering a mapping to NULL
+instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
+string which was registered, and not a copy; use of a compile-time constant
+string is \fIstrongly recommended\fR.
+.VE "info cmdtype feature"
.SH "SEE ALSO"
Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
.SH KEYWORDS
diff --git a/doc/CrtTimerHdlr.3 b/doc/CrtTimerHdlr.3
index f3957c7..c229a23 100644
--- a/doc/CrtTimerHdlr.3
+++ b/doc/CrtTimerHdlr.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_CreateTimerHandler 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/DetachPids.3 b/doc/DetachPids.3
index 39a51d3..26075c3 100644
--- a/doc/DetachPids.3
+++ b/doc/DetachPids.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_DetachPids 3 "" Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/DictObj.3 b/doc/DictObj.3
index 90ca9e3..2c111c4 100644
--- a/doc/DictObj.3
+++ b/doc/DictObj.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_DictObj 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/DoWhenIdle.3 b/doc/DoWhenIdle.3
index 3e28b4d..cfdbff9 100644
--- a/doc/DoWhenIdle.3
+++ b/doc/DoWhenIdle.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_DoWhenIdle 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Environment.3 b/doc/Environment.3
index 85880b4..7a5e396 100644
--- a/doc/Environment.3
+++ b/doc/Environment.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_PutEnv 3 "7.5" Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Exit.3 b/doc/Exit.3
index 9a04db3..a52b2e1 100644
--- a/doc/Exit.3
+++ b/doc/Exit.3
@@ -134,6 +134,9 @@ finalization of Tcl's subsystems via \fBTcl_Finalize\fR at an
appropriate time. The argument passed to \fIproc\fR when it is
invoked will be the exit status code (as passed to \fBTcl_Exit\fR)
cast to a ClientData value.
+.PP
+\fBTcl_SetExitProc\fR can not be used in stub-enabled extensions. Its symbol
+entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH "SEE ALSO"
exit(n)
.SH KEYWORDS
diff --git a/doc/ExprLongObj.3 b/doc/ExprLongObj.3
index 35edb5f..837e0a8 100644
--- a/doc/ExprLongObj.3
+++ b/doc/ExprLongObj.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_ExprLongObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/FindExec.3 b/doc/FindExec.3
index b01315c..149ef8a 100644
--- a/doc/FindExec.3
+++ b/doc/FindExec.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_FindExecutable 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
@@ -58,6 +58,8 @@ internal full path name of the executable file as computed by
equivalent to the \fBinfo nameofexecutable\fR command. NULL
is returned if the internal full path name has not been
computed or unknown.
-
+.PP
+\fBTcl_FindExecutable\fR can not be used in stub-enabled extensions. Its symbol
+entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
binary, executable file
diff --git a/doc/GetCwd.3 b/doc/GetCwd.3
index 58abcde..f4f37a1 100644
--- a/doc/GetCwd.3
+++ b/doc/GetCwd.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_GetCwd 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/GetIndex.3 b/doc/GetIndex.3
index fc6f40b..17a31d4 100644
--- a/doc/GetIndex.3
+++ b/doc/GetIndex.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_GetIndexFromObj 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/GetInt.3 b/doc/GetInt.3
index 5a3304a..eba549d 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -57,6 +57,9 @@ after the optional white space and sign are
.QW \fB0x\fR
then \fIsrc\fR is expected to be in hexadecimal form; otherwise,
if the first such characters are
+.QW \fB0d\fR
+then \fIsrc\fR is expected to be in decimal form; otherwise,
+if the first such characters are
.QW \fB0o\fR
then \fIsrc\fR is expected to be in octal form; otherwise,
if the first such characters are
@@ -65,8 +68,8 @@ then \fIsrc\fR is expected to be in binary form; otherwise,
if the first such character is
.QW \fB0\fR
then \fIsrc\fR
-is expected to be in octal form; otherwise, \fIsrc\fR is
-expected to be in decimal form.
+is expected to be in octal form; otherwise, \fIsrc\fR
+is expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is: white space; a sign; a sequence of digits; a
diff --git a/doc/GetOpnFl.3 b/doc/GetOpnFl.3
index 86d1b94..a450b02 100644
--- a/doc/GetOpnFl.3
+++ b/doc/GetOpnFl.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_GetOpenFile 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/GetTime.3 b/doc/GetTime.3
index 6b885ee..9f96be5 100644
--- a/doc/GetTime.3
+++ b/doc/GetTime.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_GetTime 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Hash.3 b/doc/Hash.3
index 4dc3623..aa79b86 100644
--- a/doc/Hash.3
+++ b/doc/Hash.3
@@ -281,7 +281,7 @@ The \fIhashKeyProc\fR member contains the address of a function called to
calculate a hash value for the key.
.PP
.CS
-typedef unsigned int \fBTcl_HashKeyProc\fR(
+typedef TCL_HASH_TYPE \fBTcl_HashKeyProc\fR(
Tcl_HashTable *\fItablePtr\fR,
void *\fIkeyPtr\fR);
.CE
diff --git a/doc/Init.3 b/doc/Init.3
index 33c27a3..0a6635e 100644
--- a/doc/Init.3
+++ b/doc/Init.3
@@ -1,7 +1,7 @@
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
-'\"
+'\"
.TH Tcl_Init 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/InitStubs.3 b/doc/InitStubs.3
index 73c3437..4423666 100644
--- a/doc/InitStubs.3
+++ b/doc/InitStubs.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_InitStubs 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
@@ -23,11 +23,11 @@ Tcl interpreter handle.
A version string consisting of one or more decimal numbers
separated by dots.
.AP int exact in
-Non-zero means that only the particular version specified by
+1 means that only the particular version specified by
\fIversion\fR is acceptable.
-Zero means that versions newer than \fIversion\fR are also
+0 means that versions newer than \fIversion\fR are also
acceptable as long as they have the same major version number
-as \fIversion\fR.
+as \fIversion\fR. Other bits have no effect.
.BE
.SH INTRODUCTION
.PP
diff --git a/doc/IntObj.3 b/doc/IntObj.3
index 2acb446..6d5ee69 100644
--- a/doc/IntObj.3
+++ b/doc/IntObj.3
@@ -97,7 +97,7 @@ are provided by the C language standard. The \fBTcl_WideInt\fR type is a
typedef defined to be whatever signed integral type covers at least the
64-bit integer range (-9223372036854775808 to 9223372036854775807). Depending
on the platform and the C compiler, the actual type might be
-\fBlong int\fR, \fBlong long int\fR, \fB__int64\fR, or something else.
+\fBlong long int\fR, \fB__int64\fR, or something else.
The \fBmp_int\fR type is a multiple-precision integer type defined
by the LibTomMath multiple-precision integer library.
.PP
diff --git a/doc/Interp.3 b/doc/Interp.3
index 731007b..4ccff21 100644
--- a/doc/Interp.3
+++ b/doc/Interp.3
@@ -101,7 +101,7 @@ the command. The \fIfreeProc\fR field will be initialized to zero,
and \fIinterp->result\fR will point to an empty string. Commands that
do not return any value can simply leave the fields alone.
Furthermore, the empty string pointed to by \fIresult\fR is actually
-part of an array of \fBTCL_RESULT_SIZE\fR characters (approximately 200).
+part of an array of approximately 200 characters.
If a command wishes to return a short string, it can simply copy
it to the area pointed to by \fIinterp->result\fR. Or, it can use
the sprintf procedure to generate a short result string at the location
diff --git a/doc/Limit.3 b/doc/Limit.3
index 20a2e02..5939a80 100644
--- a/doc/Limit.3
+++ b/doc/Limit.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_LimitCheck 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Load.3 b/doc/Load.3
index 0ffaf57..1d0d738 100644
--- a/doc/Load.3
+++ b/doc/Load.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Load 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Method.3 b/doc/Method.3
index 225da00..9e636a1 100644
--- a/doc/Method.3
+++ b/doc/Method.3
@@ -9,18 +9,18 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
+Tcl_ClassSetConstructor, Tcl_ClassSetDestructor, Tcl_MethodDeclarerClass, Tcl_MethodDeclarerObject, Tcl_MethodIsPublic, Tcl_MethodIsPrivate, Tcl_MethodIsType, Tcl_MethodName, Tcl_NewInstanceMethod, Tcl_NewMethod, Tcl_ObjectContextInvokeNext, Tcl_ObjectContextIsFiltering, Tcl_ObjectContextMethod, Tcl_ObjectContextObject, Tcl_ObjectContextSkippedArgs \- manipulate methods and method-call contexts
.SH SYNOPSIS
.nf
\fB#include <tclOO.h>\fR
.sp
Tcl_Method
-\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, isPublic,
- methodTypePtr, clientData\fR)
+\fBTcl_NewMethod\fR(\fIinterp, class, nameObj, flags, methodTypePtr,
+ clientData\fR)
.sp
Tcl_Method
-\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, isPublic,
- methodTypePtr, clientData\fR)
+\fBTcl_NewInstanceMethod\fR(\fIinterp, object, nameObj, flags, methodTypePtr,
+ clientData\fR)
.sp
\fBTcl_ClassSetConstructor\fR(\fIinterp, class, method\fR)
.sp
@@ -35,8 +35,13 @@ Tcl_Object
Tcl_Obj *
\fBTcl_MethodName\fR(\fImethod\fR)
.sp
+.VS TIP500
int
\fBTcl_MethodIsPublic\fR(\fImethod\fR)
+.VE TIP500
+.sp
+int
+\fBTcl_MethodIsPrivate\fR(\fImethod\fR)
.sp
int
\fBTcl_MethodIsType\fR(\fImethod, methodTypePtr, clientDataPtr\fR)
@@ -66,10 +71,15 @@ The class to create the method in.
.AP Tcl_Obj *nameObj in
The name of the method to create. Should not be NULL unless creating
constructors or destructors.
-.AP int isPublic in
-A flag saying what the visibility of the method is. The only supported public
-values of this flag are 0 for a non-exported method, and 1 for an exported
-method.
+.AP int flags in
+A flag saying (currently) what the visibility of the method is. The supported
+public values of this flag are \fBTCL_OO_METHOD_PUBLIC\fR (which is fixed at 1
+for backward compatibility) for an exported method,
+\fBTCL_OO_METHOD_UNEXPORTED\fR (which is fixed at 0 for backward
+compatibility) for a non-exported method,
+.VS TIP500
+and \fBTCL_OO_METHOD_PRIVATE\fR for a private method.
+.VE TIP500
.AP Tcl_MethodType *methodTypePtr in
A description of the type of the method to create, or the type of method to
compare against.
@@ -105,8 +115,12 @@ Given a method, the entity that declared it can be found using
attached to (or NULL if the method is not attached to any class) and
\fBTcl_MethodDeclarerObject\fR which returns the object that the method is
attached to (or NULL if the method is not attached to an object). The name of
-the method can be retrieved with \fBTcl_MethodName\fR and whether the method
-is exported is retrieved with \fBTcl_MethodIsPublic\fR. The type of the method
+the method can be retrieved with \fBTcl_MethodName\fR, whether the method
+is exported is retrieved with \fBTcl_MethodIsPublic\fR,
+.VS TIP500
+and whether the method is private is retrieved with \fBTcl_MethodIsPrivate\fR.
+.VE TIP500
+The type of the method
can also be introspected upon to a limited degree; the function
\fBTcl_MethodIsType\fR returns whether a method is of a particular type,
assigning the per-method \fIclientData\fR to the variable pointed to by
@@ -117,8 +131,12 @@ Methods are created by \fBTcl_NewMethod\fR and \fBTcl_NewInstanceMethod\fR,
which
create a method attached to a class or an object respectively. In both cases,
the \fInameObj\fR argument gives the name of the method to create, the
-\fIisPublic\fR argument states whether the method should be exported
-initially, the \fImethodTypePtr\fR argument describes the implementation of
+\fIflags\fR argument states whether the method should be exported
+initially
+.VS TIP500
+or be marked as a private method,
+.VE TIP500
+the \fImethodTypePtr\fR argument describes the implementation of
the method (see the \fBMETHOD TYPES\fR section below) and the \fIclientData\fR
argument gives some implementation-specific data that is passed on to the
implementation of the method when it is called.
diff --git a/doc/NRE.3 b/doc/NRE.3
index 6078a53..6024b6a 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -1,6 +1,6 @@
.\"
.\" Copyright (c) 2008 by Kevin B. Kenny.
-.\" Copyright (c) 2018 by Nathan Coulter.
+.\" Copyright (c) 2018 by Nathan Coulter.
.\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/doc/Namespace.3 b/doc/Namespace.3
index be89597..a037442 100644
--- a/doc/Namespace.3
+++ b/doc/Namespace.3
@@ -3,10 +3,10 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
'\" Note that some of these functions do not seem to belong, but they
'\" were all introduced with the same TIP (#139)
-'\"
+'\"
.TH Tcl_Namespace 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/OpenTcp.3 b/doc/OpenTcp.3
index 9fe2615..5b941dc 100644
--- a/doc/OpenTcp.3
+++ b/doc/OpenTcp.3
@@ -4,12 +4,12 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.TH Tcl_OpenTcpClient 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_OpenTcpClient 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer \- procedures to open channels using TCP sockets
+Tcl_OpenTcpClient, Tcl_MakeTcpClientChannel, Tcl_OpenTcpServer, Tcl_OpenTcpServerEx \- procedures to open channels using TCP sockets
.SH SYNOPSIS
.nf
\fB#include <tcl.h> \fR
@@ -23,6 +23,9 @@ Tcl_Channel
Tcl_Channel
\fBTcl_OpenTcpServer\fR(\fIinterp, port, myaddr, proc, clientData\fR)
.sp
+Tcl_Channel
+\fBTcl_OpenTcpServerEx\fR(\fIinterp, service, myaddr, flags, proc, clientData\fR)
+.sp
.SH ARGUMENTS
.AS Tcl_TcpAcceptProc clientData
.AP Tcl_Interp *interp in
@@ -30,6 +33,9 @@ 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 "const char" *service in
+A string specifying the port number to connect to as a client or to listen on as
+ a server.
.AP "const char" *host in
A string specifying a host name or address for the remote end of the connection.
.AP int myport in
@@ -41,6 +47,9 @@ for the local end of the connection. If NULL, a default interface is
chosen.
.AP int async in
If nonzero, the client socket is connected asynchronously to the server.
+.AP "unsigned int" flags in
+ORed combination of \fBTCL_TCPSERVER\fR flags that specify additional
+informations about the socket being created.
.AP ClientData sock in
Platform-specific handle for client TCP socket.
.AP Tcl_TcpAcceptProc *proc in
@@ -130,7 +139,7 @@ for the new channel, \fIhostName\fR points to a string containing
the name of the client host making the connection, and \fIport\fR
will contain the client's port number.
The new channel
-is opened for both input and output.
+is opened for both input and output.
If \fIproc\fR raises an error, the connection is closed automatically.
\fIProc\fR has no return value, but if it wishes to reject the
connection it can close \fIchannel\fR.
@@ -158,6 +167,11 @@ register it, use \fBTcl_RegisterChannel\fR.
If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.
+.SS TCL_OPENTCPSERVEREX
+.PP
+\fBTcl_OpenTcpServerEx\fR behaviour is identical to \fBTcl_OpenTcpServer\fR but
+gives more flexibility to the user by providing a mean to further customize some
+aspects of the socket via the \fIflags\fR parameter.
.SH "PLATFORM ISSUES"
.PP
On Unix platforms, the socket handle is a Unix file descriptor as
diff --git a/doc/Panic.3 b/doc/Panic.3
index af86665..ba39ddf 100644
--- a/doc/Panic.3
+++ b/doc/Panic.3
@@ -7,7 +7,7 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc \- report fatal error and abort
+Tcl_Panic, Tcl_PanicVA, Tcl_SetPanicProc, Tcl_ConsolePanic \- report fatal error and abort
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -21,6 +21,9 @@ void
void
\fBTcl_SetPanicProc\fR(\fIpanicProc\fR)
.sp
+void
+\fBTcl_ConsolePanic\fR(\fIformat\fR, \fIarg\fR, \fIarg\fR, \fI...\fR)
+.sp
.SH ARGUMENTS
.AS Tcl_PanicProc *panicProc
.AP "const char*" format in
@@ -54,6 +57,14 @@ message is sent to the debugger in stead. If the windows executable
does not have a stderr channel (e.g. \fBwish.exe\fR), then a
system dialog box is used to display the panic message.
.PP
+If your application doesn't use \fBTcl_Main\fR or \fBTk_Main\fR
+and you want to implicitly use the stderr channel of your
+application's C runtime (in stead of the stderr channel of the
+C runtime used by Tcl), you can call \fBTcl_SetPanicProc\fR
+with \fBTcl_ConsolePanic\fR as its argument. On platforms which
+only have one C runtime (almost all platforms except Windows)
+\fBTcl_ConsolePanic\fR is equivalent to NULL.
+.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:
@@ -82,7 +93,11 @@ 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.
+taking a variable number of arguments it takes an argument list. This
+function is deprecated and will be removed in Tcl 9.0.
+.PP
+This function can not be used in stub-enabled extensions. Its symbol
+entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH "SEE ALSO"
abort(3), printf(3), exec(n), format(n)
.SH KEYWORDS
diff --git a/doc/Preserve.3 b/doc/Preserve.3
index 970bded..c8f34a2 100644
--- a/doc/Preserve.3
+++ b/doc/Preserve.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_Preserve 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/PrintDbl.3 b/doc/PrintDbl.3
index 730794f..896b6eb 100644
--- a/doc/PrintDbl.3
+++ b/doc/PrintDbl.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_PrintDouble 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/RecEvalObj.3 b/doc/RecEvalObj.3
index 387cc44..f9550a2 100644
--- a/doc/RecEvalObj.3
+++ b/doc/RecEvalObj.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_RecordAndEvalObj 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
@@ -32,8 +32,6 @@ the command at global level instead of the current stack level.
.PP
\fBTcl_RecordAndEvalObj\fR is invoked to record a command as an event
on the history list and then execute it using \fBTcl_EvalObjEx\fR
-(or \fBTcl_GlobalEvalObj\fR if the \fBTCL_EVAL_GLOBAL\fR bit is set
-in \fIflags\fR).
It returns a completion code such as \fBTCL_OK\fR just like \fBTcl_EvalObjEx\fR,
as well as a result value containing additional information
(a result value or error message)
diff --git a/doc/RecordEval.3 b/doc/RecordEval.3
index e1625ff..36ef6b9 100644
--- a/doc/RecordEval.3
+++ b/doc/RecordEval.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_RecordAndEval 3 7.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 6dd6cb6..e62d22d 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -1,6 +1,7 @@
'\"
'\" Copyright (c) 1997 by Sun Microsystems, Inc.
'\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
+'\" Copyright (c) 2018 Nathan Coulter.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -9,7 +10,9 @@
.so man.macros
.BS
.SH NAME
-Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state
+Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState,
+Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the
+state of an an interpreter.
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
@@ -30,91 +33,53 @@ int
.SH ARGUMENTS
.AS Tcl_InterpState savedPtr
.AP Tcl_Interp *interp in
-Interpreter for which state should be saved.
+The interpreter for the operation.
.AP int status in
-Return code value to save as part of interpreter state.
+The return code for the state.
.AP Tcl_InterpState state in
-Saved state token to be restored or discarded.
+A token for saved state.
.AP Tcl_SavedResult *savedPtr in
-Pointer to location where interpreter result should be saved or restored.
+A pointer to storage for saved state.
.BE
.SH DESCRIPTION
.PP
-These routines allows a C procedure to take a snapshot of the current
-state of an interpreter so that it can be restored after a call
-to \fBTcl_Eval\fR or some other routine that modifies the interpreter
-state. There are two triplets of routines meant to work together.
+These routines save the state of an interpreter before a call to a routine such
+as \fBTcl_Eval\fR, and restore the state afterwards.
.PP
-The first triplet stores the snapshot of interpreter state in
-an opaque token returned by \fBTcl_SaveInterpState\fR. That token
-value may then be passed back to one of \fBTcl_RestoreInterpState\fR
-or \fBTcl_DiscardInterpState\fR, depending on whether the interp
-state is to be restored. So long as one of the latter two routines
-is called, Tcl will take care of memory management.
+\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the
+result of a script, including the resulting value, the return code passed as
+\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR.
+It returns a token for the saved state. The interpreter result is not reset
+and no interpreter state is changed.
.PP
-The second triplet stores the snapshot of only the interpreter
-result (not its complete state) in memory allocated by the caller.
-These routines are passed a pointer to \fBTcl_SavedResult\fR
-that is used to store enough information to restore the interpreter result.
-\fBTcl_SavedResult\fR can be allocated on the stack of the calling
-procedure. These routines do not save the state of any error
-information in the interpreter (e.g. the \fB\-errorcode\fR or
-\fB\-errorinfo\fR return options, when an error is in progress).
+\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and
+returns the \fIstatus\fR originally passed in the corresponding call to
+\fBTcl_SaveInterpState\fR.
.PP
-Because the routines \fBTcl_SaveInterpState\fR,
-\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform
-a superset of the functions provided by the other routines,
-any new code should only make use of the more powerful routines.
-The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
-and \fBTcl_DiscardResult\fR continue to exist only for the sake
-of existing programs that may already be using them.
+If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called
+to release it. A token used to discard or restore state must not be used
+again.
.PP
-\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
-interpreter state that make up the full result of script evaluation.
-This include the interpreter result, the return code (passed in
-as the \fIstatus\fR argument, and any return options, including
-\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
-This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
-The call to \fBTcl_SaveInterpState\fR does not itself change the
-state of the interpreter. Unlike \fBTcl_SaveResult\fR, it does
-not reset the interpreter.
+\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are
+deprecated. Instead use \fBTcl_SaveInterpState\fR,
+\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more
+capable.
.PP
-\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token
-previously returned by \fBTcl_SaveInterpState\fR and restores the
-state of the interp to the state held in that snapshot. The return
-value of \fBTcl_RestoreInterpState\fR is the status value originally
-passed to \fBTcl_SaveInterpState\fR when the snapshot token was
-created.
+\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location
+\fIstatePtr\fR points to and returns the interpreter result to its initial
+state. It does not save options such as \fB\-errorcode\fR or
+\fB\-errorinfo\fR.
.PP
-\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR
-token previously returned by \fBTcl_SaveInterpState\fR when that
-snapshot is not to be restored to an interp.
-.PP
-The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR
-must eventually be passed to either \fBTcl_RestoreInterpState\fR
-or \fBTcl_DiscardInterpState\fR to avoid a memory leak. Once
-the \fBTcl_InterpState\fR token is passed to one of them, the
-token is no longer valid and should not be used anymore.
-.PP
-\fBTcl_SaveResult\fR moves the string and value results
-of \fIinterp\fR into the location specified by \fIstatePtr\fR.
-\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
-leaves the result in its normal empty initialized state.
-.PP
-\fBTcl_RestoreResult\fR moves the string and value results from
-\fIstatePtr\fR back into \fIinterp\fR. Any result or error that was
-already in the interpreter will be cleared. The \fIstatePtr\fR is left
-in an uninitialized state and cannot be used until another call to
+\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and
+moves the result from \fIstatePtr\fR back to \fIinterp\fR. \fIstatePtr\fR is
+then in an undefined state and must not be used until passed again to
\fBTcl_SaveResult\fR.
.PP
-\fBTcl_DiscardResult\fR releases the saved interpreter state
-stored at \fBstatePtr\fR. The state structure is left in an
-uninitialized state and cannot be used until another call to
+\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is
+then in an undefined state and must not be used until passed again to
\fBTcl_SaveResult\fR.
.PP
-Once \fBTcl_SaveResult\fR is called to save the interpreter
-result, either \fBTcl_RestoreResult\fR or
-\fBTcl_DiscardResult\fR must be called to properly clean up the
-memory associated with the saved state.
+If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to
+release it.
.SH KEYWORDS
result, state, interp
diff --git a/doc/SetErrno.3 b/doc/SetErrno.3
index 21648b1..c202e2e 100644
--- a/doc/SetErrno.3
+++ b/doc/SetErrno.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_SetErrno 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/SetRecLmt.3 b/doc/SetRecLmt.3
index 904d4ab..ec55794 100644
--- a/doc/SetRecLmt.3
+++ b/doc/SetRecLmt.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_SetRecursionLimit 3 7.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Signal.3 b/doc/Signal.3
index 70b9d91..0a280f9 100644
--- a/doc/Signal.3
+++ b/doc/Signal.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_SignalId 3 8.3 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Sleep.3 b/doc/Sleep.3
index 2d36697..656d72a 100644
--- a/doc/Sleep.3
+++ b/doc/Sleep.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_Sleep 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/SplitList.3 b/doc/SplitList.3
index 3439f2e..d19ca14 100644
--- a/doc/SplitList.3
+++ b/doc/SplitList.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_SplitList 3 8.0 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/SplitPath.3 b/doc/SplitPath.3
index 19cee05..c011194 100644
--- a/doc/SplitPath.3
+++ b/doc/SplitPath.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_SplitPath 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/StaticPkg.3 b/doc/StaticPkg.3
index 5700ea7..8d04cd1 100644
--- a/doc/StaticPkg.3
+++ b/doc/StaticPkg.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
@@ -64,6 +64,9 @@ the event of an error it should set the interpreter's result to point to an
error message. The result or error from the initialization procedure will
be returned as the result of the \fBload\fR command that caused the
initialization procedure to be invoked.
+.PP
+This function can not be used in stub-enabled extensions. Its symbol
+entry in the stub table is deprecated and it will be removed in Tcl 9.0.
.SH KEYWORDS
initialization procedure, package, static linking
.SH "SEE ALSO"
diff --git a/doc/StdChannels.3 b/doc/StdChannels.3
index 651ad7d..7cb75a0 100644
--- a/doc/StdChannels.3
+++ b/doc/StdChannels.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH "Standard Channels" 3 7.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/StrMatch.3 b/doc/StrMatch.3
index f9c2be3..d664067 100644
--- a/doc/StrMatch.3
+++ b/doc/StrMatch.3
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_StringMatch 3 8.5 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index 7042cc8..e011c27 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -37,7 +37,7 @@ Tcl_UniChar *
Tcl_UniChar *
\fBTcl_GetUnicode\fR(\fIobjPtr\fR)
.sp
-Tcl_UniChar
+int
\fBTcl_GetUniChar\fR(\fIobjPtr, index\fR)
.sp
int
@@ -204,7 +204,8 @@ 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
-value's Unicode representation.
+value's Unicode representation. If the index is out of range or
+it references a low surrogate preceded by a high surrogate, it returns -1;
.PP
\fBTcl_GetRange\fR returns a newly created value comprised of the
characters between \fIfirst\fR and \fIlast\fR (inclusive) in the
diff --git a/doc/SubstObj.3 b/doc/SubstObj.3
index f582c5a..a2b6214 100644
--- a/doc/SubstObj.3
+++ b/doc/SubstObj.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH Tcl_SubstObj 3 8.4 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/TCL_MEM_DEBUG.3 b/doc/TCL_MEM_DEBUG.3
index e3a6809..3a014d4 100644
--- a/doc/TCL_MEM_DEBUG.3
+++ b/doc/TCL_MEM_DEBUG.3
@@ -1,8 +1,8 @@
-'\"
+'\"
'\" Copyright (c) 1992-1999 Karl Lehenbauer and Mark Diekhans.
'\" Copyright (c) 2000 by Scriptics Corporation.
'\" All rights reserved.
-'\"
+'\"
.TH TCL_MEM_DEBUG 3 8.1 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/TclZlib.3 b/doc/TclZlib.3
index c6a6417..4a5df89 100644
--- a/doc/TclZlib.3
+++ b/doc/TclZlib.3
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH TclZlib 3 8.6 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index 3ec33d1..816dfeb 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -189,6 +189,8 @@ procedure (if any) returns. In non-interactive mode, after
\fBTcl_Main\fR evaluates the startup script, and the main loop
procedure (if any) returns, \fBTcl_Main\fR will also evaluate
the \fBexit\fR command.
+.PP
+This function can not be used in stub-enabled extensions.
.SH "SEE ALSO"
tclsh(1), Tcl_GetStdChannel(3), Tcl_StandardChannels(3), Tcl_AppInit(3),
exit(n), encoding(n)
diff --git a/doc/Thread.3 b/doc/Thread.3
index 5966a71..2005c93 100644
--- a/doc/Thread.3
+++ b/doc/Thread.3
@@ -45,7 +45,9 @@ int
.AP Tcl_Condition *condPtr in
A condition variable, which must be associated with a mutex lock.
.AP Tcl_Mutex *mutexPtr in
-A mutex lock.
+.VS TIP509
+A recursive mutex lock.
+.VE TIP509
.AP "const Tcl_Time" *timePtr in
A time limit on the condition wait. NULL to wait forever.
Note that a polling value of 0 seconds does not make much sense.
@@ -140,8 +142,12 @@ of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
block until \fBTcl_MutexUnlock\fR is called.
A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
-The result of locking a mutex twice from the same thread is undefined.
-On some platforms it will result in a deadlock.
+.VS TIP509
+Mutexes are reentrant: they can be locked several times from the same
+thread. However there must be exactly one call to
+\fBTcl_MutexUnlock\fR for each call to \fBTcl_MutexLock\fR in order
+for a thread to release a mutex completely.
+.VE TIP509
The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
procedures are defined as empty macros if not compiling with threads enabled.
For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.
diff --git a/doc/ToUpper.3 b/doc/ToUpper.3
index be614e7..1c7a0c2 100644
--- a/doc/ToUpper.3
+++ b/doc/ToUpper.3
@@ -13,13 +13,13 @@ Tcl_UniCharToUpper, Tcl_UniCharToLower, Tcl_UniCharToTitle, Tcl_UtfToUpper, Tcl_
.nf
\fB#include <tcl.h>\fR
.sp
-Tcl_UniChar
+int
\fBTcl_UniCharToUpper\fR(\fIch\fR)
.sp
-Tcl_UniChar
+int
\fBTcl_UniCharToLower\fR(\fIch\fR)
.sp
-Tcl_UniChar
+int
\fBTcl_UniCharToTitle\fR(\fIch\fR)
.sp
int
diff --git a/doc/UniCharIsAlpha.3 b/doc/UniCharIsAlpha.3
index 5ba3fc9..61490ed 100644
--- a/doc/UniCharIsAlpha.3
+++ b/doc/UniCharIsAlpha.3
@@ -48,7 +48,7 @@ int
.SH ARGUMENTS
.AS int ch
.AP int ch in
-The Tcl_UniChar to be examined.
+The Unicode character to be examined.
.BE
.SH DESCRIPTION
diff --git a/doc/Utf.3 b/doc/Utf.3
index 9d0c617..afcff79 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -63,7 +63,7 @@ const char *
const char *
\fBTcl_UtfPrev\fR(\fIsrc, start\fR)
.sp
-Tcl_UniChar
+int
\fBTcl_UniCharAtIndex\fR(\fIsrc, index\fR)
.sp
const char *
@@ -121,8 +121,8 @@ case-insensitive (1).
.SH DESCRIPTION
.PP
-These routines convert between UTF-8 strings and Tcl_UniChars. A
-Tcl_UniChar is a Unicode character represented as an unsigned, fixed-size
+These routines convert between UTF-8 strings and Unicode characters. An
+Unicode character represented as an unsigned, fixed-size
quantity. A UTF-8 character is a Unicode character represented as
a varying-length sequence of up to \fBTCL_UTF_MAX\fR bytes. A multibyte UTF-8
sequence consists of a lead byte followed by some number of trail bytes.
@@ -130,9 +130,12 @@ sequence consists of a lead byte followed by some number of trail bytes.
\fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
represent one Unicode character in the UTF-8 representation.
.PP
-\fBTcl_UniCharToUtf\fR stores the Tcl_UniChar \fIch\fR as a UTF-8 string
+\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
in starting at \fIbuf\fR. The return value is the number of bytes stored
-in \fIbuf\fR.
+in \fIbuf\fR. If ch is a high surrogate (range U+D800 - U+DBFF), then
+the return value will be 0 and nothing will be stored. If you still
+want to produce UTF-8 output for it (even though knowing it's an illegal
+code-point on its own), just call \fBTcl_UniCharToUtf\fR again using ch = -1.
.PP
\fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
and stores it as a Tcl_UniChar in \fI*chPtr\fR. The return value is the
@@ -140,6 +143,9 @@ number of bytes read from \fIsrc\fR. The caller must ensure that the
source buffer is long enough such that this routine does not run off the
end and dereference non-existent or random memory; if the source buffer
is known to be null-terminated, this will not happen. If the input is
+a byte in the range 0x80 - 0x9F, \fBTcl_UtfToUniChar\fR assumes the
+cp1252 encoding, stores the corresponding Tcl_UniChar in \fI*chPtr\fR
+and returns 1. If the input is otherwise
not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x0000 and
0x00ff and return 1.
@@ -200,7 +206,7 @@ of \fIlength\fR bytes is long enough to be decoded by
\fBTcl_UtfToUniChar\fR, or 0 otherwise. This function does not guarantee
that the UTF-8 string is properly formed. This routine is used by
procedures that are operating on a byte at a time and need to know if a
-full Tcl_UniChar has been seen.
+full Unicode character has been seen.
.PP
\fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings. It
returns the number of Tcl_UniChars that are represented by the UTF-8 string
@@ -208,12 +214,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 occurrence of the Tcl_UniChar \fIch\fR
+returns a pointer to the first occurrence of the Unicode character \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 occurrence of the Tcl_UniChar \fIch\fR
+returns a pointer to the last occurrence of the Unicode character \fIch\fR
in the null-terminated UTF-8 string \fIsrc\fR. The null terminator is
considered part of the UTF-8 string.
.PP
diff --git a/doc/abstract.n b/doc/abstract.n
new file mode 100644
index 0000000..022c24b
--- /dev/null
+++ b/doc/abstract.n
@@ -0,0 +1,77 @@
+'\"
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH abstract n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::abstract \- a class that does not allow direct instances of itself
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::abstract\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+ \(-> \fBoo::class\fR
+ \(-> \fBoo::abstract\fR
+.fi
+.BE
+.SH DESCRIPTION
+Abstract classes are classes that can contain definitions, but which cannot be
+directly manufactured; they are intended to only ever be inherited from and
+instantiated indirectly. The characteristic methods of \fBoo::class\fR
+(\fBcreate\fR and \fBnew\fR) are not exported by an instance of
+\fBoo::abstract\fR.
+.PP
+Note that \fBoo::abstract\fR is not itself an instance of \fBoo::abstract\fR.
+.SS CONSTRUCTOR
+The \fBoo::abstract\fR class does not define an explicit constructor; this
+means that it is effectively the same as the constructor of the
+\fBoo::class\fR class.
+.SS DESTRUCTOR
+The \fBoo::abstract\fR class does not define an explicit destructor;
+destroying an instance of it is just like destroying an ordinary class (and
+will destroy all its subclasses).
+.SS "EXPORTED METHODS"
+The \fBoo::abstract\fR class defines no new exported methods.
+.SS "NON-EXPORTED METHODS"
+The \fBoo::abstract\fR class explicitly states that \fBcreate\fR,
+\fBcreateWithNamespace\fR, and \fBnew\fR are unexported.
+.SH EXAMPLES
+.PP
+This example defines a simple class hierarchy and creates a new instance of
+it. It then invokes a method of the object before destroying the hierarchy and
+showing that the destruction is transitive.
+.PP
+.CS
+\fBoo::abstract\fR create fruit {
+ method eat {} {
+ puts "yummy!"
+ }
+}
+oo::class create banana {
+ superclass fruit
+ method peel {} {
+ puts "skin now off"
+ }
+}
+set b [banana \fBnew\fR]
+$b peel \fI\(-> prints 'skin now off'\fR
+$b eat \fI\(-> prints 'yummy!'\fR
+set f [fruit new] \fI\(-> error 'unknown method "new"...'\fR
+.CE
+.SH "SEE ALSO"
+oo::define(n), oo::object(n)
+.SH KEYWORDS
+abstract class, class, metaclass, object
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/append.n b/doc/append.n
index e3bf224..99b4ece 100644
--- a/doc/append.n
+++ b/doc/append.n
@@ -20,6 +20,11 @@ Append all of the \fIvalue\fR arguments to the current value
of variable \fIvarName\fR. If \fIvarName\fR does not exist,
it is given a value equal to the concatenation of all the
\fIvalue\fR arguments.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, the concatenation of the default value and all the
+\fIvalue\fR arguments will be stored in the array element.
+.VE TIP508
The result of this command is the new value stored in variable
\fIvarName\fR.
This command provides an efficient way to build up long
@@ -44,6 +49,7 @@ puts $var
concat(n), lappend(n)
.SH KEYWORDS
append, variable
-'\" Local Variables:
-'\" mode: nroff
-'\" End:
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/array.n b/doc/array.n
index 25ad0c6..bbfcd9f 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,7 +5,7 @@
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\"
-.TH array n 8.3 Tcl "Tcl Built-In Commands"
+.TH array n 8.7 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
'\" Note: do not modify the .SH NAME line immediately below!
@@ -36,6 +36,53 @@ with an empty name, since the return value from
\fBarray nextelement\fR will not indicate whether the search
has been completed.
.TP
+\fBarray default \fIsubcommand arrayName args...\fR
+.VS TIP508
+Manages the default value of the array. Arrays initially have no default
+value, but this command allows you to set one; the default value will be
+returned when reading from an element of the array \farrayName\fR if the read
+would otherwise result in an error. Note that this may cause the \fBappend\fR,
+\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
+relation to non-existing array elements.
+.RS
+.PP
+The \fIsubcommand\fR argument controls what exact operation will be performed
+on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
+.VE TIP508
+.TP
+\fBarray default exists \fIarrayName\fR
+.VS TIP508
+This returns a boolean value indicating whether a default value has been set
+for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
+not exist. Raises an error if \fIarrayName\fR is an existing variable that is
+not an array.
+.VE TIP508
+.TP
+\fBarray default get \fIarrayName\fR
+.VS TIP508
+This returns the current default value for the array \fIarrayName\fR. Raises
+an error if \fIarrayName\fR is an existing variable that is not an array, or
+if \fIarrayName\fR is an array without a default value.
+.VE TIP508
+.TP
+\fBarray default set \fIarrayName value\fR
+.VS TIP508
+This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
+Returns the empty string. Raises an error if \fIarrayName\fR is an existing
+variable that is not an array, or if \fIarrayName\fR is an illegal name for an
+array. If \fIarrayName\fR does not currently exist, it is created as an empty
+array as well as having its default value set.
+.VE TIP508
+.TP
+\fBarray default unset \fIarrayName\fR
+.VS TIP508
+This removes the default value for the array \fIarrayName\fR and returns the
+empty string. Does nothing if \fIarrayName\fR does not have a default
+value. Raises an error if \fIarrayName\fR is an existing variable that is not
+an array.
+.VE TIP508
+.RE
+.TP
\fBarray donesearch \fIarrayName searchId\fR
This command terminates an array search and destroys all the
state associated with that search. \fISearchId\fR indicates
@@ -47,6 +94,15 @@ been the return value from a previous invocation of
Returns 1 if \fIarrayName\fR is an array variable, 0 if there
is no variable by that name or if it is a scalar variable.
.TP
+\fBarray for {\fIkeyVariable valueVariable\fB} \fIarrayName body\fP
+The first argument is a two element list of variable names for the
+key and value of each entry in the array. The second argument is the
+array name to iterate over. The third argument is the body to execute
+for each key and value returned.
+The ordering of the returned keys is undefined.
+If an array element is deleted or a new array element is inserted during
+the \fIarray for\fP process, the command will terminate with an error.
+.TP
\fBarray get \fIarrayName\fR ?\fIpattern\fR?
Returns a list containing pairs of elements. The first
element in each pair is the name of an element in \fIarrayName\fR
@@ -185,3 +241,7 @@ foreach color [lsort [\fBarray names\fR colorcount]] {
list(n), string(n), variable(n), trace(n), foreach(n)
.SH KEYWORDS
array, element names, search
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/break.n b/doc/break.n
index 3e4ce5f..78fd005 100644
--- a/doc/break.n
+++ b/doc/break.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH break n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/callback.n b/doc/callback.n
new file mode 100644
index 0000000..95838a9
--- /dev/null
+++ b/doc/callback.n
@@ -0,0 +1,88 @@
+'\"
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH callback n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+callback, mymethod \- generate callbacks to methods
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
+\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBcallback\fR command,
+'\" Based on notes in the tcllib docs, we know the provenance of mymethod
+also called \fBmymethod\fR for compatibility with the ooutil and snit packages
+of Tcllib,
+and which should only be used from within the context of a call to a method
+(i.e. inside a method, constructor or destructor body) is used to generate a
+script fragment that will invoke the method, \fImethodName\fR, on the current
+object (as reported by \fBself\fR) when executed. Any additional arguments
+provided will be provided as leading arguments to the callback. The resulting
+script fragment shall be a proper list.
+.PP
+Note that it is up to the caller to ensure that the current object is able to
+handle the call of \fImethodName\fR; this command does not check that.
+\fImethodName\fR may refer to any exported or unexported method, but may not
+refer to a private method as those can only be invoked directly from within
+methods. If there is no such method present at the point when the callback is
+invoked, the standard \fBunknown\fR method handler will be called.
+.SH EXAMPLE
+This is a simple echo server class. The \fBcallback\fR command is used in two
+places, to arrange for the incoming socket connections to be handled by the
+\fIAccept\fR method, and to arrange for the incoming bytes on those
+connections to be handled by the \fIReceive\fR method.
+.PP
+.CS
+oo::class create EchoServer {
+ variable server clients
+ constructor {port} {
+ set server [socket -server [\fBcallback\fR Accept] $port]
+ set clients {}
+ }
+ destructor {
+ chan close $server
+ foreach client [dict keys $clients] {
+ chan close $client
+ }
+ }
+
+ method Accept {channel clientAddress clientPort} {
+ dict set clients $channel [dict create \e
+ address $clientAddress port $clientPort]
+ chan event $channel readable [\fBcallback\fR Receive $channel]
+ }
+ method Receive {channel} {
+ if {[chan gets $channel line] >= 0} {
+ my echo $channel $line
+ } else {
+ chan close $channel
+ dict unset clients $channel
+ }
+ }
+
+ method echo {channel line} {
+ dict with clients $channel {
+ chan puts $channel \e
+ [format {[%s:%d] %s} $address $port $line]
+ }
+ }
+}
+.CE
+.SH "SEE ALSO"
+chan(n), fileevent(n), my(n), self(n), socket(n), trace(n)
+.SH KEYWORDS
+callback, object
+.\" Local Variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/case.n b/doc/case.n
index 54d5bf4..c48d634 100644
--- a/doc/case.n
+++ b/doc/case.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH case n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/cd.n b/doc/cd.n
index 67cdd17..8e19191 100644
--- a/doc/cd.n
+++ b/doc/cd.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH cd n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -41,3 +41,7 @@ current one:
filename(n), glob(n), pwd(n)
.SH KEYWORDS
working directory
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/classvariable.n b/doc/classvariable.n
new file mode 100644
index 0000000..0798bb2
--- /dev/null
+++ b/doc/classvariable.n
@@ -0,0 +1,78 @@
+'\"
+'\" Copyright (c) 2011-2015 Andreas Kupries
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH classvariable n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+classvariable \- create link from local variable to variable in class
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBclassvariable\fR command is available within methods. It takes a series
+of one or more variable names and makes them available in the method's scope;
+those variable names must not be qualified and must not refer to array
+elements. The originating scope for the variables is the namespace of the
+class that the method was defined by. In other words, the referenced variables
+are shared between all instances of that class.
+.PP
+Note: This command is equivalent to the command \fBtypevariable\fR provided by
+the snit package in tcllib for approximately the same purpose. If used in a
+method defined directly on a class instance (e.g., through the
+\fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just
+using:
+.PP
+.CS
+namespace upvar [namespace current] $var $var
+.CE
+.PP
+for each variable listed to \fBclassvariable\fR.
+.SH EXAMPLE
+This class counts how many instances of it have been made.
+.PP
+.CS
+oo::class create Counted {
+ initialise {
+ variable count 0
+ }
+
+ variable number
+ constructor {} {
+ \fBclassvariable\fR count
+ set number [incr count]
+ }
+
+ method report {} {
+ \fBclassvariable\fR count
+ puts "This is instance $number of $count"
+ }
+}
+
+set a [Counted new]
+set b [Counted new]
+$a report
+ \fI\(-> This is instance 1 of 2\fR
+set c [Counted new]
+$b report
+ \fI\(-> This is instance 2 of 3\fR
+$c report
+ \fI\(-> This is instance 3 of 3\fR
+.CE
+.SH "SEE ALSO"
+global(n), namespace(n), oo::class(n), oo::define(n), upvar(n), variable(n)
+.SH KEYWORDS
+class, class variable, variable
+.\" Local Variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/clock.n b/doc/clock.n
index 6efa722..a85f29f 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -89,10 +89,9 @@ have 59 or 61 seconds.
.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
-\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
-any unique prefix of such a word. Used in conjunction with \fIcount\fR
-to identify an interval of time, for example, \fI3 seconds\fR or
-\fI1 year\fR.
+\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
+Used in conjunction with \fIcount\fR to identify an interval of time,
+for example, \fI3 seconds\fR or \fI1 year\fR.
.SS "OPTIONS"
.TP
\fB\-base\fR time
@@ -175,8 +174,7 @@ given as its first argument. The remaining arguments (other than the
possible \fB\-timezone\fR, \fB\-locale\fR and \fB\-gmt\fR options)
are integers and keywords in alternation, where the keywords are chosen
from \fBseconds\fR, \fBminutes\fR, \fBhours\fR,
-\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
-any unique prefix of such a word.
+\fBdays\fR, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
.PP
Addition of seconds, minutes and hours is fairly straightforward;
the given time increment (times sixty for minutes, or 3600 for hours)
@@ -213,7 +211,8 @@ the given time to a calendar day and time of day in the appropriate
time zone and locale. The requisite number of days (weeks are converted
to days by multiplying by seven) is added to the calendar day, and
the date and time are then converted back to a count of seconds from
-the epoch time.
+the epoch time. The \fBweekdays\fR keyword is similar to \fBdays\fR,
+with the only difference that weekends - Saturdays and Sundays - are skipped.
.PP
Adding and subtracting a given number of days across the point that
the time changes at the start or end of summer time (Daylight Saving Time)
@@ -465,7 +464,7 @@ a Daylight Saving Time change skips over that time, or an ambiguous
time because a Daylight Saving Time change skips back so that the clock
observes the given time twice, and no time zone specifier (\fB%z\fR
or \fB%Z\fR) is present in the format, the time is interpreted as
-if the clock had not changed.
+if the clock had not changed.
.SH "FORMAT GROUPS"
.PP
The following format groups are recognized by the \fBclock scan\fR and
@@ -887,40 +886,46 @@ The \fIinputString\fR argument consists of zero or more specifications of the
following form:
.TP
\fItime\fR
-A time of day, which is of the form: \fBhh?:mm?:ss?? ?meridian? ?zone?\fR
-or \fBhhmm ?meridian? ?zone?\fR
-If no meridian is specified, \fBhh\fR is interpreted on
+.
+A time of day, which is of the form:
+.QW "\fIhh\fR?\fB:\fImm\fR?\fB:\fIss\fR?? ?\fImeridian\fR? ?\fIzone\fR?"
+or
+.QW "\fBhhmm \fR?\fBmeridian\fR? ?\fBzone\fR?" .
+If no \fImeridian\fR is specified, \fIhh\fR is interpreted on
a 24-hour clock.
.TP
\fIdate\fR
+.
A specific month and day with optional year. The
acceptable formats are
-.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
-.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
-.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
-.QW "\fBdd monthname yy\fR" ,
-.QW "?\fBCC\fR?\fByymmdd\fR" ,
+.QW "\fImm\fB/\fIdd\fR?\fB/\fIyy\fR?" ,
+.QW "\fImonthname dd\fR?\fB, \fIyy\fR?" ,
+.QW "\fIday\fB, \fIdd monthname \fR?\fIyy\fR?" ,
+.QW "\fIdd monthname yy\fR" ,
+.QW "?\fICC\fR?\fIyymmdd\fR" ,
and
-.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
+.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" .
The default year is the current year. If the year is less
than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
as 1969-1999. Not all platforms can represent the years 38-70, so
an error may result if these years are used.
.TP
\fIISO 8601 point-in-time\fR
+.
An ISO 8601 point-in-time specification, such as
.QW \fICCyymmdd\fBT\fIhhmmss\fR,
where \fBT\fR is the literal
.QW T ,
.QW "\fICCyymmdd hhmmss\fR" ,
or
-.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
+.QW \fICCyymmdd\fBT\fIhh\fB:\fImm\fB:\fIss\fR .
Note that only these three formats are accepted.
The command does \fInot\fR accept the full range of point-in-time
specifications specified in ISO8601. Other formats can be recognized by
giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
.TP
\fIrelative time\fR
+.
A specification relative to the current time. The format is \fBnumber
unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
\fBmonth\fR, \fBweek\fR, \fBday\fR,
diff --git a/doc/close.n b/doc/close.n
index 63da75b..5daf3e2 100644
--- a/doc/close.n
+++ b/doc/close.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH close n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/concat.n b/doc/concat.n
index 23c6c91..d10f092 100644
--- a/doc/concat.n
+++ b/doc/concat.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH concat n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/continue.n b/doc/continue.n
index 17d16b4..5eca861 100644
--- a/doc/continue.n
+++ b/doc/continue.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH continue n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -23,7 +23,7 @@ exception to occur.
The exception causes the current script to be aborted
out to the innermost containing loop command, which then
continues with the next iteration of the loop.
-Catch exceptions are also handled in a few other situations, such
+Continue exceptions are also handled in a few other situations, such
as the \fBcatch\fR command and the outermost scripts of procedure
bodies.
.SH EXAMPLE
diff --git a/doc/cookiejar.n b/doc/cookiejar.n
new file mode 100644
index 0000000..ac71759
--- /dev/null
+++ b/doc/cookiejar.n
@@ -0,0 +1,217 @@
+'\"
+'\" Copyright (c) 2014-2018 Donal K. Fellows.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH "cookiejar" n 0.1 http "Tcl Bundled Packages"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+cookiejar \- Implementation of the Tcl http package cookie jar protocol
+.SH SYNOPSIS
+.nf
+\fBpackage require\fR \fBcookiejar\fR ?\fB0.1\fR?
+
+\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
+\fB::http::cookiejar create\fR \fIname\fR ?\fIfilename\fR?
+\fB::http::cookiejar new\fR ?\fIfilename\fR?
+
+\fIcookiejar\fR \fBdestroy\fR
+\fIcookiejar\fR \fBforceLoadDomainData\fR
+\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
+\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
+\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
+.fi
+.SH DESCRIPTION
+.PP
+The cookiejar package provides an implementation of the http package's cookie
+jar protocol using an SQLite database. It provides one main command,
+\fB::http::cookiejar\fR, which is a TclOO class that should be instantiated to
+create a cookie jar that manages a particular HTTP session.
+.PP
+The database management policy can be controlled at the package level by the
+\fBconfigure\fR method on the \fB::http::cookiejar\fR class object:
+.TP
+\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
+.
+If neither \fIoptionName\fR nor \fIoptionValue\fR are supplied, this returns a
+copy of the configuration as a Tcl dictionary. If just \fIoptionName\fR is
+supplied, just the value of the named option is returned. If both
+\fIoptionName\fR and \fIoptionValue\fR are given, the named option is changed
+to be the given value.
+.RS
+.PP
+Supported options are:
+.TP
+\fB\-domainfile \fIfilename\fR
+.
+A file (defaulting to within the cookiejar package) with a description of the
+list of top-level domains (e.g., \fB.com\fR or \fB.co.jp\fR). Such domains
+\fImust not\fR accept cookies set upon them. Note that the list of such
+domains is both security-sensitive and \fInot\fR constant and should be
+periodically refetched. Cookie jars maintain their own cache of the domain
+list.
+.TP
+\fB\-domainlist \fIurl\fR
+.
+A URL to fetch the list of top-level domains (e.g., \fB.com\fR or
+\fB.co.jp\fR) from. Such domains \fImust not\fR accept cookies set upon
+them. Note that the list of such domains is both security-sensitive and
+\fInot\fR constant and should be periodically refetched. Cookie jars maintain
+their own cache of the domain list.
+.TP
+\fB\-domainrefresh \fIintervalMilliseconds\fR
+.
+The number of milliseconds between checks of the \fI\-domainlist\fR for new
+domains.
+.TP
+\fB\-loglevel \fIlevel\fR
+.
+The logging level of this package. The logging level must be (in order of
+decreasing verbosity) one of \fBdebug\fR, \fBinfo\fR, \fBwarn\fR, or
+\fBerror\fR.
+.TP
+\fB\-offline \fIflag\fR
+.
+Allows the cookie managment engine to be placed into offline mode. In offline
+mode, the list of domains is read immediately from the file configured in the
+\fB\-domainfile\fR option, and the \fB\-domainlist\fR option is not used; it
+also makes the \fB\-domainrefresh\fR option be effectively ignored.
+.TP
+\fB\-purgeold \fIintervalMilliseconds\fR
+.
+The number of milliseconds between checks of the database for expired
+cookies; expired cookies are deleted.
+.TP
+\fB\-retain \fIcookieCount\fR
+.
+The maximum number of cookies to retain in the database.
+.TP
+\fB\-vacuumtrigger \fIdeletionCount\fR
+.
+A count of the number of persistent cookie deletions to go between vacuuming
+the database.
+.RE
+.PP
+Cookie jar instances may be made with any of the standard TclOO instance
+creation methods (\fBcreate\fR or \fRnew\fR).
+.TP
+\fB::http::cookiejar new\fR ?\fIfilename\fR?
+.
+If a \fIfilename\fR argument is provided, it is the name of a file containing
+an SQLite database that will contain the persistent cookies maintained by the
+cookie jar; the database will be created if the file does not already
+exist. If \fIfilename\fR is not supplied, the database will be held entirely within
+memory, which effectively forces all cookies within it to be session cookies.
+.SS "INSTANCE METHODS"
+.PP
+The following methods are supported on the instances:
+.TP
+\fIcookiejar\fR \fBdestroy\fR
+.
+This is the standard TclOO destruction method. It does \fInot\fR delete the
+SQLite database if it is written to disk. Callers are responsible for ensuring
+that the cookie jar is not in use by the http package at the time of
+destruction.
+.TP
+\fIcookiejar\fR \fBforceLoadDomainData\fR
+.
+This method causes the cookie jar to immediately load (and cache) the domain
+list data. The domain list will be loaded from the \fB\-domainlist\fR
+configured a the package level if that is enabled, and otherwise will be
+obtained from the \fB\-domainfile\fR configured at the package level.
+.TP
+\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
+.
+This method obtains the cookies for a particular HTTP request. \fIThis
+implements the http cookie jar protocol.\fR
+.TP
+\fIcookiejar\fR \fBpolicyAllow\fR \fIoperation domain path\fR
+.
+This method is called by the \fBstoreCookie\fR method to get a decision on
+whether to allow \fIoperation\fR to be performed for the \fIdomain\fR and
+\fIpath\fR. This is checked immediately before the database is updated but
+after the built-in security checks are done, and should return a boolean
+value; if the value is false, the operation is rejected and the database is
+not modified. The supported \fIoperation\fRs are:
+.RS
+.TP
+\fBdelete\fR
+.
+The \fIdomain\fR is seeking to delete a cookie.
+.TP
+\fBsession\fR
+.
+The \fIdomain\fR is seeking to create or update a session cookie.
+.TP
+\fBset\fR
+.
+The \fIdomain\fR is seeking to create or update a persistent cookie (with a
+defined lifetime).
+.PP
+The default implementation of this method just returns true, but subclasses of
+this class may impose their own rules.
+.RE
+.TP
+\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
+.
+This method stores a single cookie from a particular HTTP response. Cookies
+that fail security checks are ignored. \fIThis implements the http cookie jar
+protocol.\fR
+.TP
+\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
+.
+This method looks a cookie by exact host (or domain) matching. If neither
+\fIhost\fR nor \fIkey\fR are supplied, the list of hosts for which a cookie is
+stored is returned. If just \fIhost\fR (which may be a hostname or a domain
+name) is supplied, the list of cookie keys stored for that host is returned.
+If both \fIhost\fR and \fIkey\fR are supplied, the value for that key is
+returned; it is an error if no such host or key match exactly.
+.SH "EXAMPLES"
+.PP
+The simplest way of using a cookie jar is to just permanently configure it at
+the start of the application.
+.PP
+.CS
+package require http
+\fBpackage require cookiejar\fR
+
+set cookiedb ~/.tclcookies.db
+http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]
+
+# No further explicit steps are required to use cookies
+set tok [http::geturl http://core.tcl.tk/]
+.CE
+.PP
+To only allow a particular domain to use cookies, perhaps because you only
+want to enable a particular host to create and manipulate sessions, create a
+subclass that imposes that policy.
+.PP
+.CS
+package require http
+\fBpackage require cookiejar\fR
+
+oo::class create MyCookieJar {
+ superclass \fBhttp::cookiejar\fR
+
+ method \fBpolicyAllow\fR {operation domain path} {
+ return [expr {$domain eq "my.example.com"}]
+ }
+}
+
+set cookiedb ~/.tclcookies.db
+http::configure -cookiejar [MyCookieJar new $cookiedb]
+
+# No further explicit steps are required to use cookies
+set tok [http::geturl http://core.tcl.tk/]
+.CE
+.SH "SEE ALSO"
+http(n), oo::class(n), sqlite3(n)
+.SH KEYWORDS
+cookie, internet, security policy, www
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/copy.n b/doc/copy.n
index 789a76c..706be54 100644
--- a/doc/copy.n
+++ b/doc/copy.n
@@ -33,9 +33,9 @@ as the empty string, a new name is chosen. Names, unless specified, are
chosen with the same algorithm used by the \fBnew\fR method of
\fBoo::class\fR.
.VE TIP473
-The copied object will be of the same class as the source object, and will have
-all its per-object methods copied. If it is a class, it will also have all the
-class methods in the class copied, but it will not have any of its instances
+The copied object will be of the same class as the source object, and will have
+all its per-object methods copied. If it is a class, it will also have all the
+class methods in the class copied, but it will not have any of its instances
copied.
.PP
.VS
diff --git a/doc/coroutine.n b/doc/coroutine.n
index c99f8d3..52775ef 100644
--- a/doc/coroutine.n
+++ b/doc/coroutine.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/define.n b/doc/define.n
index e619728..a84028b 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -1,5 +1,5 @@
'\"
-'\" Copyright (c) 2007 Donal K. Fellows
+'\" Copyright (c) 2007-2018 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -34,11 +34,36 @@ either the \fIdefScript\fR argument or by the \fIsubcommand\fR and following
\fIarg\fR arguments; when the second is present, it is exactly as if all the
arguments from \fIsubcommand\fR onwards are made into a list and that list is
used as the \fIdefScript\fR argument.
-.SS "CONFIGURING CLASSES"
+.PP
+Note that the constructor for \fBoo::class\fR will call \fBoo::define\fR on
+the script argument that it is provided. This is a convenient way to create
+and define a class in one step.
+.SH "CONFIGURING CLASSES"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
.TP
+\fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
+.VS TIP478
+This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
+omitted) promotes an existing method on the class object to be a class
+method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
+the \fBmethod\fR definition, below.
+.RS
+.PP
+Class methods can be called on either the class itself or on the instances of
+that class. When they are called, the current object (see the \fBself\R and
+\fBmy\fR commands) is the class on which they are called or the class of the
+instance on which they are called, depending on whether they are called on the
+class or an instance of the class, respectively. If called on a subclass or
+instance of the subclass, the current object is the subclass.
+.PP
+In a private definition context, the methods as invoked on classes are
+\fInot\fR private, but the methods as invoked on instances of classes are
+private.
+.RE
+.VE TIP478
+.TP
\fBconstructor\fI argList bodyScript\fR
.
This creates or updates the constructor for a class. The formal arguments to
@@ -49,13 +74,11 @@ namespace of the constructor will be a namespace that is unique to the object
being constructed. Within the constructor, the \fBnext\fR command should be
used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
string, the constructor will be deleted.
-.TP
-\fBdeletemethod\fI name\fR ?\fIname ...\fR?
-.
-This deletes each of the methods called \fIname\fR from a class. The methods
-must have previously existed in that class. Does not affect the superclasses
-of the class, nor does it affect the subclasses or instances of the class
-(except when they have a call chain through the class being modified).
+.RS
+.PP
+Classes do not need to have a constructor defined. If none is specified, the
+superclass's constructor will be used instead.
+.RE
.TP
\fBdestructor\fI bodyScript\fR
.
@@ -81,19 +104,6 @@ class being defined. Note that the methods themselves may be actually defined
by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
-\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
-.VS
-This slot (see \fBSLOTTED DEFINITIONS\fR below)
-.VE
-sets or updates the list of method names that are used to guard whether
-method call to instances of the class may be called and what the method's
-results are. Each \fImethodName\fR names a single filtering method (which may
-be exposed or not exposed); it is not an error for a non-existent method to be
-named since they may be defined by subclasses.
-.VS
-By default, this slot works by appending.
-.VE
-.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded method called \fIname\fR. The method is
@@ -105,8 +115,24 @@ fully-qualified, the command will be searched for in each object's namespace,
using the instances' namespace's path, or by looking in the global namespace.
The method will be exported if \fIname\fR starts with a lower-case letter, and
non-exported otherwise.
+.RS
+.PP
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below), this command creates private forwarded methods.
+.VE TIP500
+.RE
+.TP
+\fBinitialise\fI script\fR
+.TP
+\fBinitialize\fI script\fR
+.VS TIP478
+This evaluates \fIscript\fR in a context which supports local variables and
+where the current namespace is the instance namespace of the class object
+itself. This is useful for setting up, e.g., class-scoped variables.
+.VE TIP478
.TP
-\fBmethod\fI name argList bodyScript\fR
+\fBmethod\fI name \fR?\fIoption\fR? \fIargList bodyScript\fR
.
This creates or updates a method that is implemented as a procedure-like
script. The name of the method is \fIname\fR, the formal arguments to the
@@ -116,32 +142,44 @@ the body of the method is evaluated, the current namespace of the method will
be a namespace that is unique to the current object. The method will be
exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
-\fBunexport\fR.
+\fBunexport\fR
+.VS TIP519
+or by specifying \fB\-export\fR, \fB\-private\fR or \fB\-unexport\fR in the
+optional parameter \fIoption\fR.
+.VE TIP519
+.RS
+.PP
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below) or if the \fB\-private\fR flag is given for \fIoption\fR, this command
+creates private procedure-like methods.
+.VE TIP500
+.RE
.TP
-\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
-.VS
-This slot (see \fBSLOTTED DEFINITIONS\fR below)
-.VE
-sets or updates the list of additional classes that are to be mixed into
-all the instances of the class being defined. Each \fIclassName\fR argument
-names a single class that is to be mixed in.
-.VS
-By default, this slot works by replacement.
-.VE
+\fBprivate \fIcmd arg...\fR
.TP
-\fBrenamemethod\fI fromName toName\fR
+\fBprivate \fIscript\fR
.
-This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
-method must have previously existed in the class, and \fItoName\fR must not
-previously refer to a method in that class. Does not affect the superclasses
-of the class, nor does it affect the subclasses or instances of the class
-(except when they have a call chain through the class being modified). Does
-not change the export status of the method; if it was exported before, it will
-be afterwards.
+.VS TIP500
+This evaluates the \fIscript\fR (or the list of command and arguments given by
+\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
+current class will be private definitions.
+.RS
+.PP
+The following class definition commands are affected by \fBprivate\fR:
+\fBforward\fR, \fBmethod\fR, \fBself\fR, and \fBvariable\fR. Nesting
+\fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
+definition context is just a private definition context. All other definition
+commands have no difference in behavior when used in a private definition
+context.
+.RE
+.VE TIP500
.TP
\fBself\fI subcommand arg ...\fR
.TP
\fBself\fI script\fR
+.TP
+\fBself\fR
.
This command is equivalent to calling \fBoo::objdefine\fR on the class being
defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
@@ -151,20 +189,29 @@ and
.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
operates identically to
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
+.RS
+.PP
+.VS TIP470
+If no arguments at all are used, this gives the name of the class currently
+being configured.
+.VE TIP470
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below), the definitions on the class object will also be made in a private
+definition context.
+.VE TIP500
+.RE
.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
-.VS
+.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
-.VE
allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
being non-classes or vice-versa, that an empty parent class is equivalent to
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
\fBoo::class\fR may not be modified.
-.VS
By default, this slot works by replacement.
-.VE
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
@@ -176,35 +223,101 @@ actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
-.VS
+.
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made
available in the methods, constructor and destructor declared by the class
being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
-actually present in the instance object on which the method is executed. Note
+actually present in the namespace of the instance object on which the method
+is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
class. By default, this slot works by appending.
-.VE
-.SS "CONFIGURING OBJECTS"
+.RS
.PP
-The following commands are supported in the \fIdefScript\fR for
-\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
-form:
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below), this slot manipulates the list of private variable bindings for this
+class. In a private variable binding, the name of the variable within the
+instance object is different to the name given in the definition; the name
+used in the definition is the name that you use to access the variable within
+the methods of this class, and the name of the variable in the instance
+namespace has a unique prefix that makes accidental use from other classes
+extremely unlikely.
+.VE TIP500
+.RE
+.SS "ADVANCED CLASS CONFIGURATION OPTIONS"
+.PP
+The following definitions are also supported, but are not required in simple
+programs:
.TP
-\fBclass\fI className\fR
+\fBdefinitionnamespace\fR ?\fIkind\fR? \fInamespaceName\fR
+.VS TIP524
+This allows control over what namespace will be used by the \fBoo::define\fR
+and \fBoo::objdefine\fR commands to look up the definition commands they
+use. When any object has a definition operation applied to it, \fIthe class that
+it is an instance of\fR (and its superclasses and mixins) is consulted for
+what definition namespace to use. \fBoo::define\fR gets the class definition
+namespace, and \fB::oo::objdefine\fR gets the instance definition namespace,
+but both otherwise use the identical lookup operation.
+.RS
+.PP
+This sets the definition namespace of kind \fIkind\fR provided by the current
+class to \fInamespaceName\fR. The \fInamespaceName\fR must refer to a
+currently existing namespace, or must be the empty string (to stop the current
+class from having such a namespace connected). The \fIkind\fR, if supplied,
+must be either \fB\-class\fR (the default) or \fB\-instance\fR to specify the
+whether the namespace for use with \fBoo::define\fR or \fBoo::objdefine\fR
+respectively is being set.
+.PP
+The class \fBoo::object\fR has its instance namespace locked to
+\fB::oo::objdefine\fR, and the class \fBoo::class\fR has its class namespace
+locked to \fB::oo::define\fR. A consequence of this is that effective use of
+this feature for classes requires the definition of a metaclass.
+.RE
+.VE TIP524
+.TP
+\fBdeletemethod\fI name\fR ?\fIname ...\fR?
.
-This allows the class of an object to be changed after creation. Note that the
-class's constructors are not called when this is done, and so the object may
-well be in an inconsistent state unless additional configuration work is done.
+This deletes each of the methods called \fIname\fR from a class. The methods
+must have previously existed in that class. Does not affect the superclasses
+of the class, nor does it affect the subclasses or instances of the class
+(except when they have a call chain through the class being modified).
.TP
-\fBdeletemethod\fI name\fR ?\fIname ...\fR
+\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.
-This deletes each of the methods called \fIname\fR from an object. The methods
-must have previously existed in that object. Does not affect the classes that
-the object is an instance of.
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+sets or updates the list of method names that are used to guard whether
+method call to instances of the class may be called and what the method's
+results are. Each \fImethodName\fR names a single filtering method (which may
+be exposed or not exposed); it is not an error for a non-existent method to be
+named since they may be defined by subclasses.
+By default, this slot works by appending.
+.TP
+\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
+.
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+sets or updates the list of additional classes that are to be mixed into
+all the instances of the class being defined. Each \fIclassName\fR argument
+names a single class that is to be mixed in.
+By default, this slot works by replacement.
+.TP
+\fBrenamemethod\fI fromName toName\fR
+.
+This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
+method must have previously existed in the class, and \fItoName\fR must not
+previously refer to a method in that class. Does not affect the superclasses
+of the class, nor does it affect the subclasses or instances of the class
+(except when they have a call chain through the class being modified). Does
+not change the export status of the method; if it was exported before, it will
+be afterwards.
+.SH "CONFIGURING OBJECTS"
+.PP
+The following commands are supported in the \fIdefScript\fR for
+\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
+form:
.TP
\fBexport\fI name \fR?\fIname ...\fR?
.
@@ -213,20 +326,6 @@ This arranges for each of the named methods, \fIname\fR, to be exported
being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
-\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
-.VS
-This slot (see \fBSLOTTED DEFINITIONS\fR below)
-.VE
-sets or updates the list of method names that are used to guard whether a
-method call to the object may be called and what the method's results are.
-Each \fImethodName\fR names a single filtering method (which may be exposed or
-not exposed); it is not an error for a non-existent method to be named. Note
-that the actual list of filters also depends on the filters set upon any
-classes that the object is an instance of.
-.VS
-By default, this slot works by appending.
-.VE
-.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded object method called \fIname\fR. The
@@ -235,8 +334,15 @@ additional arguments, \fIarg\fR etc., added before those arguments specified
by the caller of the method. Forwarded methods should be deleted using the
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
a lower-case letter, and non-exported otherwise.
+.RS
+.PP
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below), this command creates private forwarded methods.
+.VE TIP500
+.RE
.TP
-\fBmethod\fI name argList bodyScript\fR
+\fBmethod\fI name \fR?\fIoption\fR? \fIargList bodyScript\fR
.
This creates, updates or deletes an object method. The name of the method is
\fIname\fR, the formal arguments to the method (defined using the same format
@@ -244,26 +350,45 @@ as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
method will be \fIbodyScript\fR. When the body of the method is evaluated, the
current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
-letter, and non-exported otherwise.
+letter, and non-exported otherwise;
+.VS TIP519
+this can be overridden by specifying \fB\-export\fR, \fB\-private\fR or
+\fB\-unexport\fR in the optional parameter \fIoption\fR, or via the
+\fBexport\fR and \fBunexport\fR definitions.
+.VE TIP519
+.RS
+.PP
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below) or if the \fB\-private\fR flag is given for \fIoption\fR, this command
+creates private procedure-like methods.
+.VE TIP500
+.RE
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
-.VS
+.
This slot (see \fBSLOTTED DEFINITIONS\fR below)
-.VE
sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
that is to be mixed in.
-.VS
By default, this slot works by replacement.
-.VE
.TP
-\fBrenamemethod\fI fromName toName\fR
-.
-This renames the method called \fIfromName\fR in an object to \fItoName\fR.
-The method must have previously existed in the object, and \fItoName\fR must
-not previously refer to a method in that object. Does not affect the classes
-that the object is an instance of. Does not change the export status of the
-method; if it was exported before, it will be afterwards.
+\fBprivate \fIcmd arg...\fR
+.TP
+\fBprivate \fIscript\fR
+.VS TIP500
+This evaluates the \fIscript\fR (or the list of command and arguments given by
+\fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
+current object will be private definitions.
+.RS
+.PP
+The following class definition commands are affected by \fBprivate\fR:
+\fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
+\fBprivate\fR has no cumulative effect; the innermost definition context is
+just a private definition context. All other definition commands have no
+difference in behavior when used in a private definition context.
+.RE
+.VE TIP500
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
@@ -274,36 +399,110 @@ object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
-.VS
+.
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made available in the methods declared by the
object being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
-actually present in the object on which the method is executed. Note that the
+actually present in the namespace of the object on which the method is
+executed. Note that the
variable lists declared by the classes and mixins of which the object is an
instance are completely disjoint; the list of variable names is just for
methods declared by this object. By default, this slot works by appending.
+.RS
+.PP
+.VS TIP500
+If in a private definition context (see the \fBprivate\fR definition command,
+below), this slot manipulates the list of private variable bindings for this
+object. In a private variable binding, the name of the variable within the
+instance object is different to the name given in the definition; the name
+used in the definition is the name that you use to access the variable within
+the methods of this instance object, and the name of the variable in the
+instance namespace has a unique prefix that makes accidental use from
+superclass methods extremely unlikely.
+.VE TIP500
+.RE
+.SS "ADVANCED OBJECT CONFIGURATION OPTIONS"
+.PP
+The following definitions are also supported, but are not required in simple
+programs:
+.TP
+\fBclass\fI className\fR
+.
+This allows the class of an object to be changed after creation. Note that the
+class's constructors are not called when this is done, and so the object may
+well be in an inconsistent state unless additional configuration work is done.
+.TP
+\fBdeletemethod\fI name\fR ?\fIname ...\fR
+.
+This deletes each of the methods called \fIname\fR from an object. The methods
+must have previously existed in that object. Does not affect the classes that
+the object is an instance of.
+.TP
+\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
+.
+This slot (see \fBSLOTTED DEFINITIONS\fR below)
+sets or updates the list of method names that are used to guard whether a
+method call to the object may be called and what the method's results are.
+Each \fImethodName\fR names a single filtering method (which may be exposed or
+not exposed); it is not an error for a non-existent method to be named. Note
+that the actual list of filters also depends on the filters set upon any
+classes that the object is an instance of.
+By default, this slot works by appending.
+.TP
+\fBrenamemethod\fI fromName toName\fR
+.
+This renames the method called \fIfromName\fR in an object to \fItoName\fR.
+The method must have previously existed in the object, and \fItoName\fR must
+not previously refer to a method in that object. Does not affect the classes
+that the object is an instance of. Does not change the export status of the
+method; if it was exported before, it will be afterwards.
+.TP
+\fBself \fR
+.VS TIP470
+This gives the name of the object currently being configured.
+.VE TIP470
+.SH "PRIVATE METHODS"
+.VS TIP500
+When a class or instance has a private method, that private method can only be
+invoked from within methods of that class or instance. Other callers of the
+object's methods \fIcannot\fR invoke private methods, it is as if the private
+methods do not exist. However, a private method of a class \fIcan\fR be
+invoked from the class's methods when those methods are being used on another
+instance object; this means that a class can use them to coordinate behaviour
+between several instances of itself without interfering with how other
+classes (especially either subclasses or superclasses) interact. Private
+methods precede all mixed in classes in the method call order (as reported by
+\fBself call\fR).
+.VE TIP500
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
-the slot. The class defines three operations (as methods) that may be done on
+the slot. The class defines five operations (as methods) that may be done on
the slot:
-.VE
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
-.VS
+.
This appends the given \fImember\fR elements to the slot definition.
-.VE
.TP
\fIslot\fR \fB\-clear\fR
-.VS
+.
This sets the slot definition to the empty list.
-.VE
+.TP
+\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
+.VS TIP516
+This prepends the given \fImember\fR elements to the slot definition.
+.VE TIP516
+.TP
+\fIslot\fR \fB\-remove\fR ?\fImember ...\fR?
+.VS TIP516
+This removes the given \fImember\fR elements from the slot definition.
+.VE TIP516
.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
-.VS
+.
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
@@ -316,20 +515,55 @@ which is forwarded to the default operation of the slot (thus, for the class
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:
-.VE
.TP
\fIslot\fR \fBGet\fR
-.VS
-Returns a list that is the current contents of the slot. This method must
-always be called from a stack frame created by a call to \fBoo::define\fR or
-\fBoo::objdefine\fR.
-.VE
+.
+Returns a list that is the current contents of the slot, but does not modify
+the slot. This method must always be called from a stack frame created by a
+call to \fBoo::define\fR or \fBoo::objdefine\fR. This method \fIshould not\fR
+return an error unless it is called from outside a definition context or with
+the wrong number of arguments.
+.RS
+.PP
+.VS TIP516
+The elements of the list should be fully resolved, if that is a meaningful
+concept to the slot.
+.VE TIP516
+.RE
+.TP
+\fIslot\fR \fBResolve\fR \fIslotElement\fR
+.VS TIP516
+Returns \fIslotElement\fR with a resolution operation applied to it, but does
+not modify the slot. For slots of simple strings, this is an operation that
+does nothing, whereas for slots of classes, this maps a class name to its
+fully-qualified class name. This method must always be called from a stack
+frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR. This
+method \fIshould not\fR return an error unless it is called from outside a
+definition context or with the wrong number of arguments; unresolvable
+arguments should be returned as is (as not all slot operations strictly
+require that values are resolvable to work).
+.RS
+.PP
+Implementations \fIshould not\fR enforce uniqueness and ordering constraints
+in this method; that is the responsibility of the \fBSet\fR method.
+.RE
+.VE TIP516
.TP
\fIslot\fR \fBSet \fIelementList\fR
-.VS
+.
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
-a call to \fBoo::define\fR or \fBoo::objdefine\fR.
+a call to \fBoo::define\fR or \fBoo::objdefine\fR. This method may return an
+error if it rejects the change to the slot contents (e.g., because of invalid
+values) as well as if it is called from outside a definition context or with
+the wrong number of arguments.
+.RS
+.PP
+This method \fImay\fR reorder and filter the elements if this is necessary in
+order to satisfy the underlying constraints of the slot. (For example, slots
+of classes enforce a uniqueness constraint that places each element in the
+earliest location in the slot that it can.)
+.RE
.PP
The implementation of these methods is slot-dependent (and responsible for
accessing the correct part of the class or object definition). Slots also have
@@ -337,7 +571,14 @@ an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.
-.VE
+.PP
+.VS TIP516
+Most slot operations will initially \fBResolve\fR their argument list, combine
+it with the results of the \fBGet\fR method, and then \fBSet\fR the result.
+Some operations omit one or both of the first two steps; omitting the third
+would result in an idempotent read-only operation (but the standard mechanism
+for reading from slots is via \fBinfo class\fR and \fBinfo object\fR).
+.VE TIP516
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
@@ -394,6 +635,138 @@ oo::class create B {
inst m1 \fI\(-> prints "red brick"\fR
inst m2 \fI\(-> prints "blue brick"\fR
.CE
+.PP
+.VS TIP478
+This example shows how to create and use class variables. It is a class that
+counts how many instances of itself have been made.
+.PP
+.CS
+oo::class create Counted
+\fBoo::define\fR Counted {
+ \fBinitialise\fR {
+ variable count 0
+ }
+
+ \fBvariable\fR number
+ \fBconstructor\fR {} {
+ classvariable count
+ set number [incr count]
+ }
+
+ \fBmethod\fR report {} {
+ classvariable count
+ puts "This is instance $number of $count"
+ }
+}
+
+set a [Counted new]
+set b [Counted new]
+$a report
+ \fI\(-> This is instance 1 of 2\fR
+set c [Counted new]
+$b report
+ \fI\(-> This is instance 2 of 3\fR
+$c report
+ \fI\(-> This is instance 3 of 3\fR
+.CE
+.PP
+This example demonstrates how to use class methods. (Note that the constructor
+for \fBoo::class\fR calls \fBoo::define\fR on the class.)
+.PP
+.CS
+oo::class create DBTable {
+ \fBclassmethod\fR find {description} {
+ puts "DB: locate row from [self] matching $description"
+ return [my new]
+ }
+ \fBclassmethod\fR insert {description} {
+ puts "DB: create row in [self] matching $description"
+ return [my new]
+ }
+ \fBmethod\fR update {description} {
+ puts "DB: update row [self] with $description"
+ }
+ \fBmethod\fR delete {} {
+ puts "DB: delete row [self]"
+ my destroy; # Just delete the object, not the DB row
+ }
+}
+
+oo::class create Users {
+ \fBsuperclass\fR DBTable
+}
+oo::class create Groups {
+ \fBsuperclass\fR DBTable
+}
+
+set u1 [Users insert "username=abc"]
+ \fI\(-> DB: create row from ::Users matching username=abc\fR
+set u2 [Users insert "username=def"]
+ \fI\(-> DB: create row from ::Users matching username=def\fR
+$u2 update "group=NULL"
+ \fI\(-> DB: update row ::oo::Obj124 with group=NULL\fR
+$u1 delete
+ \fI\(-> DB: delete row ::oo::Obj123\fR
+set g [Group find "groupname=webadmins"]
+ \fI\(-> DB: locate row ::Group with groupname=webadmins\fR
+$g update "emailaddress=admins"
+ \fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
+.CE
+.VE TIP478
+.PP
+.VS TIP524
+This example shows how to make a custom definition for a class. Note that it
+explicitly includes delegation to the existing definition commands via
+\fBnamespace path\fR.
+.PP
+.CS
+namespace eval myDefinitions {
+ # Delegate to existing definitions where not overridden
+ namespace path \fB::oo::define\fR
+
+ # A custom type of method
+ proc exprmethod {name arguments body} {
+ tailcall \fBmethod\fR $name $arguments [list expr $body]
+ }
+
+ # A custom way of building a constructor
+ proc parameters args {
+ uplevel 1 [list \fBvariable\fR {*}$args]
+ set body [join [lmap a $args {
+ string map [list VAR $a] {
+ set [my varname VAR] [expr {double($VAR)}]
+ }
+ }] ";"]
+ tailcall \fBconstructor\fR $args $body
+ }
+}
+
+# Bind the namespace into a (very simple) metaclass for use
+oo::class create exprclass {
+ \fBsuperclass\fR oo::class
+ \fBdefinitionnamespace\fR myDefinitions
+}
+
+# Use the custom definitions
+exprclass create quadratic {
+ parameters a b c
+ exprmethod evaluate {x} {
+ ($a * $x**2) + ($b * $x) + $c
+ }
+}
+
+# Showing the resulting class and object in action
+quadratic create quad 1 2 3
+for {set x 0} {$x <= 4} {incr x} {
+ puts [format "quad(%d) = %.2f" $x [quad evaluate $x]]
+}
+ \fI\(-> quad(0) = 3.00\fR
+ \fI\(-> quad(1) = 6.00\fR
+ \fI\(-> quad(2) = 11.00\fR
+ \fI\(-> quad(3) = 18.00\fR
+ \fI\(-> quad(4) = 27.00\fR
+.CE
+.VE TIP524
.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
diff --git a/doc/dict.n b/doc/dict.n
index cd7e94c..1829768 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -27,6 +27,11 @@ key maps to in the dictionary value contained in the given variable,
writing the resulting dictionary value back to that variable.
Non-existent keys are treated as if they map to an empty string. The
updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the appending operation.
+.VE TIP508
.TP
\fBdict create \fR?\fIkey value ...\fR?
.
@@ -124,6 +129,11 @@ resulting dictionary value back to that variable. Non-existent keys
are treated as if they map to 0. It is an error to increment a value
for an existing key if that value is not an integer. The updated
dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the incrementing operation.
+.VE TIP508
.TP
\fBdict info \fIdictionaryValue\fR
.
@@ -149,6 +159,11 @@ keys are treated as if they map to an empty list, and it is legal for
there to be no items to append to the list. It is an error for the
value that the key maps to to not be representable as a list. The
updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the list-appending operation.
+.VE TIP508
.TP
\fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
.
@@ -206,6 +221,11 @@ value and places an updated dictionary value in that variable
containing a mapping from the given key to the given value. When
multiple keys are present, this operation creates or updates a chain
of nested dictionaries. The updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the value insert/update operation.
+.VE TIP508
.TP
\fBdict size \fIdictionaryValue\fR
.
@@ -221,6 +241,11 @@ through nested dictionaries to the mapping to remove. At least one key
must be specified, but the last key on the key-path need not exist.
All other components on the path must exist. The updated dictionary
value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the value remove operation.
+.VE TIP508
.TP
\fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
.
@@ -236,6 +261,11 @@ are silently discarded), even if the result of \fIbody\fR is an error
or some other kind of exceptional exit. The result of \fBdict
update\fR is (unless some kind of error occurs) the result of the
evaluation of \fIbody\fR.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the update operation.
+.VE TIP508
.RS
.PP
Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
@@ -270,6 +300,11 @@ dictionary be discarded, and this also happens if the contents of
dictionaries no longer exists. The result of \fBdict with\fR is
(unless some kind of error occurs) the result of the evaluation of
\fIbody\fR.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the updating operation.
+.VE TIP508
.RS
.PP
The variables are mapped in the scope enclosing the \fBdict with\fR;
diff --git a/doc/eof.n b/doc/eof.n
index 75f3c48..0dcf34a 100644
--- a/doc/eof.n
+++ b/doc/eof.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH eof n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -59,3 +59,7 @@ while {1} {
file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, end of file
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/eval.n b/doc/eval.n
index 3ef5023..9fc2ae4 100644
--- a/doc/eval.n
+++ b/doc/eval.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH eval n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/exit.n b/doc/exit.n
index 9b4ad20..36676b1 100644
--- a/doc/exit.n
+++ b/doc/exit.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH exit n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -49,3 +49,7 @@ if {[catch {main} msg options]} {
exec(n)
.SH KEYWORDS
abort, exit, process
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/expr.n b/doc/expr.n
index b76b6a2..d33623c 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -17,14 +17,14 @@ expr \- Evaluate an expression
.BE
.SH DESCRIPTION
.PP
-Concatenates \fIarg\fRs (adding separator spaces between them),
-evaluates the result as a Tcl expression, and returns the value.
-The operators permitted in Tcl expressions include a subset of
+Concatenates \fIarg\fRs, separated by a space, into an expression, and evaluates
+that expression, returning its value.
+The operators permitted in an expression include a subset of
the operators permitted in C expressions. For those operators
common to both Tcl and C, Tcl applies the same meaning and precedence
as the corresponding C operators.
-Expressions almost always yield numeric results
-(integer or floating-point values).
+The value of an expression is often a numeric result, either an integer or a
+floating-point value, but may also be a non-numeric value.
For example, the expression
.PP
.CS
@@ -32,78 +32,69 @@ For example, the expression
.CE
.PP
evaluates to 14.2.
-Tcl expressions differ from C expressions in the way that
-operands are specified. Also, Tcl expressions support
-non-numeric operands and string comparisons, as well as some
+Expressions differ from C expressions in the way that
+operands are specified. Expressions also support
+non-numeric operands, string comparisons, and some
additional operators not found in C.
+.PP
+When an expression evaluates to an integer, the value is the decimal form of
+the integer, and when an expression evaluates to a floating-point number, the
+value is the form produced by the \fB%g\fR format specifier of Tcl's
+\fBformat\fR command.
.SS OPERANDS
.PP
-A Tcl expression consists of a combination of operands, operators,
-parentheses and commas.
-White space may be used between the operands and operators and
-parentheses (or commas); it is ignored by the expression's instructions.
-Where possible, operands are interpreted as integer values.
-Integer values may be specified in decimal (the normal case), in binary
-(if the first two characters of the operand are \fB0b\fR), in octal
-(if the first two characters of the operand are \fB0o\fR), or in hexadecimal
-(if the first two characters of the operand are \fB0x\fR). For
-compatibility with older Tcl releases, an octal integer value is also
-indicated simply when the first character of the operand is \fB0\fR,
-whether or not the second character is also \fBo\fR.
-If an operand does not have one of the integer formats given
-above, then it is treated as a floating-point number if that is
-possible. Floating-point numbers may be specified in any of several
-common formats making use of the decimal digits, the decimal point \fB.\fR,
-the characters \fBe\fR or \fBE\fR indicating scientific notation, and
-the sign characters \fB+\fR or \fB\-\fR. For example, all of the
-following are valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
-Also recognized as floating point values are the strings \fBInf\fR
-and \fBNaN\fR making use of any case for each character.
-If no numeric interpretation is possible (note that all literal
-operands that are not numeric or boolean must be quoted with either
-braces or with double quotes), then an operand is left as a string
-(and only a limited set of operators may be applied to it).
-.PP
-Operands may be specified in any of the following ways:
+An expression consists of a combination of operands, operators, parentheses and
+commas, possibly with whitespace between any of these elements, which is
+ignored.
+An integer operand may be specified in decimal (the normal case, the optional
+first two characters are \fB0d\fR), binary
+(the first two characters are \fB0b\fR), octal
+(the first two characters are \fB0o\fR), or hexadecimal
+(the first two characters are \fB0x\fR) form. For
+compatibility with older Tcl releases, an operand that begins with \fB0\fR is
+interpreted as an octal integer even if the second character is not \fBo\fR.
+A floating-point number may be specified in any of several
+common decimal formats, and may use the decimal point \fB.\fR,
+\fBe\fR or \fBE\fR for scientific notation, and
+the sign characters \fB+\fR and \fB\-\fR. The
+following are all valid floating-point numbers: 2.1, 3., 6e4, 7.91e+16.
+The strings \fBInf\fR
+and \fBNaN\fR, in any combination of case, are also recognized as floating point
+values. An operand that doesn't have a numeric interpretation must be quoted
+with either braces or with double quotes.
+.PP
+An operand may be specified in any of the following ways:
.IP [1]
As a numeric value, either integer or floating-point.
.IP [2]
As a boolean value, using any form understood by \fBstring is\fR
\fBboolean\fR.
.IP [3]
-As a Tcl variable, using standard \fB$\fR notation.
-The variable's value will be used as the operand.
+As a variable, using standard \fB$\fR notation.
+The value of the variable is then the value of the operand.
.IP [4]
As a string enclosed in double-quotes.
-The expression parser will perform backslash, variable, and
-command substitutions on the information between the quotes,
-and use the resulting value as the operand
+Backslash, variable, and command substitution are performed as described in
+\fBTcl\fR.
.IP [5]
As a string enclosed in braces.
-The characters between the open brace and matching close brace
-will be used as the operand without any substitutions.
+The operand is treated as a braced value as described in \fBTcl\fR.
.IP [6]
As a Tcl command enclosed in brackets.
-The command will be executed and its result will be used as
-the operand.
+Command substitution is performed as described in \fBTcl\fR.
.IP [7]
-As a mathematical function whose arguments have any of the above
-forms for operands, such as \fBsin($x)\fR. See \fBMATH FUNCTIONS\fR below for
+As a mathematical function such as \fBsin($x)\fR, whose arguments have any of the above
+forms for operands. See \fBMATH FUNCTIONS\fR below for
a discussion of how mathematical functions are handled.
.PP
-Where the above substitutions occur (e.g. inside quoted strings), they
-are performed by the expression's instructions.
-However, the command parser may already have performed one round of
-substitution before the expression processor was called.
-As discussed below, it is usually best to enclose expressions
-in braces to prevent the command parser from performing substitutions
-on the contents.
+Because \fBexpr\fR parses and performs substitutions on values that have
+already been parsed and substituted by \fBTcl\fR, it is usually best to enclose
+expressions in braces to avoid the first round of substitutions by
+\fBTcl\fR.
.PP
-For some examples of simple expressions, suppose the variable
-\fBa\fR has the value 3 and
-the variable \fBb\fR has the value 6.
-Then the command on the left side of each of the lines below
-will produce the value on the right side of the line:
+Below are some examples of simple expressions where the value of \fBa\fR is 3
+and the value of \fBb\fR is 6. The command on the left side of each line
+produces the value on the right side.
.PP
.CS
.ta 6c
@@ -114,34 +105,41 @@ will produce the value on the right side of the line:
.CE
.SS OPERATORS
.PP
-The valid operators (most of which are also available as commands in
-the \fBtcl::mathop\fR namespace; see the \fBmathop\fR(n) manual page
-for details) are listed below, grouped in decreasing order of precedence:
+For operators having both a numeric mode and a string mode, the numeric mode is
+chosen when all operands have a numeric interpretation. The integer
+interpretation of an operand is preferred over the floating-point
+interpretation. To ensure string operations on arbitrary values it is generally a
+good idea to use \fBeq\fR, \fBne\fR, or the \fBstring\fR command instead of
+more versatile operators such as \fB==\fR.
+.PP
+Unless otherwise specified, operators accept non-numeric operands. The value
+of a boolean operation is 1 if true, 0 otherwise. See also \fBstring is\fR
+\fBboolean\fR. The valid operators, most of which are also available as
+commands in the \fBtcl::mathop\fR namespace (see \fBmathop\fR(n)), are listed
+below, grouped in decreasing order of precedence:
.TP 20
\fB\-\0\0+\0\0~\0\0!\fR
.
-Unary minus, unary plus, bit-wise NOT, logical NOT. None of these operators
-may be applied to string operands, and bit-wise NOT may be
-applied only to integers.
+Unary minus, unary plus, bit-wise NOT, logical NOT. These operators
+may only be applied to numeric operands, and bit-wise NOT may only be
+applied to integers.
.TP 20
\fB**\fR
.
-Exponentiation. Valid for any numeric operands.
+Exponentiation. Valid for numeric operands.
.TP 20
\fB*\0\0/\0\0%\fR
.
-Multiply, divide, remainder. None of these operators may be
-applied to string operands, and remainder may be applied only
-to integers.
-The remainder will always have the same sign as the divisor and
-an absolute value smaller than the absolute value of the divisor.
+Multiply and divide, which are valid for numeric operands, and remainder, which
+is valid for integers. The remainder, an absolute value smaller than the
+absolute value of the divisor, has the same sign as the divisor.
.RS
.PP
-When applied to integers, the division and remainder operators can be
-considered to partition the number line into a sequence of equal-sized
-adjacent non-overlapping pieces where each piece is the size of the divisor;
-the division result identifies which piece the divisor lay within, and the
-remainder result identifies where within that piece the divisor lay. A
+When applied to integers, division and remainder can be
+considered to partition the number line into a sequence of
+adjacent non-overlapping pieces, where each piece is the size of the divisor;
+the quotient identifies which piece the dividend lies within, and the
+remainder identifies where within that piece the dividend lies. A
consequence of this is that the result of
.QW "-57 \fB/\fR 10"
is always -6, and the result of
@@ -151,177 +149,157 @@ is always 3.
.TP 20
\fB+\0\0\-\fR
.
-Add and subtract. Valid for any numeric operands.
+Add and subtract. Valid for numeric operands.
.TP 20
\fB<<\0\0>>\fR
.
-Left and right shift. Valid for integer operands only.
+Left and right shift. Valid for integers.
A right shift always propagates the sign bit.
.TP 20
\fB<\0\0>\0\0<=\0\0>=\fR
.
-Boolean less, greater, less than or equal, and greater than or equal.
-Each operator produces 1 if the condition is true, 0 otherwise.
-These operators may be applied to strings as well as numeric operands,
-in which case string comparison is used.
+Boolean less than, greater than, less than or equal, and greater than or equal.
.TP 20
\fB==\0\0!=\fR
.
-Boolean equal and not equal. Each operator produces a zero/one result.
-Valid for all operand types.
+Boolean equal and not equal.
.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.
+Boolean string equal and string not equal.
.TP 20
\fBin\0\0ni\fR
.
-List containment and negated list containment. Each operator produces
-a zero/one result and treats its first argument as a string and its
-second argument as a Tcl list. The \fBin\fR operator indicates
-whether the first argument is a member of the second argument list;
-the \fBni\fR operator inverts the sense of the result.
+List containment and negated list containment. The first argument is
+interpreted as a string, the second as a list. \fBin\fR tests for membership
+in the list, and \fBni\fR is the inverse.
.TP 20
\fB&\fR
.
-Bit-wise AND. Valid for integer operands only.
+Bit-wise AND. Valid for integer operands.
.TP 20
\fB^\fR
.
-Bit-wise exclusive OR. Valid for integer operands only.
+Bit-wise exclusive OR. Valid for integer operands.
.TP 20
\fB|\fR
.
-Bit-wise OR. Valid for integer operands only.
+Bit-wise OR. Valid for integer operands.
.TP 20
\fB&&\fR
.
-Logical AND. Produces a 1 result if both operands are non-zero,
-0 otherwise.
-Valid for boolean and numeric (integers or floating-point) operands only.
+Logical AND. If both operands are true, the result is 1, or 0 otherwise.
+
.TP 20
\fB||\fR
.
-Logical OR. Produces a 0 result if both operands are zero, 1 otherwise.
-Valid for boolean and numeric (integers or floating-point) operands only.
+Logical OR. If both operands are false, the result is 0, or 1 otherwise.
.TP 20
\fIx\fB?\fIy\fB:\fIz\fR
.
-If-then-else, as in C. If \fIx\fR
-evaluates to non-zero, then the result is the value of \fIy\fR.
-Otherwise the result is the value of \fIz\fR.
-The \fIx\fR operand must have a boolean or numeric value.
-.PP
-See the C manual for more details on the results
-produced by each operator.
-The exponentiation operator promotes types like the multiply and
-divide operators, and produces a result that is the same as the output
-of the \fBpow\fR function (after any type conversions.)
-All of the binary operators but exponentiation group left-to-right
-within the same precedence level; exponentiation groups right-to-left. For example, the command
+If-then-else, as in C. If \fIx\fR is false , the result is the value of
+\fIy\fR. Otherwise the result is the value of \fIz\fR.
+.PP
+The exponentiation operator promotes types in the same way that the multiply
+and divide operators do, and the result is is the same as the result of
+\fBpow\fR.
+Exponentiation groups right-to-left within a precedence level. Other binary
+operators group left-to-right. For example, the value of
.PP
.CS
\fBexpr\fR {4*2 < 7}
.CE
.PP
-returns 0, while
+is 0, while the value of
.PP
.CS
\fBexpr\fR {2**3**2}
.CE
.PP
-returns 512.
+is 512.
.PP
-The \fB&&\fR, \fB||\fR, and \fB?:\fR operators have
+As in C, \fB&&\fR, \fB||\fR, and \fB?:\fR feature
.QW "lazy evaluation" ,
-just as in C, which means that operands are not evaluated if they are
-not needed to determine the outcome. For example, in the command
+which means that operands are not evaluated if they are
+not needed to determine the outcome. For example, in
.PP
.CS
\fBexpr\fR {$v ? [a] : [b]}
.CE
.PP
-only one of
-.QW \fB[a]\fR
-or
-.QW \fB[b]\fR
-will actually be evaluated,
-depending on the value of \fB$v\fR. Note, however, that this is
-only true if the entire expression is enclosed in braces; otherwise
-the Tcl parser will evaluate both
-.QW \fB[a]\fR
-and
-.QW \fB[b]\fR
-before invoking the \fBexpr\fR command.
+only one of \fB[a]\fR or \fB[b]\fR is evaluated,
+depending on the value of \fB$v\fR. This is not true of the normal Tcl parser,
+so it is normally recommended to enclose the arguments to \fBexpr\fR in braces.
+Without braces, as in
+\fBexpr\fR $v ? [a] : [b]
+both \fB[a]\fR and \fB[b]\fR are evaluated before \fBexpr\fR is even called.
+.PP
+For more details on the results
+produced by each operator, see the documentation for C.
.SS "MATH FUNCTIONS"
.PP
-When the expression parser encounters a mathematical function
-such as \fBsin($x)\fR, it replaces it with a call to an ordinary
-Tcl function in the \fBtcl::mathfunc\fR namespace. The processing
-of an expression such as:
+A mathematical function such as \fBsin($x)\fR is replaced with a call to an ordinary
+Tcl command in the \fBtcl::mathfunc\fR namespace. The evaluation
+of an expression such as
.PP
.CS
\fBexpr\fR {sin($x+$y)}
.CE
.PP
-is the same in every way as the processing of:
+is the same in every way as the evaluation of
.PP
.CS
\fBexpr\fR {[tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]]}
.CE
.PP
-which in turn is the same as the processing of:
+which in turn is the same as the evaluation of
.PP
.CS
tcl::mathfunc::sin [\fBexpr\fR {$x+$y}]
.CE
.PP
-The executor will search for \fBtcl::mathfunc::sin\fR using the usual
-rules for resolving functions in namespaces. Either
-\fB::tcl::mathfunc::sin\fR or \fB[namespace
-current]::tcl::mathfunc::sin\fR will satisfy the request, and others
-may as well (depending on the current \fBnamespace path\fR setting).
+\fBtcl::mathfunc::sin\fR is resolved as described in
+\fBNAMESPACE RESOLUTION\fR in the \fBnamespace\fR(n) documentation. Given the
+default value of \fBnamespace path\fR, \fB[namespace
+current]::tcl::mathfunc::sin\fR or \fB::tcl::mathfunc::sin\fR are the typical
+resolutions.
.PP
-Some mathematical functions have several arguments, separated by commas like in C. Thus:
+As in C, a mathematical function may accept multiple arguments separated by commas. Thus,
.PP
.CS
\fBexpr\fR {hypot($x,$y)}
.CE
.PP
-ends up as
+becomes
.PP
.CS
tcl::mathfunc::hypot $x $y
.CE
.PP
-See the \fBmathfunc\fR(n) manual page for the math functions that are
+See the \fBmathfunc\fR(n) documentation for the math functions that are
available by default.
.SS "TYPES, OVERFLOW, AND PRECISION"
.PP
-All internal computations involving integers are done calling on the
-LibTomMath multiple precision integer library as required so that all
-integer calculations are performed exactly. Note that in Tcl releases
-prior to 8.5, integer calculations were performed with one of the C types
+When needed to guarantee exact performance, internal computations involving
+integers use the LibTomMath multiple precision integer library. In Tcl releases
+prior to 8.5, integer calculations were performed using one of the C types
\fIlong int\fR or \fITcl_WideInt\fR, causing implicit range truncation
in those calculations where values overflowed the range of those types.
-Any code that relied on these implicit truncations will need to explicitly
-add \fBint()\fR or \fBwide()\fR function calls to expressions at the points
-where such truncation is required to take place.
+Any code that relied on these implicit truncations should instead call
+\fBint()\fR or \fBwide()\fR, which do truncate.
.PP
-All internal computations involving floating-point are
-done with the C type \fIdouble\fR.
-When converting a string to floating-point, exponent overflow is
+Internal floating-point computations are
+performed using the \fIdouble\fR C type.
+When converting a string to floating-point value, exponent overflow is
detected and results in the \fIdouble\fR value of \fBInf\fR or
\fB\-Inf\fR as appropriate. Floating-point overflow and underflow
are detected to the degree supported by the hardware, which is generally
-pretty reliable.
+fairly reliable.
.PP
-Conversion among internal representations for integer, floating-point,
-and string operands is done automatically as needed.
-For arithmetic computations, integers are used until some
-floating-point number is introduced, after which floating-point is used.
-For example,
+Conversion among internal representations for integer, floating-point, and
+string operands is done automatically as needed. For arithmetic computations,
+integers are used until some floating-point number is introduced, after which
+floating-point values are used. For example,
.PP
.CS
\fBexpr\fR {5 / 4}
@@ -335,82 +313,62 @@ returns 1, while
.CE
.PP
both return 1.25.
-Floating-point values are always returned with a
+A floating-point result can be distinguished from an integer result by the
+presence of either
.QW \fB.\fR
-or an
+or
.QW \fBe\fR
-so that they will not look like integer values. For example,
+.PP
+. For example,
.PP
.CS
\fBexpr\fR {20.0/5.0}
.CE
.PP
returns \fB4.0\fR, not \fB4\fR.
-.SS "STRING OPERATIONS"
-.PP
-String values may be used as operands of the comparison operators,
-although the expression evaluator tries to do comparisons as integer
-or floating-point when it can,
-i.e., when all arguments to the operator allow numeric interpretations,
-except in the case of the \fBeq\fR and \fBne\fR operators.
-If one of the operands of a comparison is a string and the other
-has a numeric value, a canonical string representation of the numeric
-operand value is generated to compare with the string operand.
-Canonical string representation for integer values is a decimal string
-format. Canonical string representation for floating-point values
-is that produced by the \fB%g\fR format specifier of Tcl's
-\fBformat\fR command. For example, the commands
-.PP
-.CS
-\fBexpr\fR {"0x03" > "2"}
-\fBexpr\fR {"0y" > "0x12"}
-.CE
-.PP
-both return 1. The first comparison is done using integer
-comparison, and the second is done using string comparison.
-Because of Tcl's tendency to treat values as numbers whenever
-possible, it is not generally a good idea to use operators like \fB==\fR
-when you really want string comparison and the values of the
-operands could be arbitrary; it is better in these cases to use
-the \fBeq\fR or \fBne\fR operators, or the \fBstring\fR command instead.
.SH "PERFORMANCE CONSIDERATIONS"
.PP
-Enclose expressions in braces for the best speed and the smallest
-storage requirements.
-This allows the Tcl bytecode compiler to generate the best code.
-.PP
-As mentioned above, expressions are substituted twice:
-once by the Tcl parser and once by the \fBexpr\fR command.
-For example, the commands
+Where an expression contains syntax that Tcl would otherwise perform
+substitutions on, enclosing an expression in braces or otherwise quoting it
+so that it's a static value allows the Tcl compiler to generate bytecode for
+the expression, resulting in better speed and smaller storage requirements.
+This also avoids issues that can arise if Tcl is allowed to perform
+substitution on the value before \fBexpr\fR is called.
.PP
+In the following example, the value of the expression is 11 because the Tcl parser first
+substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the
+expression in braces would result in a syntax error.
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP
-return 11, not a multiple of 4.
-This is because the Tcl parser will first substitute \fB$a + 2\fR for
-the variable \fBb\fR,
-then the \fBexpr\fR command will evaluate the expression \fB$a + 2*4\fR.
-.PP
-Most expressions do not require a second round of substitutions.
-Either they are enclosed in braces or, if not,
-their variable and command substitutions yield numbers or strings
-that do not themselves require substitutions.
-However, because a few unbraced expressions
-need two rounds of substitutions,
-the bytecode compiler must emit
-additional instructions to handle this situation.
-The most expensive code is required for
-unbraced expressions that contain command substitutions.
-These expressions must be implemented by generating new code
-each time the expression is executed.
-When the expression is unbraced to allow the substitution of a function or
-operator, consider using the commands documented in the \fBmathfunc\fR(n) or
-\fBmathop\fR(n) manual pages directly instead.
+
+When an expression is generated at runtime, like the one above is, the bytcode
+compiler must ensure that new code is generated each time the expression
+is evaluated. This is the most costly kind of expression from a performance
+perspective. In such cases, consider directly using the commands described in
+the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.
+
+Most expressions are not formed at runtime, but are literal strings or contain
+substitutions that don't introduce other substitutions. To allow the bytecode
+compiler to work with an expression as a string literal at compilation time,
+ensure that it contains no substitutions or that it is enclosed in braces or
+otherwise quoted to prevent Tcl from performing substitutions, allowing
+\fBexpr\fR to perform them instead.
.SH EXAMPLES
.PP
+A numeric comparison whose result is 1:
+.CS
+\fBexpr\fR {"0x03" > "2"}
+.CE
+.PP
+A string comparison whose result is 1:
+.CS
+\fBexpr\fR {"0y" > "0x12"}
+.CE
+.PP
Define a procedure that computes an
.QW interesting
mathematical function:
@@ -444,8 +402,8 @@ each other:
puts "a and b are [\fBexpr\fR {$a eq $b ? {equal} : {different}}]"
.CE
.PP
-Set a variable to whether an environment variable is both defined at
-all and also set to a true boolean value:
+Set a variable indicating whether an environment variable is defined and has
+value of true:
.PP
.CS
set isTrue [\fBexpr\fR {
diff --git a/doc/fblocked.n b/doc/fblocked.n
index 2841aee..0a28dcf 100644
--- a/doc/fblocked.n
+++ b/doc/fblocked.n
@@ -1,4 +1,4 @@
-'\"
+'\"
'\" Copyright (c) 1996 Sun Microsystems, Inc.
'\"
'\" See the file "license.terms" for information on usage and redistribution
@@ -65,3 +65,7 @@ vwait forever
gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, nonblocking
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/file.n b/doc/file.n
index 2f8b70c..ad35dd5 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -390,7 +390,7 @@ that use the third component do not attempt to perform tilde
substitution.
.RE
.TP
-\fBfile stat \fIname varName\fR
+\fBfile stat \fIname varName\fR
.
Invokes the \fBstat\fR kernel call on \fIname\fR, and uses the variable
given by \fIvarName\fR to hold information returned from the kernel call.
diff --git a/doc/fileevent.n b/doc/fileevent.n
index 2751040..bbba997 100644
--- a/doc/fileevent.n
+++ b/doc/fileevent.n
@@ -154,3 +154,7 @@ fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
.SH KEYWORDS
asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
script, writable.
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/filename.n b/doc/filename.n
index 87ba467..f160eff 100644
--- a/doc/filename.n
+++ b/doc/filename.n
@@ -176,3 +176,7 @@ file(n), glob(n)
.SH KEYWORDS
current directory, absolute file name, relative file name,
volume-relative file name, portability
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/flush.n b/doc/flush.n
index d266d91..1d84383 100644
--- a/doc/flush.n
+++ b/doc/flush.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH flush n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -43,3 +43,7 @@ puts "Hello there, $name!"
file(n), open(n), socket(n), Tcl_StandardChannels(3)
.SH KEYWORDS
blocking, buffer, channel, flush, nonblocking, output
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/foreach.n b/doc/foreach.n
index 89a11f6..43f961a 100644
--- a/doc/foreach.n
+++ b/doc/foreach.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH foreach n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -102,3 +102,7 @@ for(n), while(n), break(n), continue(n)
.SH KEYWORDS
foreach, iteration, list, loop
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/format.n b/doc/format.n
index 1c511e8..eb64491 100644
--- a/doc/format.n
+++ b/doc/format.n
@@ -83,12 +83,15 @@ Specifies that the number should be padded on the left with
zeroes instead of spaces.
.TP 10
\fB#\fR
-Requests an alternate output form. For \fBo\fR
-conversions it guarantees that the first digit is always \fB0\fR.
-For \fBx\fR or \fBX\fR conversions, \fB0x\fR or \fB0X\fR (respectively)
+Requests an alternate output form. For \fBo\fR conversions,
+\fB0o\fR will be added to the beginning of the result unless
+it is zero. For \fBx\fR or \fBX\fR conversions, \fB0x\fR
will be added to the beginning of the result unless it is zero.
For \fBb\fR conversions, \fB0b\fR
will be added to the beginning of the result unless it is zero.
+For \fBd\fR conversions, \fB0d\fR there is no effect unless
+the \fB0\fR specifier is used as well: In that case, \fB0d\fR
+will be added to the beginning.
For all floating-point conversions (\fBe\fR, \fBE\fR, \fBf\fR,
\fBg\fR, and \fBG\fR) it guarantees that the result always
has a decimal point.
@@ -130,7 +133,7 @@ it must be a numeric string.
.SS "OPTIONAL SIZE MODIFIER"
.PP
The fifth part of a conversion specifier is a size modifier,
-which must be \fBll\fR, \fBh\fR, or \fBl\fR.
+which must be \fBll\fR, \fBh\fR, \fBl\fR, or \fBL\fR.
If it is \fBll\fR it specifies that an integer value is taken
without truncation for conversion to a formatted substring.
If it is \fBh\fR it specifies that an integer value is
@@ -138,7 +141,9 @@ truncated to a 16-bit range before converting. This option is rarely useful.
If it is \fBl\fR it specifies that the integer value is
truncated to the same range as that produced by the \fBwide()\fR
function of the \fBexpr\fR command (at least a 64-bit range).
-If neither \fBh\fR nor \fBl\fR are present, the integer value is
+If it is \fBL\fR it specifies that an integer or double value is taken
+without truncation for conversion to a formatted substring.
+If neither \fBh\fR nor \fBl\fR nor \fBL\fR are present, the integer value is
truncated to the same range as that produced by the \fBint()\fR
function of the \fBexpr\fR command (at least a 32-bit range, but
determined by the value of the \fBwordSize\fR element of the
@@ -198,8 +203,19 @@ precision, then convert number as for \fB%e\fR or
Otherwise convert as for \fB%f\fR.
Trailing zeroes and a trailing decimal point are omitted.
.TP 10
+\fBa\fR or \fBA\fR
+Convert double to hexadecimal notation in the form
+\fI0x1.yyy\fBp\(+-\fIzz\fR, where the number of \fIy\fR's is
+determined by the precision (default: 13).
+If the \fBA\fR form is used then the hex characters
+are printed in uppercase.
+.TP 10
\fB%\fR
No conversion: just insert \fB%\fR.
+.TP 10
+\fBp\fR
+Shorthand form for \fB0x%zx\fR, so it outputs the integer in
+hexadecimal form with \fB0x\fR prefix.
.SH "DIFFERENCES FROM ANSI SPRINTF"
.PP
The behavior of the format command is the same as the
@@ -208,13 +224,12 @@ differences:
.IP [1]
Tcl guarantees that it will be working with UNICODE characters.
.IP [2]
-\fB%p\fR and \fB%n\fR specifiers are not supported.
+\fB%n\fR specifier is not supported.
.IP [3]
For \fB%c\fR conversions the argument must be an integer value,
which will then be converted to the corresponding character value.
.IP [4]
The size modifiers are ignored when formatting floating-point values.
-The \fBll\fR modifier has no \fBsprintf\fR counterpart.
The \fBb\fR specifier has no \fBsprintf\fR counterpart.
.SH EXAMPLES
.PP
diff --git a/doc/gets.n b/doc/gets.n
index 0150f29..57532c0 100644
--- a/doc/gets.n
+++ b/doc/gets.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH gets n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/global.n b/doc/global.n
index 9848817..e6d2678b 100644
--- a/doc/global.n
+++ b/doc/global.n
@@ -56,3 +56,7 @@ proc accum {string} {
namespace(n), upvar(n), variable(n)
.SH KEYWORDS
global, namespace, procedure, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/history.n b/doc/history.n
index e1f9781..05d936e 100644
--- a/doc/history.n
+++ b/doc/history.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH history n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -100,3 +100,7 @@ the \fBevent\fR operation to retrieve some event,
and the \fBadd\fR operation to add it to history and execute it.
.SH KEYWORDS
event, history, record
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/http.n b/doc/http.n
index 7e633b3..7845e60 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -13,10 +13,10 @@
.SH NAME
http \- Client-side implementation of the HTTP/1.1 protocol
.SH SYNOPSIS
-\fBpackage require http ?2.8?\fR
+\fBpackage require http\fI ?\fB2.8\fR?
.\" See Also -useragent option documentation in body!
.sp
-\fB::http::config ?\fI\-option value\fR ...?
+\fB::http::config\fR ?\fI\-option value\fR ...?
.sp
\fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
.sp
@@ -99,6 +99,15 @@ comma-separated list of mime type patterns that you are
willing to receive. For example,
.QW "image/gif, image/jpeg, text/*" .
.TP
+\fB\-cookiejar\fR \fIcommand\fR
+.VS TIP406
+The cookie store for the package to use to manage HTTP cookies.
+\fIcommand\fR is a command prefix list; if the empty list (the
+default value) is used, no cookies will be sent by requests or stored
+from responses. The command indicated by \fIcommand\fR, if supplied,
+must obey the \fBCOOKIE JAR PROTOCOL\fR described below.
+.VE TIP406
+.TP
\fB\-pipeline\fR \fIboolean\fR
.
Specifies whether HTTP/1.1 transactions on a persistent socket will be
@@ -770,6 +779,108 @@ Subsequent GET and HEAD requests in a failed pipeline will also be retried.
that the retry is appropriate\fR - specifically, the application must know
that if the failed POST successfully modified the state of the server, a repeat POST
would have no adverse effect.
+.VS TIP406
+.SH "COOKIE JAR PROTOCOL"
+.PP
+Cookies are short key-value pairs used to implement sessions within the
+otherwise-stateless HTTP protocol. (See RFC 6265 for details; Tcl does not
+implement the Cookie2 protocol as that is rarely seen in the wild.)
+.PP
+Cookie storage managment commands \(em
+.QW "cookie jars"
+\(em must support these subcommands which form the HTTP cookie storage
+management protocol. Note that \fIcookieJar\fR below does not have to be a
+command name; it is properly a command prefix (a Tcl list of words that will
+be expanded in place) and admits many possible implementations.
+.PP
+Though not formally part of the protocol, it is expected that particular
+values of \fIcookieJar\fR will correspond to sessions; it is up to the caller
+of \fB::http::config\fR to decide what session applies and to manage the
+deletion of said sessions when they are no longer desired (which should be
+when they not configured as the current cookie jar).
+.TP
+\fIcookieJar \fBgetCookies \fIprotocol host requestPath\fR
+.
+This command asks the cookie jar what cookies should be supplied for a
+particular request. It should take the \fIprotocol\fR (typically \fBhttp\fR or
+\fBhttps\fR), \fIhost\fR name and \fIrequestPath\fR (parsed from the \fIurl\fR
+argument to \fB::http::geturl\fR) and return a list of cookie keys and values
+that describe the cookies to supply to the remote host. The list must have an
+even number of elements.
+.RS
+.PP
+There should only ever be at most one cookie with a particular key for any
+request (typically the one with the most specific \fIhost\fR/domain match and
+most specific \fIrequestPath\fR/path match), but there may be many cookies
+with different names in any request.
+.RE
+.TP
+\fIcookieJar \fBstoreCookie \fIcookieDictionary\fR
+.
+This command asks the cookie jar to store a particular cookie that was
+returned by a request; the result of this command is ignored. The cookie
+(which will have been parsed by the http package) is described by a
+dictionary, \fIcookieDictionary\fR, that may have the following keys:
+.RS
+.TP
+\fBdomain\fR
+.
+This is always present. Its value describes the domain hostname \fIor
+prefix\fR that the cookie should be returned for. The checking of the domain
+against the origin (below) should be careful since sites that issue cookies
+should only do so for domains related to themselves. Cookies that do not obey
+a relevant origin matching rule should be ignored.
+.TP
+\fBexpires\fR
+.
+This is optional. If present, the cookie is intended to be a persistent cookie
+and the value of the option is the Tcl timestamp (in seconds from the same
+base as \fBclock seconds\fR) of when the cookie expires (which may be in the
+past, which should result in the cookie being deleted immediately). If absent,
+the cookie is intended to be a session cookie that should be not persisted
+beyond the lifetime of the cookie jar.
+.TP
+\fBhostonly\fR
+.
+This is always present. Its value is a boolean that describes whether the
+cookie is a single host cookie (true) or a domain-level cookie (false).
+.TP
+\fBhttponly\fR
+.
+This is always present. Its value is a boolean that is true when the site
+wishes the cookie to only ever be used with HTTP (or HTTPS) traffic.
+.TP
+\fBkey\fR
+.
+This is always present. Its value is the \fIkey\fR of the cookie, which is
+part of the information that must be return when sending this cookie back in a
+future request.
+.TP
+\fBorigin\fR
+.
+This is always present. Its value describes where the http package believes it
+received the cookie from, which may be useful for checking whether the
+cookie's domain is valid.
+.TP
+\fBpath\fR
+.
+This is always present. Its value describes the path prefix of requests to the
+cookie domain where the cookie should be returned.
+.TP
+\fBsecure\fR
+.
+This is always present. Its value is a boolean that is true when the cookie
+should only used on requests sent over secure channels (typically HTTPS).
+.TP
+\fBvalue\fR
+.
+This is always present. Its value is the value of the cookie, which is part of
+the information that must be return when sending this cookie back in a future
+request.
+.PP
+Other keys may always be ignored; they have no meaning in this protocol.
+.RE
+.VE TIP406
.SH EXAMPLE
.PP
This example creates a procedure to copy a URL to a file while printing a
diff --git a/doc/idna.n b/doc/idna.n
new file mode 100644
index 0000000..744bf67
--- /dev/null
+++ b/doc/idna.n
@@ -0,0 +1,88 @@
+'\"
+'\" Copyright (c) 2014-2018 Donal K. Fellows.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH "idna" n 0.1 http "Tcl Bundled Packages"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tcl::idna \- Support for normalization of Internationalized Domain Names
+.SH SYNOPSIS
+.nf
+package require tcl::idna 1.0
+
+\fBtcl::idna decode\fR \fIhostname\fR
+\fBtcl::idna encode\fR \fIhostname\fR
+\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
+\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
+\fBtcl::idna version\fR
+.fi
+.SH DESCRIPTION
+This package provides an implementation of the punycode scheme used in
+Internationalised Domain Names, and some access commands. (See RFC 3492 for a
+description of punycode.)
+.TP
+\fBtcl::idna decode\fR \fIhostname\fR
+.
+This command takes the name of a host that potentially contains
+punycode-encoded character sequences, \fIhostname\fR, and returns the hostname
+as might be displayed to the user. Note that there are often UNICODE
+characters that have extremely similar glyphs, so care should be taken with
+displaying hostnames to users.
+.TP
+\fBtcl::idna encode\fR \fIhostname\fR
+.
+This command takes the name of a host as might be displayed to the user,
+\fIhostname\fR, and returns the version of the hostname with characters not
+permitted in basic hostnames encoded with punycode.
+.TP
+\fBtcl::idna puny\fR \fIsubcommand ...\fR
+.
+This command provides direct access to the basic punycode encoder and
+decoder. It supports two \fIsubcommand\fRs:
+.RS
+.TP
+\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
+.
+This command decodes the punycode-encoded string, \fIstring\fR, and returns
+the result. If \fIcase\fR is provided, it is a boolean to make the case be
+folded to upper case (if \fIcase\fR is true) or lower case (if \fIcase\fR is
+false) during the decoding process; if omitted, no case transformation is
+applied.
+.TP
+\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
+.
+This command encodes the string, \fIstring\fR, and returns the
+punycode-encoded version of the string. If \fIcase\fR is provided, it is a
+boolean to make the case be folded to upper case (if \fIcase\fR is true) or
+lower case (if \fIcase\fR is false) during the encoding process; if omitted,
+no case transformation is applied.
+.RE
+.TP
+\fBtcl::idna version\fR
+.
+This returns the version of the \fBtcl::idna\fR package.
+.SH "EXAMPLE"
+.PP
+This is an example of how punycoding of a string works:
+.PP
+.CS
+package require tcl::idna
+
+puts [\fBtcl::idna puny encode\fR "abc\(->def"]
+# prints: \fIabcdef-kn2c\fR
+puts [\fBtcl::idna puny decode\fR "abcdef-kn2c"]
+# prints: \fIabc\(->def\fR
+.CE
+'\" TODO: show how it handles a real domain name
+.SH "SEE ALSO"
+http(n), cookiejar(n)
+.SH KEYWORDS
+internet, www
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/if.n b/doc/if.n
index 776f811..ff2518d 100644
--- a/doc/if.n
+++ b/doc/if.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH if n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/incr.n b/doc/incr.n
index 9052c5a..f491903 100644
--- a/doc/incr.n
+++ b/doc/incr.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH incr n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -27,6 +27,11 @@ and also returned as result.
Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
to \fBincr\fR may be unset, and in that case, it will be set to
the value \fIincrement\fR or to the default increment value of \fB1\fR.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, the sum of the default value and the \fIincrement\fR (or
+1) will be stored in the array element.
+.VE TIP508
.SH EXAMPLES
.PP
Add one to the contents of the variable \fIx\fR:
@@ -59,3 +64,7 @@ an error if it is not):
expr(n), set(n)
.SH KEYWORDS
add, increment, variable, value
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/info.n b/doc/info.n
index 1ad908d..cf5a438 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -7,7 +7,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -35,16 +35,51 @@ Returns the body of procedure \fIprocname\fR. \fIProcname\fR must be
the name of a Tcl command procedure.
.TP
\fBinfo class\fI subcommand class\fR ?\fIarg ...\fR
-.VS 8.6
+.
Returns information about the class, \fIclass\fR. The \fIsubcommand\fRs are
described in \fBCLASS INTROSPECTION\fR below.
-.VE 8.6
.TP
\fBinfo cmdcount\fR
.
Returns a count of the total number of commands that have been invoked
in this interpreter.
.TP
+\fBinfo cmdtype \fIcommandName\fR
+.VS TIP426
+Returns a description of the kind of command named by \fIcommandName\fR. The
+supported types are:
+.RS
+.IP \fBalias\fR
+Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that
+safe interpreters can only see a subset of aliases (specifically those between
+two commands within themselves).
+.IP \fBcoroutine\fR
+Indicates that \fIcommandName\fR was created by \fBcoroutine\fR.
+.IP \fBensemble\fR
+Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR.
+.IP \fBimport\fR
+Indicates that \fIcommandName\fR was created by \fBnamespace import\fR.
+.IP \fBnative\fR
+Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
+interface directly without further registration of the type of command.
+.IP \fBobject\fR
+Indicates that \fIcommandName\fR is the public command that represents an
+instance of \fBoo::object\fR or one of its subclasses.
+.IP \fBprivateObject\fR
+Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default)
+that represents an instance of \fBoo::object\fR or one of its subclasses.
+.IP \fBproc\fR
+Indicates that \fIcommandName\fR was created by \fBproc\fR.
+.IP \fBslave\fR
+Indicates that \fIcommandName\fR was created by \fBinterp create\fR.
+.IP \fBzlibStream\fR
+Indicates that \fIcommandName\fR was created by \fBzlib stream\fR.
+.PP
+There may be other registered types as well; this is a set that is extensible
+at the implementation level with \fBTcl_RegisterCommandTypeName\fR.
+.RE
+.VE TIP426
+.TP
\fBinfo commands \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified,
@@ -78,11 +113,10 @@ command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
-.VS 8.6
+.
Returns the name of the currently executing \fBcoroutine\fR, or the empty
string if either no coroutine is currently executing, or the current coroutine
has been deleted (but has not yet returned or yielded since deletion).
-.VE 8.6
.TP
\fBinfo default \fIprocname arg varname\fR
.
@@ -93,7 +127,7 @@ Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
-.VS 8.6
+.
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.
@@ -118,7 +152,6 @@ options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBtclsh\fR.
.RE
-.VE 8.6
.TP
\fBinfo exists \fIvarName\fR
.
@@ -297,10 +330,11 @@ scripts are stored.
This is actually the value of the \fBtcl_library\fR
variable and may be changed by setting \fBtcl_library\fR.
.TP
-\fBinfo loaded \fR?\fIinterp\fR?
+\fBinfo loaded \fR?\fIinterp\fR? ?\fIpackage\fR?
.
-Returns a list describing all of the packages that have been loaded into
-\fIinterp\fR with the \fBload\fR command.
+Returns the filename loaded as part of \fIpackage\fR. If \fIpackage\fR
+is not specified, returns a list describing all of the packages
+that have been loaded into \fIinterp\fR with the \fBload\fR command.
Each list element is a sub-list with two elements consisting of the
name of the file from which the package was loaded and the name of
the package.
@@ -328,10 +362,9 @@ was invoked. If Tcl was unable to identify the file, then an empty
string is returned.
.TP
\fBinfo object\fI subcommand object\fR ?\fIarg ...\fR
-.VS 8.6
+.
Returns information about the object, \fIobject\fR. The \fIsubcommand\fRs are
described in \fBOBJECT INTROSPECTION\fR below.
-.VE 8.6
.TP
\fBinfo patchlevel\fR
.
@@ -398,20 +431,22 @@ Note that a currently-visible variable may not yet
if it has not
been set (e.g. a variable declared but not set by \fBvariable\fR).
.SS "CLASS INTROSPECTION"
-.VS 8.6
.PP
The following \fIsubcommand\fR values are supported by \fBinfo class\fR:
-.VE 8.6
.TP
\fBinfo class call\fI class method\fR
-.VS
+.
Returns a description of the method implementations that are used to provide a
stereotypical instance of \fIclass\fR's implementation of \fImethod\fR
(stereotypical instances being objects instantiated by a class without having
any object-specific definitions added). This consists of a list of lists of
four elements, where each sublist consists of a word that describes the
general type of method implementation (being one of \fBmethod\fR for an
-ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
+ordinary method, \fBfilter\fR for an applied filter,
+.VS TIP500
+\fBprivate\fR for a private method,
+.VE TIP500
+and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
@@ -422,122 +457,167 @@ implementation (see \fBinfo class methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
-actually use \fBnext\fR to transfer control along the call chain.
+actually use \fBnext\fR to transfer control along the call chain,
+.VS TIP500
+and the call chains that this command files do not actually contain private
+methods.
+.VE TIP500
.RE
-.VE 8.6
.TP
\fBinfo class constructor\fI class\fR
-.VS 8.6
+.
This subcommand returns a description of the definition of the constructor of
class \fIclass\fR. The definition is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
passing to another call to \fBproc\fR or a method definition, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.
-.VE 8.6
.TP
\fBinfo class definition\fI class method\fR
-.VS 8.6
+.
This subcommand returns a description of the definition of the method named
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
list; the first element is the list of arguments to the method in a form
suitable for passing to another call to \fBproc\fR or a method definition, and
the second element is the body of the method.
-.VE 8.6
+.TP
+\fBinfo class definitionnamespace\fI class\fR ?\fIkind\fR?
+.VS TIP524
+This subcommand returns the definition namespace for \fIkind\fR definitions of
+the class \fIclass\fR; the definition namespace only affects the instances of
+\fIclass\fR, not \fIclass\fR itself. The \fIkind\fR can be either
+\fB\-class\fR to return the definition namespace used for \fBoo::define\fR, or
+\fB\-instance\fR to return the definition namespace used for
+\fBoo::objdefine\fR; the \fB\-class\fR kind is default (though this is only
+actually useful on classes that are subclasses of \fBoo::class\fR).
+.RS
+.PP
+If \fIclass\fR does not provide a definition namespace of the specified kind,
+this command returns the empty string. In those circumstances, the
+\fBoo::define\fR and \fBoo::objdefine\fR commands look up which definition
+namespace to use using the class inheritance hierarchy.
+.RE
+.VE TIP524
.TP
\fBinfo class destructor\fI class\fR
-.VS 8.6
+.
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.
-.VE 8.6
.TP
\fBinfo class filters\fI class\fR
-.VS 8.6
+.
This subcommand returns the list of filter methods set on the class.
-.VE 8.6
.TP
\fBinfo class forward\fI class method\fR
-.VS 8.6
+.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the class called \fIclass\fR.
-.VE 8.6
.TP
\fBinfo class instances\fI class\fR ?\fIpattern\fR?
-.VS 8.6
+.
This subcommand returns a list of instances of class \fIclass\fR. If the
optional \fIpattern\fR argument is present, it constrains the list of returned
instances to those that match it according to the rules of \fBstring match\fR.
-.VE 8.6
.TP
\fBinfo class methods\fI class\fR ?\fIoptions...\fR?
-.VS 8.6
+.
This subcommand returns a list of all public (i.e. exported) methods of the
class called \fIclass\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
-.VE 8.6
.TP
\fB\-all\fR
-.VS 8.6
-If the \fB\-all\fR flag is given, the list of methods will include those
+.
+If the \fB\-all\fR flag is given,
+.VS TIP500
+and the \fB\-scope\fR flag is not given,
+.VE TIP500
+the list of methods will include those
methods defined not just by the class, but also by the class's superclasses
and mixins.
-.VE 8.6
.TP
\fB\-private\fR
-.VS 8.6
-If the \fB\-private\fR flag is given, the list of methods will also include
-the private (i.e. non-exported) methods of the class (and superclasses and
+.
+If the \fB\-private\fR flag is given,
+.VS TIP500
+and the \fB\-scope\fR flag is not given,
+.VE TIP500
+the list of methods will also include
+the non-exported methods of the class (and superclasses and
mixins, if \fB\-all\fR is also given).
+.VS TIP500
+Note that this naming is an unfortunate clash with true private methods; this
+option name is retained for backward compatibility.
+.VE TIP500
+.TP
+\fB\-scope\fI scope\fR
+.VS TIP500
+Returns a list of all methods on \fIclass\fR that have the given visibility
+\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
+\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
+.RS
+.IP \fBpublic\fR 3
+Only methods with \fIpublic\fR scope (i.e., callable from anywhere by any instance
+of this class) are to be returned.
+.IP \fBunexported\fR 3
+Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
+be returned.
+.IP \fBprivate\fR 3
+Only methods with \fIprivate\fR scope (i.e., only callable from within this class's
+methods) are to be returned.
+.RE
+.VE TIP500
.RE
-.VE 8.6
.TP
\fBinfo class methodtype\fI class method\fR
-.VS 8.6
+.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of class \fIclass\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo class
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo class forward\fR.
-.VE 8.6
.TP
\fBinfo class mixins\fI class\fR
-.VS 8.6
+.
This subcommand returns a list of all classes that have been mixed into the
class named \fIclass\fR.
-.VE 8.6
.TP
\fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
-.VS 8.6
+.
This subcommand returns a list of direct subclasses of class \fIclass\fR. If
the optional \fIpattern\fR argument is present, it constrains the list of
returned classes to those that match it according to the rules of
\fBstring match\fR.
-.VE 8.6
.TP
\fBinfo class superclasses\fI class\fR
-.VS 8.6
+.
This subcommand returns a list of direct superclasses of class \fIclass\fR in
inheritance precedence order.
-.VE 8.6
.TP
-\fBinfo class variables\fI class\fR
-.VS 8.6
+\fBinfo class variables\fI class\fR ?\fB\-private\fR?
+.
This subcommand returns a list of all variables that have been declared for
the class named \fIclass\fR (i.e. that are automatically present in the
class's methods, constructor and destructor).
+.VS TIP500
+If the \fB\-private\fR option is specified, this lists the private variables
+declared instead.
+.VE TIP500
.SS "OBJECT INTROSPECTION"
.PP
The following \fIsubcommand\fR values are supported by \fBinfo object\fR:
-.VE 8.6
.TP
\fBinfo object call\fI object method\fR
-.VS 8.6
+.
Returns a description of the method implementations that are used to provide
\fIobject\fR's implementation of \fImethod\fR. This consists of a list of
lists of four elements, where each sublist consists of a word that describes
the general type of method implementation (being one of \fBmethod\fR for an
-ordinary method, \fBfilter\fR for an applied filter, and \fBunknown\fR for a
+ordinary method, \fBfilter\fR for an applied filter,
+.VS TIP500
+\fBprivate\fR for a private method,
+.VE TIP500
+and \fBunknown\fR for a
method that is invoked as part of unknown method handling), a word giving the
name of the particular method invoked (which is always the same as
\fImethod\fR for the \fBmethod\fR type, and
@@ -549,128 +629,160 @@ implementation (see \fBinfo object methodtype\fR).
.RS
.PP
Note that there is no inspection of whether the method implementations
-actually use \fBnext\fR to transfer control along the call chain.
+actually use \fBnext\fR to transfer control along the call chain,
+.VS TIP500
+and the call chains that this command files do not actually contain private
+methods.
+.VE TIP500
.RE
-.VE 8.6
.TP
\fBinfo object class\fI object\fR ?\fIclassName\fR?
-.VS 8.6
+.
If \fIclassName\fR is unspecified, this subcommand returns class of the
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
-.VE 8.6
+.TP
+\fBinfo object creationid\fI object\fR
+.VS TIP500
+Returns the unique creation identifier for the \fIobject\fR object. This
+creation identifier is unique to the object (within a Tcl interpreter) and
+cannot be controlled at object creation time or altered afterwards.
+.RS
+.PP
+\fIImplementation note:\fR the creation identifier is used to generate unique
+identifiers associated with the object, especially for private variables.
+.RE
+.VE TIP500
.TP
\fBinfo object definition\fI object method\fR
-.VS 8.6
+.
This subcommand returns a description of the definition of the method named
\fImethod\fR of object \fIobject\fR. The definition is described as a two
element list; the first element is the list of arguments to the method in a
form suitable for passing to another call to \fBproc\fR or a method definition,
and the second element is the body of the method.
-.VE 8.6
.TP
\fBinfo object filters\fI object\fR
-.VS 8.6
+.
This subcommand returns the list of filter methods set on the object.
-.VE 8.6
.TP
\fBinfo object forward\fI object method\fR
-.VS 8.6
+.
This subcommand returns the argument list for the method forwarding called
\fImethod\fR that is set on the object called \fIobject\fR.
-.VE 8.6
.TP
\fBinfo object isa\fI category object\fR ?\fIarg\fR?
-.VS 8.6
+.
This subcommand tests whether an object belongs to a particular category,
returning a boolean value that indicates whether the \fIobject\fR argument
meets the criteria for the category. The supported categories are:
-.VE 8.6
.RS
.TP
\fBinfo object isa class\fI object\fR
-.VS 8.6
+.
This returns whether \fIobject\fR is a class (i.e. an instance of
\fBoo::class\fR or one of its subclasses).
-.VE 8.6
.TP
\fBinfo object isa metaclass\fI object\fR
-.VS 8.6
+.
This returns whether \fIobject\fR is a class that can manufacture classes
(i.e. is \fBoo::class\fR or a subclass of it).
-.VE 8.6
.TP
\fBinfo object isa mixin\fI object class\fR
-.VS 8.6
+.
This returns whether \fIclass\fR is directly mixed into \fIobject\fR.
-.VE 8.6
.TP
\fBinfo object isa object\fI object\fR
-.VS 8.6
+.
This returns whether \fIobject\fR really is an object.
-.VE 8.6
.TP
\fBinfo object isa typeof\fI object class\fR
-.VS 8.6
+.
This returns whether \fIclass\fR is the type of \fIobject\fR (i.e. whether
\fIobject\fR is an instance of \fIclass\fR or one of its subclasses, whether
direct or indirect).
.RE
-.VE 8.6
.TP
\fBinfo object methods\fI object\fR ?\fIoption...\fR?
-.VS 8.6
+.
This subcommand returns a list of all public (i.e. exported) methods of the
object called \fIobject\fR. Any of the following \fIoption\fRs may be
specified, controlling exactly which method names are returned:
.RS
-.VE 8.6
.TP
\fB\-all\fR
-.VS 8.6
-If the \fB\-all\fR flag is given, the list of methods will include those
+.
+If the \fB\-all\fR flag is given,
+.VS TIP500
+and the \fB\-scope\fR flag is not given,
+.VE TIP500
+the list of methods will include those
methods defined not just by the object, but also by the object's class and
mixins, plus the superclasses of those classes.
-.VE 8.6
.TP
\fB\-private\fR
-.VS 8.6
-If the \fB\-private\fR flag is given, the list of methods will also include
-the private (i.e. non-exported) methods of the object (and classes, if
+.
+If the \fB\-private\fR flag is given,
+.VS TIP500
+and the \fB\-scope\fR flag is not given,
+.VE TIP500
+the list of methods will also include
+the non-exported methods of the object (and classes, if
\fB\-all\fR is also given).
+.VS TIP500
+Note that this naming is an unfortunate clash with true private methods; this
+option name is retained for backward compatibility.
+.VE TIP500
+.TP
+\fB\-scope\fI scope\fR
+.VS TIP500
+Returns a list of all methods on \fIobject\fR that have the given visibility
+\fIscope\fR. When this option is supplied, both the \fB\-all\fR and
+\fB\-private\fR options are ignored. The valid values for \fIscope\fR are:
+.RS
+.IP \fBpublic\fR 3
+Only methods with \fIpublic\fR scope (i.e., callable from anywhere) are to be
+returned.
+.IP \fBunexported\fR 3
+Only methods with \fIunexported\fR scope (i.e., only callable via \fBmy\fR) are to
+be returned.
+.IP \fBprivate\fR 3
+Only methods with \fIprivate\fR scope (i.e., only callable from within this object's
+instance methods) are to be returned.
+.RE
+.VE TIP500
.RE
-.VE 8.6
.TP
\fBinfo object methodtype\fI object method\fR
-.VS 8.6
+.
This subcommand returns a description of the type of implementation used for
the method named \fImethod\fR of object \fIobject\fR. When the result is
\fBmethod\fR, further information can be discovered with \fBinfo object
definition\fR, and when the result is \fBforward\fR, further information can
be discovered with \fBinfo object forward\fR.
-.VE 8.6
.TP
\fBinfo object mixins\fI object\fR
-.VS 8.6
+.
This subcommand returns a list of all classes that have been mixed into the
object named \fIobject\fR.
-.VE 8.6
.TP
\fBinfo object namespace\fI object\fR
-.VS 8.6
+.
This subcommand returns the name of the internal namespace of the object named
\fIobject\fR.
-.VE 8.6
.TP
-\fBinfo object variables\fI object\fR
-.VS 8.6
+\fBinfo object variables\fI object\fRR ?\fB\-private\fR?
+.
This subcommand returns a list of all variables that have been declared for
the object named \fIobject\fR (i.e. that are automatically present in the
object's methods).
-.VE 8.6
+.VS TIP500
+If the \fB\-private\fR option is specified, this lists the private variables
+declared instead.
+.VE TIP500
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
-.VS 8.6
+.
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
@@ -679,7 +791,6 @@ from the list returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).
-.VE 8.6
.SH EXAMPLES
.PP
This command prints out a procedure suitable for saving in a Tcl
@@ -702,7 +813,6 @@ proc printProc {procName} {
}
.CE
.SS "EXAMPLES WITH OBJECTS"
-.VS 8.6
.PP
Every object necessarily knows what its class is; this information is
trivially extractable through introspection:
@@ -723,8 +833,10 @@ method and get how it is defined. This procedure illustrates how:
proc getDef {obj method} {
foreach inf [\fBinfo object call\fR $obj $method] {
lassign $inf calltype name locus methodtype
+
# Assume no forwards or filters, and hence no $calltype
# or $methodtype checks...
+
if {$locus eq "object"} {
return [\fBinfo object definition\fR $obj $name]
} else {
@@ -747,7 +859,9 @@ proc getDef {obj method} {
# Assume no forwards
return [\fBinfo object definition\fR $obj $method]
}
+
set cls [\fBinfo object class\fR $obj]
+
while {$method ni [\fBinfo class methods\fR $cls]} {
# Assume the simple case
set cls [lindex [\fBinfo class superclass\fR $cls] 0]
@@ -755,22 +869,17 @@ proc getDef {obj method} {
error "no definition for $method"
}
}
+
# Assume no forwards
return [\fBinfo class definition\fR $cls $method]
}
.CE
-.VE 8.6
.SH "SEE ALSO"
-.VS 8.6
global(n), oo::class(n), oo::define(n), oo::object(n), proc(n), self(n),
-.VE 8.6
tcl_library(n), tcl_patchLevel(n), tcl_version(n)
.SH KEYWORDS
command, information, interpreter, introspection, level, namespace,
-.VS 8.6
-object,
-.VE 8.6
-procedure, variable
+object, procedure, variable
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
diff --git a/doc/interp.n b/doc/interp.n
index 92113a6..e91e403 100644
--- a/doc/interp.n
+++ b/doc/interp.n
@@ -5,7 +5,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH interp n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -236,7 +236,7 @@ attempts are silently ignored. This is needed to maintain the
consistency of the underlying interpreter's state.
.RE
.TP
-\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
+\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
.
Deletes zero or more interpreters given by the optional \fIpath\fR
arguments, and for each interpreter, it also deletes its slaves. The
diff --git a/doc/join.n b/doc/join.n
index c8179bb..7dcde98 100644
--- a/doc/join.n
+++ b/doc/join.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH join n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -42,3 +42,7 @@ set data {1 {2 3} 4 {5 {6 7} 8}}
list(n), lappend(n), split(n)
.SH KEYWORDS
element, join, list, separator
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/lappend.n b/doc/lappend.n
index a324ca3..66bea5f 100644
--- a/doc/lappend.n
+++ b/doc/lappend.n
@@ -5,7 +5,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH lappend n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -22,6 +22,12 @@ and appends each of the \fIvalue\fR arguments to that list as a separate
element, with spaces between elements.
If \fIvarName\fR does not exist, it is created as a list with elements
given by the \fIvalue\fR arguments.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, list that is comprised of the default value with all the
+\fIvalue\fR arguments appended as elements will be stored in the array
+element.
+.VE TIP508
\fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
are appended as list elements rather than raw text.
This command provides a relatively efficient way to build up
@@ -47,3 +53,7 @@ list(n), lindex(n), linsert(n), llength(n), lset(n),
lsort(n), lrange(n)
.SH KEYWORDS
append, element, list, variable
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/lassign.n b/doc/lassign.n
index e250729..5620de6 100644
--- a/doc/lassign.n
+++ b/doc/lassign.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH lassign n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/lindex.n b/doc/lindex.n
index d5605bc..be4f169 100644
--- a/doc/lindex.n
+++ b/doc/lindex.n
@@ -13,7 +13,7 @@
.SH NAME
lindex \- Retrieve an element from a list
.SH SYNOPSIS
-\fBlindex \fIlist ?index ...?\fR
+\fBlindex \fIlist\fR ?\fIindex ...\fR?
.BE
.SH DESCRIPTION
.PP
diff --git a/doc/link.n b/doc/link.n
new file mode 100644
index 0000000..7219342
--- /dev/null
+++ b/doc/link.n
@@ -0,0 +1,124 @@
+'\"
+'\" Copyright (c) 2011-2015 Andreas Kupries
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH link n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+link \- create link from command to method of object
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBlink\fR \fImethodName\fR ?\fI...\fR?
+\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBlink\fR command is available within methods. It takes a series of one
+or more method names (\fImethodName ...\fR) and/or pairs of command- and
+method-name (\fB{\fIcommandName methodName\fB}\fR) and makes the named methods
+available as commands without requiring the explicit use of the name of the
+object or the \fBmy\fR command. The method does not need to exist at the time
+that the link is made; if the link command is invoked when the method does not
+exist, the standard \fBunknown\fR method handling system is used.
+.PP
+The command name under which the method becomes available defaults to the
+method name, except where explicitly specified through an alias/method pair.
+Formally, every argument must be a list; if the list has two elements, the
+first element is the name of the command to create and the second element is
+the name of the method of the current object to which the command links;
+otherwise, the name of the command and the name of the method are the same
+string (the first element of the list).
+.PP
+If the name of the command is not a fully-qualified command name, it will be
+resolved with respect to the current namespace (i.e., the object namespace).
+.SH EXAMPLES
+This demonstrates linking a single method in various ways. First it makes a
+simple link, then a renamed link, then an external link. Note that the method
+itself is unexported, but that it can still be called directly from outside
+the class.
+.PP
+.CS
+oo::class create ABC {
+ method Foo {} {
+ puts "This is Foo in [self]"
+ }
+
+ constructor {} {
+ \fBlink\fR Foo
+ # The method foo is now directly accessible as foo here
+ \fBlink\fR {bar Foo}
+ # The method foo is now directly accessible as bar
+ \fBlink\fR {::ExternalCall Foo}
+ # The method foo is now directly accessible in the global
+ # namespace as ExternalCall
+ }
+
+ method grill {} {
+ puts "Step 1:"
+ Foo
+ puts "Step 2:"
+ bar
+ }
+}
+
+ABC create abc
+abc grill
+ \fI\(-> Step 1:\fR
+ \fI\(-> This is foo in ::abc\fR
+ \fI\(-> Step 2:\fR
+ \fI\(-> This is foo in ::abc\fR
+# Direct access via the linked command
+puts "Step 3:"; ExternalCall
+ \fI\(-> Step 3:\fR
+ \fI\(-> This is foo in ::abc\fR
+.CE
+.PP
+This example shows that multiple linked commands can be made in a call to
+\fBlink\fR, and that they can handle arguments.
+.PP
+.CS
+oo::class create Ex {
+ constructor {} {
+ \fBlink\fR a b c
+ # The methods a, b, and c (defined below) are all now
+ # directly acessible within methods under their own names.
+ }
+
+ method a {} {
+ puts "This is a"
+ }
+ method b {x} {
+ puts "This is b($x)"
+ }
+ method c {y z} {
+ puts "This is c($y,$z)"
+ }
+
+ method call {p q r} {
+ a
+ b $p
+ c $q $r
+ }
+}
+
+set o [Ex new]
+$o 3 5 7
+ \fI\(-> This is a\fR
+ \fI\(-> This is b(3)\fR
+ \fI\(-> This is c(5,7)\fR
+.CE
+.SH "SEE ALSO"
+interp(n), my(n), oo::class(n), oo::define(n)
+.SH KEYWORDS
+command, method, object
+.\" Local Variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/list.n b/doc/list.n
index c2797f3..a182fc8 100644
--- a/doc/list.n
+++ b/doc/list.n
@@ -5,7 +5,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH list n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/llength.n b/doc/llength.n
index 79f93c0..7e46064 100644
--- a/doc/llength.n
+++ b/doc/llength.n
@@ -53,3 +53,7 @@ list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
lset(n), lsort(n), lrange(n), lreplace(n)
.SH KEYWORDS
element, list, length
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/load.n b/doc/load.n
index 2ab8f2e..b592bb3 100644
--- a/doc/load.n
+++ b/doc/load.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH load n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/lpop.n b/doc/lpop.n
new file mode 100644
index 0000000..0ce8ff8
--- /dev/null
+++ b/doc/lpop.n
@@ -0,0 +1,96 @@
+'\"
+'\" Copyright (c) 2018 by Peter Spjuth. All rights reserved.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH lpop n 8.7 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+lpop \- Get and remove an element in a list
+.SH SYNOPSIS
+\fBlpop \fIvarName ?index ...?\fR
+.BE
+.SH DESCRIPTION
+.PP
+The \fBlpop\fR command accepts a parameter, \fIvarName\fR, which
+it interprets as the name of a variable containing a Tcl list.
+It also accepts one or more \fIindices\fR into
+the list. If no indices are presented, it defaults to "end".
+.PP
+When presented with a single index, the \fBlpop\fR command
+addresses the \fIindex\fR'th element in it, removes if from the list
+and returns the element.
+.PP
+If \fIindex\fR is negative or greater or equal than the number
+of elements in \fI$varName\fR, then an error occurs.
+.PP
+The interpretation of each simple \fIindex\fR value is the same as
+for the command \fBstring index\fR, supporting simple index
+arithmetic and indices relative to the end of the list.
+.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 remove elements in sublists.
+The command,
+.PP
+.CS
+\fBlpop\fR a 1 2
+.CE
+.PP
+gets and removes element 2 of sublist 1.
+.PP
+.SH EXAMPLES
+.PP
+In each of these examples, the initial value of \fIx\fR is:
+.PP
+.CS
+set x [list [list a b c] [list d e f] [list g h i]]
+ \fI\(-> {a b c} {d e f} {g h i}\fR
+.CE
+.PP
+The indicated value becomes the new value of \fIx\fR
+(except in the last case, which is an error which leaves the value of
+\fIx\fR unchanged.)
+.PP
+.CS
+\fBlpop\fR x 0
+ \fI\(-> {d e f} {g h i}\fR
+\fBlpop\fR x 2
+ \fI\(-> {a b c} {d e f}\fR
+\fBlpop\fR x end
+ \fI\(-> {a b c} {d e f}\fR
+\fBlpop\fR x end-1
+ \fI\(-> {a b c} {g h i}\fR
+\fBlpop\fR x 2 1
+ \fI\(-> {a b c} {d e f} {g i}\fR
+\fBlpop\fR x 2 3 j
+ \fI\(-> list index out of range\fR
+.CE
+.PP
+In the following examples, the initial value of \fIx\fR is:
+.PP
+.CS
+set x [list [list [list a b] [list c d]] \e
+ [list [list e f] [list g h]]]
+ \fI\(-> {{a b} {c d}} {{e f} {g h}}\fR
+.CE
+.PP
+The indicated value becomes the new value of \fIx\fR.
+.PP
+.CS
+\fBlpop\fR x 1 1 0
+ \fI\(-> {{a b} {c d}} {{e f} h}\fR
+.CE
+.SH "SEE ALSO"
+list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
+lsort(n), lrange(n), lreplace(n), lset(n)
+string(n)
+.SH KEYWORDS
+element, index, list, remove, pop, stack, queue
+'\"Local Variables:
+'\"mode: nroff
+'\"End:
diff --git a/doc/lrange.n b/doc/lrange.n
index ffa6dba..ba068f6 100644
--- a/doc/lrange.n
+++ b/doc/lrange.n
@@ -76,3 +76,7 @@ lset(n), lreplace(n), lsort(n),
string(n)
.SH KEYWORDS
element, list, range, sublist
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/lrepeat.n b/doc/lrepeat.n
index 466339d..4719bfd 100644
--- a/doc/lrepeat.n
+++ b/doc/lrepeat.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH lrepeat n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -33,6 +33,9 @@ is identical to \fBlist element ...\fR.
.CE
.SH "SEE ALSO"
list(n), lappend(n), linsert(n), llength(n), lset(n)
-
.SH KEYWORDS
element, index, list
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/lreverse.n b/doc/lreverse.n
index 51a9e57..4c2f762 100644
--- a/doc/lreverse.n
+++ b/doc/lreverse.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH lreverse n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/lsearch.n b/doc/lsearch.n
index c2644b8..12c2786 100644
--- a/doc/lsearch.n
+++ b/doc/lsearch.n
@@ -148,6 +148,19 @@ or \fB\-not\fR.
These options are used to search lists of lists. They may be used
with any other options.
.TP
+\fB\-stride\0\fIstrideLength\fR
+.
+If this option is specified, the list is treated as consisting of
+groups of \fIstrideLength\fR elements and the groups are searched by
+either their first element or, if the \fB\-index\fR option is used,
+by the element within each group given by the first index passed to
+\fB\-index\fR (which is then ignored by \fB\-index\fR). The resulting
+index always points to the first element in a group.
+.PP
+The list length must be an integer multiple of \fIstrideLength\fR, which
+in turn must be at least 1. A \fIstrideLength\fR of 1 is the default and
+indicates no grouping.
+.TP
\fB\-index\fR\0\fIindexList\fR
.
This option is designed for use when searching within nested lists.
@@ -208,6 +221,13 @@ It is also possible to search inside elements:
\fBlsearch\fR -index 1 -all -inline {{a abc} {b bcd} {c cde}} *bc*
\fI\(-> {a abc} {b bcd}\fR
.CE
+.PP
+The same thing for a flattened list:
+.PP
+.CS
+\fBlsearch\fR -stride 2 -index 1 -all -inline {a abc b bcd c cde} *bc*
+ \fI\(-> {a abc b bcd}\fR
+.CE
.SH "SEE ALSO"
foreach(n), list(n), lappend(n), lindex(n), linsert(n), llength(n),
lset(n), lsort(n), lrange(n), lreplace(n),
diff --git a/doc/msgcat.n b/doc/msgcat.n
index 2fc1eee..3d87ffd 100644
--- a/doc/msgcat.n
+++ b/doc/msgcat.n
@@ -11,9 +11,9 @@
.SH NAME
msgcat \- Tcl message catalog
.SH SYNOPSIS
-\fBpackage require Tcl 8.5\fR
+\fBpackage require Tcl 8.7\fR
.sp
-\fBpackage require msgcat 1.6\fR
+\fBpackage require msgcat 1.7\fR
.sp
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
.sp
@@ -23,9 +23,15 @@ msgcat \- Tcl message catalog
\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
.VE "TIP 412"
.sp
+.VS "TIP 490"
+\fB::msgcat::mcpackagenamespaceget\fR
+.VE "TIP 490"
+.sp
\fB::msgcat::mclocale \fR?\fInewLocale\fR?
.sp
-\fB::msgcat::mcpreferences\fR
+.VS "TIP 499"
+\fB::msgcat::mcpreferences\fR ?\fIlocale preference\fR? ...
+.VE "TIP 499"
.sp
.VS "TIP 412"
\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
@@ -50,6 +56,10 @@ msgcat \- Tcl message catalog
.sp
\fB::msgcat::mcforgetpackage\fR
.VE "TIP 412"
+.sp
+.VS "TIP 499"
+\fB::msgcat::mcutil subcommand\fR ?\fIlocale\fR?
+.VS "TIP 499"
.BE
.SH DESCRIPTION
.PP
@@ -71,6 +81,11 @@ In \fBmsgcat\fR, there is a global locale initialized by the system locale of th
Each package may decide to use the global locale or to use a package specific locale.
.PP
The global locale may be changed on demand, for example by a user initiated language change or within a multi user application like a web server.
+.PP
+.VS tip490
+Object oriented programming is supported by the use of a package namespace.
+.VE tip490
+.PP
.SH COMMANDS
.TP
\fB::msgcat::mc \fIsrc-string\fR ?\fIarg arg ...\fR?
@@ -95,6 +110,17 @@ use the result. If an application is written for a single language in
this fashion, then it is easy to add support for additional languages
later simply by defining new message catalog entries.
.RE
+.VS "TIP 490"
+.TP
+\fB::msgcat::mcn \fInamespace\fR \fIsrc-string\fR ?\fIarg arg ...\fR?
+.
+Like \fB::msgcat::mc\fR, but with the message namespace specified as first argument.
+.PP
+.RS
+\fBmcn\fR may be used for cases where the package namespace is not the namespace of the caller.
+An example is shown within the description of the command \fB::msgcat::mcpackagenamespaceget\fR below.
+.RE
+.PP
.TP
\fB::msgcat::mcmax ?\fIsrc-string src-string ...\fR?
.
@@ -102,29 +128,69 @@ 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).
+.VS "TIP 412"
.TP
-\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? \fIsrc-string\fR
+\fB::msgcat::mcexists\fR ?\fB-exactnamespace\fR? ?\fB-exactlocale\fR? ?\fB-namespace\fR \fInamespace\fR? \fIsrc-string\fR
.
-.VS "TIP 412"
Return true, if there is a translation for the given \fIsrc-string\fR.
.PP
.RS
The search may be limited by the option \fB\-exactnamespace\fR to only check the current namespace and not any parent namespaces.
.PP
It may also be limited by the option \fB\-exactlocale\fR to only check the first prefered locale (e.g. first element returned by \fB::msgcat::mcpreferences\fR if global locale is used).
-.RE
+.PP
.VE "TIP 412"
+.VS "TIP 490"
+An explicit package namespace may be specified by the option \fB-namespace\fR.
+The namespace of the caller is used if not explicitly specified.
+.RE
+.PP
+.VE "TIP 490"
+.VS "TIP 490"
+.TP
+\fB::msgcat::mcpackagenamespaceget\fR
+.
+Return the package namespace of the caller.
+This command handles all cases described in section \fBOBJECT ORIENTED PROGRAMMING\fR.
+.PP
+.RS
+Example usage is a tooltip package, which saves the caller package namespace to update the translation each time the tooltip is shown:
+.CS
+proc ::tooltip::tooltip {widget message} {
+ ...
+ set messagenamespace [uplevel 1 {::msgcat::mcpackagenamespaceget}]
+ ...
+ bind $widget [list ::tooltip::show $widget $messagenamespace $message]
+}
+
+proc ::tooltip::show {widget messagenamespace message} {
+ ...
+ set message [::msgcat::mcn $messagenamespace $message]
+ ...
+}
+.CE
+.RE
+.PP
+.VE "TIP 490"
.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. msgcat stores and compares the locale in a
+If \fInewLocale\fR is omitted, the current locale is returned, otherwise the current locale
+is set to \fInewLocale\fR.
+.PP
+.RS
+If the new locale is set to \fInewLocale\fR, the corresponding preferences are calculated and set.
+For example, if the current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR returns \fB{en_us_funky en_us en {}}\fR.
+.PP
+The same result may be acheved by \fB::msgcat::mcpreferences\fR {*}[\fB::msgcat::mcutil getpreferences\fR \fInewLocale\fR].
+.PP
+The current locale is always the first element of the list returned by \fBmcpreferences\fR.
+.PP
+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.
-.RS
.PP
.VS "TIP 412"
If the locale is set, the preference list of locales is evaluated.
@@ -132,16 +198,26 @@ Locales in this list are loaded now, if not jet loaded.
.VE "TIP 412"
.RE
.TP
-\fB::msgcat::mcpreferences\fR
+\fB::msgcat::mcpreferences\fR ?\fIlocale preference\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. The list is derived from the current
-locale set in msgcat by \fB::msgcat::mclocale\fR, and
-cannot be set independently. For example, if the
-current locale is en_US_funky, then \fB::msgcat::mcpreferences\fR
-returns \fB{en_us_funky en_us en {}}\fR.
+Without arguments, returns an ordered list of the locales preferred by
+the user.
+The list is ordered from most specific to least preference.
+.PP
+.VS "TIP 499"
+.RS
+A set of locale preferences may be given to set the list of locale preferences.
+The current locale is also set, which is the first element of the locale preferences list.
+.PP
+Locale preferences are loaded now, if not jet loaded.
+.PP
+As an example, the user may prefer French or English text. This may be configured by:
+.CS
+::msgcat::mcpreferences fr en {}
+.CE
+.RE
+.PP
+.VS "TIP 499"
.TP
\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
.
@@ -232,6 +308,22 @@ Note that this routine is only called if the concerned package did not set a pac
The calling package clears all its state within the \fBmsgcat\fR package including all settings and translations.
.VE "TIP 412"
.PP
+.VS "TIP 499"
+.TP
+\fB::msgcat::mcutil getpreferences\fR \fIlocale\fR
+.
+Return the preferences list of the given locale as described in section \fBLOCALE SPECIFICATION\fR.
+An example is the composition of a preference list for the bilingual region "Biel/Bienne" as a concatenation of swiss german and swiss french:
+.CS
+% concat [lrange [msgcat::mcutil getpreferences fr_CH] 0 end-1] [msgcat::mcutil getpreferences de_CH]
+fr_ch fr de_ch de {}
+.CE
+.TP
+\fB::msgcat::mcutil getsystemlocale\fR
+.
+The system locale is returned as described by the section \fBLOCALE SPECIFICATION\fR.
+.VE "TIP 499"
+.PP
.SH "LOCALE SPECIFICATION"
.PP
The locale is specified to \fBmsgcat\fR by a locale string
@@ -437,7 +529,7 @@ formatting substitution is done directly.
# human-oriented versions by \fBmsgcat::mcset\fR
.CE
.VS "TIP 412"
-.SH Package private locale
+.SH "PACKAGE PRIVATE LOCALE"
.PP
A package using \fBmsgcat\fR may choose to use its own package private
locale and its own set of loaded locales, independent to the global
@@ -461,10 +553,22 @@ This command may cause the load of locales.
.
Return the package private locale or the global locale, if no package private locale is set.
.TP
-\fB::msgcat::mcpackagelocale preferences\fR
+\fB::msgcat::mcpackagelocale preferences\fR ?\fIlocale preference\fR? ...
.
-Return the package private preferences or the global preferences,
+With no parameters, return the package private preferences or the global preferences,
if no package private locale is set.
+The package locale state (set or not) is not changed (in contrast to the command \fB::msgcat::mcpackagelocale set\fR).
+.PP
+.RS
+.VS "TIP 499"
+If a set of locale preferences is given, it is set as package locale preference list.
+The package locale is set to the first element of the preference list.
+A package locale is activated, if it was not set so far.
+.PP
+Locale preferences are loaded now for the package, if not jet loaded.
+.VE "TIP 499"
+.RE
+.PP
.TP
\fB::msgcat::mcpackagelocale loaded\fR
.
@@ -488,7 +592,7 @@ Returns true, if the given locale is loaded for the package.
.
Clear any loaded locales of the package not present in the package preferences.
.PP
-.SH Changing package options
+.SH "CHANGING PACKAGE OPTIONS"
.PP
Each package using msgcat has a set of options within \fBmsgcat\fR.
The package options are described in the next sectionPackage options.
@@ -563,7 +667,7 @@ A generic unknown handler is used if set to the empty string. This consists in r
See section \fBcallback invocation\fR below.
The appended arguments are identical to \fB::msgcat::mcunknown\fR.
.RE
-.SS Callback invocation
+.SH "Callback invocation"
A package may decide to register one or multiple callbacks, as described above.
.PP
Callbacks are invoked, if:
@@ -577,7 +681,54 @@ Callbacks are invoked, if:
If a called routine fails with an error, the \fBbgerror\fR routine for the interpreter is invoked after command completion.
Only exception is the callback \fBunknowncmd\fR, where an error causes the invoking \fBmc\fR-command to fail with that error.
.PP
-.SS Examples
+.VS tip490
+.SH "OBJECT ORIENTED PROGRAMMING"
+\fBmsgcat\fR supports packages implemented by object oriented programming.
+Objects and classes should be defined within a package namespace.
+.PP
+There are 3 supported cases where package namespace sensitive commands of msgcat (\fBmc\fR, \fBmcexists\fR, \fBmcpackagelocale\fR, \fBmcforgetpackage\fR, \fBmcpackagenamespaceget\fR, \fBmcpackageconfig\fR, \fBmcset\fR and \fBmcmset\fR) may be called:
+.PP
+.TP
+\fB1) In class definition script\fR
+.
+\fBmsgcat\fR command is called within a class definition script.
+.CS
+namespace eval ::N2 {
+ mcload $dir/msgs
+ oo::class create C1 {puts [mc Hi!]}
+}
+.CE
+.PP
+.TP
+\fB2) method defined in a class\fR
+.
+\fBmsgcat\fR command is called from a method in an object and the method is defined in a class.
+.CS
+namespace eval ::N3Class {
+ mcload $dir/msgs
+ oo::class create C1
+ oo::define C1 method m1 {
+ puts [mc Hi!]
+ }
+}
+.CE
+.PP
+.TP
+\fB3) method defined in a classless object\fR
+.
+\fBmsgcat\fR command is called from a method of a classless object.
+.CS
+namespace eval ::N4 {
+ mcload $dir/msgs
+ oo::object create O1
+ oo::objdefine O1 method m1 {} {
+ puts [mc Hi!]
+ }
+}
+.CE
+.PP
+.VE tip490
+.SH EXAMPLES
Packages which display a GUI may update their widgets when the global locale changes.
To register to a callback, use:
.CS
@@ -643,9 +794,9 @@ proc ::tcl::clock::LocalizeFormat { locale format } {
.PP
The message catalog code was developed by Mark Harrison.
.SH "SEE ALSO"
-format(n), scan(n), namespace(n), package(n)
+format(n), scan(n), namespace(n), package(n), oo::class(n), oo::object
.SH KEYWORDS
-internationalization, i18n, localization, l10n, message, text, translation
+internationalization, i18n, localization, l10n, message, text, translation, class, object
.\" Local Variables:
.\" mode: nroff
.\" End:
diff --git a/doc/my.n b/doc/my.n
index 2a9769b..262186f 100644
--- a/doc/my.n
+++ b/doc/my.n
@@ -9,25 +9,45 @@
.BS
'\" Note: do not modify the .SH NAME line immediately below!
.SH NAME
-my \- invoke any method of current object
+my, myclass \- invoke any method of current object or its class
.SH SYNOPSIS
.nf
package require TclOO
\fBmy\fI methodName\fR ?\fIarg ...\fR?
+\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
.fi
.BE
.SH DESCRIPTION
.PP
-The \fBmy\fR command is used to allow methods of objects to invoke any method
-of the object (or its class). In particular, the set of valid values for
+The \fBmy\fR command is used to allow methods of objects to invoke methods
+of the object (or its class),
+.VS TIP478
+and he \fBmyclass\fR command is used to allow methods of objects to invoke
+methods of the current class of the object \fIas an object\fR.
+.VE TIP478
+In particular, the set of valid values for
\fImethodName\fR is the set of all methods supported by an object and its
-superclasses, including those that are not exported. The object upon which the
-method is invoked is always the one that is the current context of the method
-(i.e. the object that is returned by \fBself object\fR) from which the
-\fBmy\fR command is invoked.
+superclasses, including those that are not exported
+.VS TIP500
+and private methods of the object or class when used within another method
+defined by that object or class.
+.VE TIP500
.PP
-Each object has its own \fBmy\fR command, contained in its instance namespace.
+The object upon which the method is invoked via \fBmy\fR is the one that owns
+the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
+remains if the command is renamed), which is the currently invoked object by
+default.
+.VS TIP478
+Similarly, the object on which the method is invoked via \fBmyclass\fR is the
+object that is the current class of the object that owns the namespace that
+the \fBmyclass\fR command is contained in initially. As with \fBmy\fR, the
+link remains even if the command is renamed into another namespace, and
+defaults to being the manufacturing class of the current object.
+.VE TIP478
+.PP
+Each object has its own \fBmy\fR and \fBmyclass\fR commands, contained in its
+instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
@@ -40,16 +60,71 @@ oo::class create c {
puts [incr counter]
}
}
+
c create o
o count \fI\(-> prints "1"\fR
o count \fI\(-> prints "2"\fR
o count \fI\(-> prints "3"\fR
.CE
+.PP
+This example shows how you can use \fBmy\fR to make callbacks to private
+methods from outside the object (from a \fBtrace\fR), using
+\fBnamespace code\fR to enter the correct context. (See the \fBcallback\fR
+command for the recommended way of doing this.)
+.PP
+.CS
+oo::class create HasCallback {
+ method makeCallback {} {
+ return [namespace code {
+ \fBmy\fR Callback
+ }]
+ }
+
+ method Callback {args} {
+ puts "callback: $args"
+ }
+}
+
+set o [HasCallback new]
+trace add variable xyz write [$o makeCallback]
+set xyz "called" \fI\(-> prints "callback: xyz {} write"\fR
+.CE
+.PP
+.VS TIP478
+This example shows how to access a private method of a class from an instance
+of that class. (See the \fBclassmethod\fR declaration in \fBoo::define\fR for
+a higher level interface for doing this.)
+.PP
+.CS
+oo::class create CountedSteps {
+ self {
+ variable count
+ method Count {} {
+ return [incr count]
+ }
+ }
+ method advanceTwice {} {
+ puts "in [self] step A: [\fBmyclass\fR Count]"
+ puts "in [self] step B: [\fBmyclass\fR Count]"
+ }
+}
+
+CountedSteps create x
+CountedSteps create y
+x advanceTwice \fI\(-> prints "in ::x step A: 1"\fR
+ \fI\(-> prints "in ::x step B: 2"\fR
+y advanceTwice \fI\(-> prints "in ::y step A: 3"\fR
+ \fI\(-> prints "in ::y step B: 4"\fR
+x advanceTwice \fI\(-> prints "in ::x step A: 5"\fR
+ \fI\(-> prints "in ::x step B: 6"\fR
+y advanceTwice \fI\(-> prints "in ::y step A: 7"\fR
+ \fI\(-> prints "in ::y step B: 8"\fR
+.CE
+.VE TIP478
.SH "SEE ALSO"
next(n), oo::object(n), self(n)
.SH KEYWORDS
method, method visibility, object, private method, public method
-
.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
diff --git a/doc/namespace.n b/doc/namespace.n
index 1f4e85f..b0b6e25 100644
--- a/doc/namespace.n
+++ b/doc/namespace.n
@@ -303,7 +303,7 @@ used for qualified namespace or variable names.
Sets or returns the unknown command handler for the current namespace.
The handler is invoked when a command called from within the namespace
cannot be found in the current namespace, the namespace's path nor in
-the global namespace.
+the global namespace.
The \fIscript\fR argument, if given, should be a well
formed list representing a command name and optional arguments. When
the handler is invoked, the full invocation line will be appended to the
diff --git a/doc/next.n b/doc/next.n
index 62782e5..8ebaed2 100644
--- a/doc/next.n
+++ b/doc/next.n
@@ -112,6 +112,7 @@ oo::class create theSuperclass {
puts "in the superclass, args = $args"
}
}
+
oo::class create theSubclass {
superclass theSuperclass
method example {args} {
@@ -121,6 +122,7 @@ oo::class create theSubclass {
puts "after chaining from subclass"
}
}
+
theSubclass create obj
oo::objdefine obj method example args {
puts "per-object method, args = $args"
@@ -138,7 +140,7 @@ before chaining from subclass, args = x 1 2 3 y
in the superclass, args = a x 1 2 3 y b
in the superclass, args = pureSynthesis
after chaining from subclass
-before chaining from subclass, args =
+before chaining from subclass, args =
in the superclass, args = a b
in the superclass, args = pureSynthesis
after chaining from subclass
@@ -167,6 +169,7 @@ oo::class create cache {
\fI# Compute value, insert into cache, and return it\fR
return [set ValueCache($key) [\fBnext\fR {*}$args]]
}
+
method flushCache {} {
my variable ValueCache
unset ValueCache
@@ -178,10 +181,12 @@ oo::class create cache {
oo::object create demo
oo::objdefine demo {
mixin cache
+
method compute {a b c} {
after 3000 \fI;# Simulate deep thought\fR
return [expr {$a + $b * $c}]
}
+
method compute2 {a b c} {
after 3000 \fI;# Simulate deep thought\fR
return [expr {$a * $b + $c}]
diff --git a/doc/package.n b/doc/package.n
index a6a972f..5687480 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -12,6 +12,7 @@
package \- Facilities for package loading and version control
.SH SYNOPSIS
.nf
+\fBpackage files\fR \fIpackage\fR
\fBpackage forget\fR ?\fIpackage package ...\fR?
\fBpackage ifneeded \fIpackage version\fR ?\fIscript\fR?
\fBpackage names\fR
@@ -43,6 +44,13 @@ primarily by system scripts that maintain the package database.
The behavior of the \fBpackage\fR command is determined by its first argument.
The following forms are permitted:
.TP
+\fBpackage files\fR \fIpackage\fR
+.
+Lists all files forming part of \fIpackage\fR. Auto-loaded files are not
+included in this list, only files which were directly sourced during package
+initialization. The list order corresponds with the order in which the
+files were sourced.
+.TP
\fBpackage forget\fR ?\fIpackage package ...\fR?
.
Removes all information about each specified package from this interpreter,
@@ -283,8 +291,8 @@ error.
.PP
When an interpreter is created, its initial selection mode value is set to
.QW stable
-unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR
-is set. If that environment variable is defined (with any value) then
+unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR is set
+(to any value) or the Tcl package itself is unstable. Otherwise
the initial (and permanent) selection mode value is set to
.QW latest .
.RE
diff --git a/doc/packagens.n b/doc/packagens.n
index 61e7eca..a6eee1e 100644
--- a/doc/packagens.n
+++ b/doc/packagens.n
@@ -1,7 +1,7 @@
'\"
'\" Copyright (c) 1998-2000 by Scriptics Corporation.
'\" All rights reserved.
-'\"
+'\"
.TH pkg::create n 8.3 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -48,3 +48,7 @@ At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
package(n)
.SH KEYWORDS
auto-load, index, package, version
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/pid.n b/doc/pid.n
index a4df2f3..fa0af56 100644
--- a/doc/pid.n
+++ b/doc/pid.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH pid n 7.0 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -43,6 +43,9 @@ close $pipeline
.SH "SEE ALSO"
exec(n), open(n)
-
.SH KEYWORDS
file, pipeline, process identifier
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/platform.n b/doc/platform.n
index 6abc289..7cb685d 100644
--- a/doc/platform.n
+++ b/doc/platform.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
.so man.macros
.BS
@@ -12,7 +12,7 @@
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
-\fBpackage require platform ?1.0.10?\fR
+\fBpackage require platform\fR ?\fB1.0.10\fR?
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
diff --git a/doc/platform_shell.n b/doc/platform_shell.n
index 64a2e46..a9e14d0 100644
--- a/doc/platform_shell.n
+++ b/doc/platform_shell.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH "platform::shell" n 1.1.4 platform::shell "Tcl Bundled Packages"
.so man.macros
.BS
@@ -12,7 +12,7 @@
platform::shell \- System identification support code and utilities
.SH SYNOPSIS
.nf
-\fBpackage require platform::shell ?1.1.4?\fR
+\fBpackage require platform::shell\fR ?\fB1.1.4\fR?
.sp
\fBplatform::shell::generic \fIshell\fR
\fBplatform::shell::identify \fIshell\fR
@@ -55,3 +55,7 @@ This command returns the contents of \fBtcl_platform(platform)\fR for
the specified Tcl shell.
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/prefix.n b/doc/prefix.n
index 344ade7..d327a78 100644
--- a/doc/prefix.n
+++ b/doc/prefix.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH prefix n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -12,9 +12,9 @@
tcl::prefix \- facilities for prefix matching
.SH SYNOPSIS
.nf
-\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
-\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
-\fB::tcl::prefix match\fR \fI?option ...?\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix all\fR \fItable string\fR
+\fB::tcl::prefix longest\fR \fItable string\fR
+\fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR
.fi
.BE
.SH DESCRIPTION
@@ -22,17 +22,17 @@ tcl::prefix \- facilities for prefix matching
This document describes commands looking up a prefix in a list of strings.
The following commands are supported:
.TP
-\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix all\fR \fItable string\fR
.
Returns a list of all elements in \fItable\fR that begin with the prefix
\fIstring\fR.
.TP
-\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix longest\fR \fItable string\fR
.
Returns the longest common prefix of all elements in \fItable\fR that
begin with the prefix \fIstring\fR.
.TP
-\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable\fR \fIstring\fR
+\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR
.
If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
one element, the matched element is returned. If not, the result depends
diff --git a/doc/process.n b/doc/process.n
new file mode 100644
index 0000000..165e413
--- /dev/null
+++ b/doc/process.n
@@ -0,0 +1,150 @@
+'\"
+'\" Copyright (c) 2017 Frederic Bonnet.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH process n 8.7 Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tcl::process \- Subprocess management
+.SH SYNOPSIS
+\fB::tcl::process \fIoption \fR?\fIarg arg ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+This command provides a way to manage subprocesses created by the \fBopen\fR
+and \fBexec\fR commands, as identified by the process identifiers (PIDs) of
+those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are:
+.TP
+\fB::tcl::process autopurge\fR ?\fIflag\fR?
+.
+Automatic purge facility. If \fIflag\fR is specified as a boolean value then
+it activates or deactivate autopurge. In all cases it returns the current
+status as a boolean value. When autopurge is active,
+\fBTcl_ReapDetachedProcs\fR is called each time the \fBexec\fR command is
+executed or a pipe channel created by \fBopen\fR is closed. When autopurge is
+inactive, \fB::tcl::process\fR purge must be called explicitly. By default
+autopurge is active.
+.TP
+\fB::tcl::process list\fR
+.
+Returns the list of subprocess PIDs. This includes all currently executing
+subprocesses and all terminated subprocesses that have not yet had their
+corresponding process table entries purged.
+.TP
+\fB::tcl::process purge\fR ?\fIpids\fR?
+.
+Cleans up all data associated with terminated subprocesses. If \fIpids\fR is
+specified as a list of PIDs then the command only cleanup data for the matching
+subprocesses if they exist, and raises an error otherwise. If a process listed is
+still active, this command does nothing to that process.
+.TP
+\fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
+.
+Returns a dictionary mapping subprocess PIDs to their respective status. If
+\fIpids\fR is specified as a list of PIDs then the command only returns the
+status of the matching subprocesses if they exist, and raises an error
+otherwise. For active processes, the status is an empty value. For terminated
+processes, the status is a list with the following format:
+.QW "\fB{\fIcode\fR ?\fImsg errorCode\fR?\fB}\fR" ,
+where:
+.RS
+.TP
+\fIcode\fR\0
+.
+is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR
+for TCL_ERROR,
+.TP
+\fImsg\fR\0
+.
+is the human-readable error message,
+.TP
+\fIerrorCode\fR\0
+.
+uses the same format as the \fBerrorCode\fR global variable
+.PP
+Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
+terminated processes (i.e. those where the \fIcode\fR is nonzero). Under the
+hood this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
+non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
+.PP
+Additionally, \fB::tcl::process status\fR accepts the following switches:
+.TP
+\fB\-wait\fR\0
+.
+By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
+called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR
+is specified as a list of PIDs then the command waits until the status of the
+matching subprocesses are available. If \fIpids\fR was not specified, this
+command will wait for all known subprocesses.
+.TP
+\fB\-\|\-\fR
+.
+Marks the end of switches. The argument following this one will
+be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
+.RE
+.SH "EXAMPLES"
+.PP
+These show the use of \fB::tcl::process\fR. Some of the results from
+\fB::tcl::process status\fR are split over multiple lines for readability.
+.PP
+.CS
+\fB::tcl::process autopurge\fR
+ \fI\(-> true\fR
+\fB::tcl::process autopurge\fR false
+ \fI\(-> false\fR
+
+set pid1 [exec command1 a b c | command2 d e f &]
+ \fI\(-> 123 456\fR
+set chan [open "|command1 a b c | command2 d e f"]
+ \fI\(-> file123\fR
+set pid2 [pid $chan]
+ \fI\(-> 789 1011\fR
+
+\fB::tcl::process list\fR
+ \fI\(-> 123 456 789 1011\fR
+
+\fB::tcl::process status\fR
+ \fI\(-> 123 0
+ 456 {1 "child killed: write on pipe with no readers" {
+ CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
+ 789 {1 "child suspended: background tty read" {
+ CHILDSUSP 789 SIGTTIN "background tty read"}}
+ 1011 {}\fR
+
+\fB::tcl::process status\fR 123
+ \fI\(-> 123 0\fR
+
+\fB::tcl::process status\fR 1011
+ \fI\(-> 1011 {}\fR
+
+\fB::tcl::process status\fR -wait
+ \fI\(-> 123 0
+ 456 {1 "child killed: write on pipe with no readers" {
+ CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
+ 789 {1 "child suspended: background tty read" {
+ CHILDSUSP 789 SIGTTIN "background tty read"}}
+ 1011 {1 "child process exited abnormally" {
+ CHILDSTATUS 1011 -1}}\fR
+
+\fB::tcl::process status\fR 1011
+ \fI\(-> 1011 {1 "child process exited abnormally" {
+ CHILDSTATUS 1011 -1}}\fR
+
+\fB::tcl::process purge\fR
+exec command1 1 2 3 &
+ \fI\(-> 1213\fR
+\fB::tcl::process list\fR
+ \fI\(-> 1213\fR
+.CE
+.SH "SEE ALSO"
+exec(n), open(n), pid(n),
+Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
+.SH "KEYWORDS"
+background, child, detach, process, wait
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/puts.n b/doc/puts.n
index 01ca122..0e23c80 100644
--- a/doc/puts.n
+++ b/doc/puts.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH puts n 7.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -96,3 +96,7 @@ close $chan
file(n), fileevent(n), Tcl_StandardChannels(3)
.SH KEYWORDS
channel, newline, output, write
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/pwd.n b/doc/pwd.n
index 31d378f..e96cae5 100644
--- a/doc/pwd.n
+++ b/doc/pwd.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH pwd n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -37,3 +37,7 @@ cd $savedDir
file(n), cd(n), glob(n), filename(n)
.SH KEYWORDS
working directory
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/re_syntax.n b/doc/re_syntax.n
index 7988071..8d732ed 100644
--- a/doc/re_syntax.n
+++ b/doc/re_syntax.n
@@ -293,12 +293,12 @@ treatment is as if the enclosing delimiters were
.QW \fB[.\fR \&
and
.QW \fB.]\fR .)
-For example, if \fBo\fR and \fB\*(qo\fR are the members of an
+For example, if \fBo\fR and \fB\[^o]\fR are the members of an
equivalence class, then
.QW \fB[[=o=]]\fR ,
-.QW \fB[[=\*(qo=]]\fR ,
+.QW \fB[[=\[^o]=]]\fR ,
and
-.QW \fB[o\*(qo]\fR \&
+.QW \fB[o\[^o]]\fR \&
are all synonymous. An equivalence class may not be an endpoint of a range.
.RS
.PP
diff --git a/doc/refchan.n b/doc/refchan.n
index 2232d50..8737556 100644
--- a/doc/refchan.n
+++ b/doc/refchan.n
@@ -1,4 +1,4 @@
-'\"
+'\"
'\" Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
'\"
'\" See the file "license.terms" for information on usage and redistribution
diff --git a/doc/registry.n b/doc/registry.n
index 001def9..ec5910c 100644
--- a/doc/registry.n
+++ b/doc/registry.n
@@ -152,7 +152,7 @@ nulls.
.TP
\fBsz\fR
.
-The registry value contains a null-terminated string. The data is
+The registry value contains a null-terminated string. The data is
represented in Tcl as a string.
.TP
\fBexpand_sz\fR
diff --git a/doc/regsub.n b/doc/regsub.n
index a5b79de..29c118a 100644
--- a/doc/regsub.n
+++ b/doc/regsub.n
@@ -68,6 +68,33 @@ and
sequences are handled for each substitution using the information
from the corresponding match.
.TP
+\fB\-command\fR
+.VS 8.7
+Changes the handling of \fIsubSpec\fR so that it is not treated
+as a template for a substitution string and the substrings
+.QW &
+and
+.QW \e\fIn\fR
+no longer have special meaning. Instead \fIsubSpec\fR must be a
+command prefix, that is, a non-empty list. The substring of \fIstring\fR
+that matches \fIexp\fR, and then each substring that matches each
+capturing sub-RE within \fIexp\fR are appended as additional elements
+to that list. (The items appended to the list are much like what
+\fBregexp\fR \fB-inline\fR would return). The completed list is then
+evaluated as a Tcl command, and the result of that command is the
+substitution string. Any error or exception from command evaluation
+becomes an error or exception from the \fBregsub\fR command.
+.RS
+.PP
+If \fB\-all\fR is not also given, the command callback will be invoked at most
+once (exactly when the regular expression matches). If \fB\-all\fR is given,
+the command callback will be invoked for each matched location, in sequence.
+The exact location indices that matched are not made available to the script.
+.PP
+See \fBEXAMPLES\fR below for illustrative cases.
+.RE
+.VE 8.7
+.TP
\fB\-expanded\fR
.
Enables use of the expanded regular expression syntax where
@@ -183,6 +210,53 @@ set substitution {[format \e\e\e\eu%04x [scan "\e\e&" %c]]}
set quoted [subst [string map {\en {\e\eu000a}} \e
[\fBregsub\fR -all $RE $string $substitution]]]
.CE
+.PP
+.VS 8.7
+The above operation can be done using \fBregsub \-command\fR instead, which is
+often faster. (A full pre-computed \fBstring map\fR would be faster still, but
+the cost of computing the map for a transformation as complex as this can be
+quite large.)
+.PP
+.CS
+# This RE is just a character class for everything "bad"
+set RE {[][{};#\e\e\e$\es\eu0080-\euffff]}
+
+# This encodes what the RE described above matches
+proc encodeChar {ch} {
+ # newline is handled specially since backslash-newline is a
+ # special sequence.
+ if {$ch eq "\en"} {
+ return "\e\eu000a"
+ }
+ # No point in writing this as a one-liner
+ scan $ch %c charNumber
+ format "\e\eu%04x" $charNumber
+}
+
+set quoted [\fBregsub\fR -all -command $RE $string encodeChar]
+.CE
+.PP
+Decoding a URL-encoded string using \fBregsub \-command\fR, a lambda term and
+the \fBapply\fR command.
+.PP
+.CS
+# Match one of the sequences in a URL-encoded string that needs
+# fixing, converting + to space and %XX to the right character
+# (e.g., %7e becomes ~)
+set RE {(\e+)|%([0-9A-Fa-f]{2})}
+
+# Note that -command uses a command prefix, not a command name
+set decoded [\fBregsub\fR -all -command $RE $string {apply {{- p h} {
+ # + is a special case; handle directly
+ if {$p eq "+"} {
+ return " "
+ }
+ # convert hex to a char
+ scan $h %x charNumber
+ format %c $charNumber
+}}}]
+.CE
+.VE 8.7
.SH "SEE ALSO"
regexp(n), re_syntax(n), subst(n), string(n)
.SH KEYWORDS
diff --git a/doc/rename.n b/doc/rename.n
index 744bf5a..b064f66 100644
--- a/doc/rename.n
+++ b/doc/rename.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH rename n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -43,3 +43,7 @@ proc ::source args {
namespace(n), proc(n)
.SH KEYWORDS
command, delete, namespace, rename
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/seek.n b/doc/seek.n
index 02c5341..3b206d1 100644
--- a/doc/seek.n
+++ b/doc/seek.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH seek n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/self.n b/doc/self.n
index 0ad5428..855d067 100644
--- a/doc/self.n
+++ b/doc/self.n
@@ -32,7 +32,12 @@ implement the current call chain. The first element is the same as would be
reported by \fBinfo object\fR \fBcall\fR for the current method (except that this
also reports useful values from within constructors and destructors, whose
names are reported as \fB<constructor>\fR and \fB<destructor>\fR
-respectively), and the second element is an index into the first element's
+respectively,
+.VS TIP500
+and for private methods, which are described as being \fBprivate\fR instead of
+being a \fBmethod\fR),
+.VE TIP500
+and the second element is an index into the first element's
list that indicates which actual implementation is currently executing (the
first implementation to execute is always at index 0).
.TP
diff --git a/doc/set.n b/doc/set.n
index f065087..890ef1d 100644
--- a/doc/set.n
+++ b/doc/set.n
@@ -73,3 +73,7 @@ practice instead of doing double-dereferencing):
expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
.SH KEYWORDS
read, write, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/singleton.n b/doc/singleton.n
new file mode 100644
index 0000000..568a8bd
--- /dev/null
+++ b/doc/singleton.n
@@ -0,0 +1,99 @@
+'\"
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH singleton n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::singleton \- a class that does only allows one instance of itself
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::singleton\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+ \(-> \fBoo::class\fR
+ \(-> \fBoo::singleton\fR
+.fi
+.BE
+.SH DESCRIPTION
+Singleton classes are classes that only permit at most one instance of
+themselves to exist. They unexport the \fBcreate\fR and
+\fBcreateWithNamespace\fR methods entirely, and override the \fBnew\fR method
+so that it only makes a new instance if there is no existing instance. It is
+not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
+inherited. It is not recommended that a singleton class's constructor take any
+arguments.
+.PP
+Instances have their\fB destroy\fR method overridden with a method that always
+returns an error in order to discourage destruction of the object, but
+destruction remains possible if strictly necessary (e.g., by destroying the
+class or using \fBrename\fR to delete it). They also have a (non-exported)
+\fB<cloned>\fR method defined on them that similarly always returns errors to
+make attempts to use the singleton instance with \fBoo::copy\fR fail.
+.SS CONSTRUCTOR
+The \fBoo::singleton\fR class does not define an explicit constructor; this
+means that it is effectively the same as the constructor of the
+\fBoo::class\fR class.
+.SS DESTRUCTOR
+The \fBoo::singleton\fR class does not define an explicit destructor;
+destroying an instance of it is just like destroying an ordinary class (and
+will destroy the singleton object).
+.SS "EXPORTED METHODS"
+.TP
+\fIcls \fBnew \fR?\fIarg ...\fR?
+.
+This returns the current instance of the singleton class, if one exists, and
+creates a new instance only if there is no existing instance. The additional
+arguments, \fIarg ...\fR, are only used if a new instance is actually
+manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
+method.
+.RS
+.PP
+This is an override of the behaviour of a superclass's method with an
+identical call signature to the superclass's implementation.
+.RE
+.SS "NON-EXPORTED METHODS"
+The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
+\fBcreateWithNamespace\fR are unexported; callers should not assume that they
+have control over either the name or the namespace name of the singleton instance.
+.SH EXAMPLE
+.PP
+This example demonstrates that there is only one instance even though the
+\fBnew\fR method is called three times.
+.PP
+.CS
+\fBoo::singleton\fR create Highlander {
+ method say {} {
+ puts "there can be only one"
+ }
+}
+
+set h1 [Highlander new]
+set h2 [Highlander new]
+if {$h1 eq $h2} {
+ puts "equal objects" \fI\(-> prints "equal objects"\fR
+}
+set h3 [Highlander new]
+if {$h1 eq $h3} {
+ puts "equal objects" \fI\(-> prints "equal objects"\fR
+}
+.CE
+.PP
+Note that the name of the instance of the singleton is not guaranteed to be
+anything in particular.
+.SH "SEE ALSO"
+oo::class(n)
+.SH KEYWORDS
+class, metaclass, object, single instance
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/socket.n b/doc/socket.n
index 3efdb37..823dbd5 100644
--- a/doc/socket.n
+++ b/doc/socket.n
@@ -131,6 +131,16 @@ wildcard address so that it can accept connections from any
interface. If \fIaddr\fR is a domain name that resolves to multiple IP
addresses that are available on the local machine, the socket will
listen on all of them.
+.TP
+\fB\-reuseaddr\fI boolean\fR
+.
+Tells the kernel whether to reuse the local address if there is no socket
+actively listening on it. This is the default on Windows.
+.TP
+\fB\-reuseport\fI boolean\fR
+.
+Tells the kernel whether to allow the binding of multiple sockets to the same
+address and port.
.PP
Server channels cannot be used for input or output; their sole use is to
accept new client connections. The channels created for each incoming
diff --git a/doc/source.n b/doc/source.n
index 67d4b6b..3fc001e 100644
--- a/doc/source.n
+++ b/doc/source.n
@@ -5,7 +5,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH source n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -69,3 +69,7 @@ foreach scriptFile {foo.tcl bar.tcl} {
file(n), cd(n), encoding(n), info(n)
.SH KEYWORDS
file, script
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/split.n b/doc/split.n
index f1c66d0..e977d7c 100644
--- a/doc/split.n
+++ b/doc/split.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH split n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/string.n b/doc/string.n
index 7e666ea..cc3fc54 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -12,7 +12,7 @@
.SH NAME
string \- Manipulate strings
.SH SYNOPSIS
-\fBstring \fIoption arg \fR?\fIarg ...?\fR
+\fBstring \fIoption arg \fR?\fIarg ...\fR?
.BE
.SH DESCRIPTION
.PP
@@ -20,7 +20,7 @@ Performs one of several string operations, depending on \fIoption\fR.
The legal \fIoption\fRs (which may be abbreviated) are:
.TP
\fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
-.VS 8.6.2
+.
Concatenate the given \fIstring\fRs just like placing them directly
next to each other and return the resulting compound string. If no
\fIstring\fRs are present, the result is an empty string.
@@ -32,7 +32,6 @@ of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR,
and is more efficient than building a list of arguments and using
\fBjoin\fR with an empty join string.
.RE
-.VE
.TP
\fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
.
@@ -111,17 +110,24 @@ Any character with a value less than \eu0080 (those that are in the
Any of the forms allowed to \fBTcl_GetBoolean\fR.
.IP \fBcontrol\fR 12
Any Unicode control character.
+.IP \fBdict\fR 12
+.VS TIP501
+Any proper dict structure, with optional surrounding whitespace. In
+case of improper dict structure, 0 is returned and the \fIvarname\fR
+will contain the index of the
+.QW element
+where the dict parsing fails, or \-1 if this cannot be determined.
+.VE TIP501
.IP \fBdigit\fR 12
Any Unicode digit character. Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
.IP \fBentier\fR 12
-.VS 8.6
+.
Any of the valid string formats for an integer value of arbitrary size
in Tcl, with optional surrounding whitespace. The formats accepted are
exactly those accepted by the C routine \fBTcl_GetBignumFromObj\fR.
-.VE
.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
diff --git a/doc/switch.n b/doc/switch.n
index 6e27f56..70eeb09 100644
--- a/doc/switch.n
+++ b/doc/switch.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH switch n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/tailcall.n b/doc/tailcall.n
index 926c608..24eb902 100644
--- a/doc/tailcall.n
+++ b/doc/tailcall.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH tailcall n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index 6ed5eb6..c37eb81 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH tclsh 1 "" Tcl "Tcl Applications"
.so man.macros
.BS
@@ -143,6 +143,15 @@ incomplete commands.
.SH "STANDARD CHANNELS"
.PP
See \fBTcl_StandardChannels\fR for more explanations.
+.SH ZIPVFS
+.PP
+When a zipfile is concatenated to the end of a \fBtclsh\fR, on
+startup the contents of the zip archive will be mounted as the
+virtual file system /zvfs. If a top level directory tcl8.6 is
+present in the zip archive, it will become the directory loaded
+as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
+in the top level directory of the zip archive, it will be sourced
+instead of the shell's normal command line handing.
.SH "SEE ALSO"
auto_path(n), encoding(n), env(n), fconfigure(n)
.SH KEYWORDS
diff --git a/doc/tell.n b/doc/tell.n
index e8bf3af..54fbae1 100644
--- a/doc/tell.n
+++ b/doc/tell.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH tell n 8.1 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
@@ -16,7 +16,7 @@ tell \- Return current access position for an open channel
.BE
.SH DESCRIPTION
.PP
-Returns an integer string giving the current access position in
+Returns an integer giving the current access position in
\fIchannelId\fR. This value returned is a byte offset that can be passed to
\fBseek\fR in order to set the channel to a particular position. Note
that this value is in terms of bytes, not characters like \fBread\fR.
@@ -46,3 +46,7 @@ if {[read $chan 6] eq "foobar"} {
file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, channel, seeking
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/throw.n b/doc/throw.n
index 0d1df78..0d096f4 100644
--- a/doc/throw.n
+++ b/doc/throw.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH throw n 8.6 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/time.n b/doc/time.n
index 35b41c4..bea974f 100644
--- a/doc/time.n
+++ b/doc/time.n
@@ -4,7 +4,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH time n "" Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/tm.n b/doc/tm.n
index 5602686..d5c3cc7 100644
--- a/doc/tm.n
+++ b/doc/tm.n
@@ -3,7 +3,7 @@
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
+'\"
.TH tm n 8.5 Tcl "Tcl Built-In Commands"
.so man.macros
.BS
diff --git a/doc/trace.n b/doc/trace.n
index 5482e59..570b263 100644
--- a/doc/trace.n
+++ b/doc/trace.n
@@ -20,7 +20,8 @@ trace \- Monitor variable accesses, command usages and command executions
This command causes Tcl commands to be executed whenever certain operations are
invoked. The legal \fIoption\fRs (which may be abbreviated) are:
.TP
-\fBtrace add \fItype name ops ?args?\fR
+\fBtrace add \fItype name ops\fR ?\fIargs\fR?
+.
Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
.RS
.TP
diff --git a/doc/unknown.n b/doc/unknown.n
index 82dcefc..ee8a5be 100644
--- a/doc/unknown.n
+++ b/doc/unknown.n
@@ -89,3 +89,7 @@ proc \fBunknown\fR args {
info(n), proc(n), interp(n), library(n), namespace(n)
.SH KEYWORDS
error, non-existent command, unknown
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/update.n b/doc/update.n
index ce0fb25..a85faac 100644
--- a/doc/update.n
+++ b/doc/update.n
@@ -63,3 +63,7 @@ while {!$done} {
after(n), interp(n)
.SH KEYWORDS
asynchronous I/O, event, flush, handler, idle, update
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/uplevel.n b/doc/uplevel.n
index 4decc6d..cda1652 100644
--- a/doc/uplevel.n
+++ b/doc/uplevel.n
@@ -24,9 +24,9 @@ the result of that evaluation.
If \fIlevel\fR is an integer then
it gives a distance (up the procedure calling stack) to move before
executing the command. If \fIlevel\fR consists of \fB#\fR followed by
-a number then the number gives an absolute level number. If \fIlevel\fR
+a integer then the level gives an absolute level. If \fIlevel\fR
is omitted then it defaults to \fB1\fR. \fILevel\fR cannot be
-defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
+defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR.
.PP
For example, suppose that procedure \fBa\fR was invoked
from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
diff --git a/doc/while.n b/doc/while.n
index 961260c..6acc909 100644
--- a/doc/while.n
+++ b/doc/while.n
@@ -63,3 +63,7 @@ set lineCount 0
break(n), continue(n), for(n), foreach(n)
.SH KEYWORDS
boolean, loop, test, while
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:
diff --git a/doc/zipfs.3 b/doc/zipfs.3
new file mode 100644
index 0000000..23b9a93
--- /dev/null
+++ b/doc/zipfs.3
@@ -0,0 +1,120 @@
+'\"
+'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
+'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
+'\" Copyright (c) 2017 Sean Woods <yoda@etoyoc.com>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
+.SH SYNOPSIS
+.nf
+int
+\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
+.sp
+int
+\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
+.sp
+int
+\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)
+.sp
+int
+\fBTclzipfs_Unmount\fR(\fIinterp, mountpoint\fR)
+.fi
+.SH ARGUMENTS
+.AS Tcl_Interp *mountpoint in
+.AP "int" *argcPtr in
+Pointer to a variable holding the number of command line arguments from
+\fBmain\fR().
+.AP "char" ***argvPtr in
+Pointer to an array of strings containing the command line arguments to
+\fBmain\fR().
+.AP Tcl_Interp *interp in
+Interpreter in which the ZIP file system is mounted. The interpreter's result is
+modified to hold the result or error message from the script.
+.AP "const char" *zipname in
+Name of a ZIP file. Must not be NULL when either mounting or unmounting a ZIP.
+.AP "const char" *mountpoint in
+Name of a mount point, which must be a legal Tcl file or directory name. May
+be NULL to query current mount points.
+.AP "const char" *password in
+An (optional) password. Use NULL if no password is wanted to read the file.
+.AP "unsigned char" *data in
+A data buffer to mount. The data buffer must hold the contents of a ZIP
+archive, and must not be NULL.
+.AP size_t dataLen in
+The number of bytes in the supplied data buffer argument, \fIdata\fR.
+.AP int copy in
+If non-zero, the ZIP archive in the data buffer will be internally copied
+before mounting, allowing the data buffer to be disposed once
+\fBTclZipfs_MountBuffer\fR returns. If zero, the caller guarantees that the
+buffer will be valid to read from for the duration of the mount.
+.BE
+.SH DESCRIPTION
+\fBTclZipfs_AppHook\fR is a utility function to perform standard application
+initialization procedures, taking into account available ZIP archives as
+follows:
+.IP [1]
+If the current application has a mountable ZIP archive, that archive is
+mounted under \fIZIPFS_VOLUME\fB/app\fR as a read-only Tcl virtual file
+system. \fIZIPFS_VOLUME\fR is usually \fB//zipfs:\fR on all platforms, but
+\fBzipfs:\fR may also be used on Windows (due to differences in the
+platform's filename parsing).
+.IP [2]
+If a file named \fBmain.tcl\fR is located in the root directory of that file
+system (i.e., at \fIZIPROOT\fB/app/main.tcl\fR after the ZIP archive is
+mounted as described above) it is treated as the startup script for the
+process.
+.IP [3]
+If the file \fIZIPROOT\fB/app/tcl_library/init.tcl\fR is present, the
+\fBtcl_library\fR global variable in the initial Tcl interpreter is set to
+\fIZIPROOT\fB/app/tcl_library\fR.
+.IP [4]
+If the directory \fBtcl_library\fR was not found in the main application
+mount, the system will then search for it as either a VFS attached to the
+application dynamic library, or as a zip archive named
+\fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the
+present working directory or in the standard Tcl install location. (For
+example, the Tcl 8.7.2 release would be searched for in a file
+\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
+.PP
+On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
+it uses WCHAR in stead of char. As a result, it requires your application to
+be compiled with the UNICODE preprocessor symbol defined (e.g., via the
+\fB-DUNICODE\fR compiler flag).
+.PP
+The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
+when the function is successful). The function \fImay\fR modify the variables
+pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
+current implementation does not do so, but callers \fIshould not\fR assume
+that this will be true in the future.
+.PP
+\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
+given in \fImountpoint\fR using the optional ZIP password \fIpassword\fR.
+Errors during that process are reported in the interpreter \fIinterp\fR. If
+\fImountpoint\fR is a NULL pointer, information on all currently mounted ZIP
+file systems is written into \fIinterp\fR's result as a sequence of mount
+points and ZIP file names. The result of this call is a standard Tcl result
+code.
+.PP
+\fBTclzipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
+\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
+assumed to be not password protected. Errors during that process are reported
+in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
+the buffer is internally copied before mounting or not. The result of this
+call is a standard Tcl result code.
+.PP
+\fBTclzipfs_Unmount\fR undoes the effect of \fBTclzipfs_Mount\fR, i.e., it
+unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
+\fImountpoint\fR). Errors are reported in the interpreter \fIinterp\fR. The
+result of this call is a standard Tcl result code.
+.PP
+\fBTclZipfs_AppHook\fR can not be used in stub-enabled extensions.
+.SH "SEE ALSO"
+zipfs(n)
+.SH KEYWORDS
+compress, filesystem, zip
diff --git a/doc/zipfs.n b/doc/zipfs.n
new file mode 100644
index 0000000..c27b5d5
--- /dev/null
+++ b/doc/zipfs.n
@@ -0,0 +1,255 @@
+'\"
+'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
+'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
+'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH zipfs n 1.0 Zipfs "zipfs Commands"
+.so man.macros
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+zipfs \- Mount and work with ZIP files within Tcl
+.SH SYNOPSIS
+.nf
+\fBpackage require zipfs \fR?\fB1.0\fR?
+.sp
+\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
+\fBzipfs exists\fR \fIfilename\fR
+\fBzipfs find\fR \fIdirectoryName\fR
+\fBzipfs info\fR \fIfilename\fR
+\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
+\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
+\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
+\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
+\fBzipfs mkkey\fR \fIpassword\fR
+\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
+\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
+\fBzipfs root\fR
+\fBzipfs unmount\fR \fImountpoint\fR
+.fi
+'\" The following subcommand is *UNDOCUMENTED*
+'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The \fBzipfs\fR command (the sole public command provided by the built-in
+package with the same name) provides Tcl with the ability to mount the
+contents of a ZIP archive file as a virtual file system. ZIP archives support
+simple encryption, sufficient to prevent casual inspection of their contents
+but not able to prevent access by even a moderately determined attacker.
+.TP
+\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR?
+.
+This takes the name of a file, \fIfilename\fR, and produces where it would be
+mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says
+within which mount the mapping will be done; if omitted, the main root of the
+zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean
+which controls whether to fully canonicalise the name; it defaults to true.
+.TP
+\fBzipfs exists\fR \fIfilename\fR
+.
+Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
+.TP
+\fBzipfs find\fR \fIdirectoryName\fR
+.
+Recursively lists files including and below the directory \fIdirectoryName\fR.
+The result list consists of relative path names starting from the given
+directory. This command is also used by the \fBzipfs mkzip\fR and \fBzipfs
+mkimg\fR commands.
+.TP
+\fBzipfs info\fR \fIfile\fR
+.
+Return information about the given \fIfile\fR in the mounted zipfs. The
+information consists of:
+.RS
+.IP (1)
+the name of the ZIP archive file that contains the file,
+.IP (2)
+the size of the file after decompressions,
+.IP (3)
+the compressed size of the file, and
+.IP (4)
+the offset of the compressed data in the ZIP archive file.
+.PP
+Note: querying the mount point gives the start of the zip data as the offset
+in (4), which can be used to truncate the zip information from an executable.
+.RE
+.TP
+\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
+.
+Return a list of all files in the mounted zipfs, or just those matching
+\fIpattern\fR (optionally controlled by the option parameters). The order of
+the names in the list is arbitrary.
+.TP
+\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
+.
+The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
+filesystem at \fImountpoint\fR. After this command executes, files contained
+in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
+.RS
+.PP
+With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR. With
+no \fImountpoint\fR, return all zipfile/mount pairs. If \fImountpoint\fR is
+specified as an empty string, mount on file path.
+.PP
+\fBNB:\fR because the current working directory is a concept maintained by the
+operating system, using \fBcd\fR into a mounted archive will only work in the
+current process, and then not entirely consistently (e.g., if a shared library
+uses direct access to the OS rather than through Tcl's filesystem API, it will
+not see the current directory as being inside the mount and will not be able
+to access the files inside the mount).
+.RE
+.TP
+\fBzipfs root\fR
+.
+Returns a constant string which indicates the mount point for zipfs volumes
+for the current platform. On Windows, this value is
+.QW \fBzipfs:/\fR .
+On Unix, this value is
+.QW \fB//zipfs:/\fR .
+.RE
+.TP
+\fBzipfs unmount \fImountpoint\fR
+.
+Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
+.SS "ZIP CREATION COMMANDS"
+This package also provides several commands to aid the creation of ZIP
+archives as Tcl applications.
+.TP
+\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
+.
+Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
+directory \fIindir\fR (contained regular files only) with optional ZIP
+password \fIpassword\fR. While processing the files below \fIindir\fR the
+optional file name prefix given in \fIstrip\fR is stripped off the beginning
+of the respective file name. When stripping, it is common to remove either
+the whole source directory name or the name of its parent directory.
+.RS
+.PP
+\fBCaution:\fR the choice of the \fIindir\fR parameter (less the optional
+stripped prefix) determines the later root name of the archive's content.
+.RE
+.TP
+\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
+.
+Creates an image (potentially a new executable file) similar to \fBzipfs
+mkzip\fR; see that command for a description of most parameters to this
+command, as they behave identically here.
+.RS
+.PP
+If the \fIinfile\fR parameter is specified, this file is prepended in front of
+the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
+(i.e., the executable file of the running process) is used. If the
+\fIpassword\fR parameter is not empty, an obfuscated version of that password
+(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
+output file and the contents of the ZIP chunk are protected with that
+password.
+.PP
+If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
+archive and the image file that the archive is attached to is a \fBtclsh\fR
+(or \fBwish\fR) instance (true by default, but depends on your configuration),
+then the resulting image is an executable that will \fBsource\fR the script in
+that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once
+that script has been executed.
+.PP
+\fBCaution:\fR highly experimental, not usable on Android, only partially
+tested on Linux and Windows.
+.RE
+.TP
+\fBzipfs mkkey\fR \fIpassword\fR
+.
+Given the clear text \fIpassword\fR argument, an obfuscated string version is
+returned with the same format used in the \fBzipfs mkimg\fR command.
+.TP
+\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
+.
+This command is like \fBzipfs mkimg\fR, but instead of an input directory,
+\fIinlist\fR must be a Tcl list where the odd elements are the names of files
+to be copied into the archive in the image, and the even elements are their
+respective names within that archive.
+.TP
+\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
+.
+This command is like \fBzipfs mkzip\fR, but instead of an input directory,
+\fIinlist\fR must be a Tcl list where the odd elements are the names of files
+to be copied into the archive, and the even elements are their respective
+names within that archive.
+.SH "EXAMPLES"
+.PP
+Mounting an ZIP archive as an application directory and running code out of it
+before unmounting it again:
+.PP
+.CS
+set zip myApp.zip
+set base [file join [\fbzipfs root\fR] myApp]
+
+\fBzipfs mount\fR $base $zip
+# $base now has the contents of myApp.zip
+
+source [file join $base app.tcl]
+# use the contents, load libraries from it, etc...
+
+\fBzipfs unmount\fR $zip
+.CE
+.PP
+Creating a ZIP archive, given that a directory exists containing the content
+to put in the archive. Note that the source directory is given twice, in order
+to strip the exterior directory name from each filename in the archive.
+.PP
+.CS
+set sourceDirectory [file normalize myApp]
+set targetZip myApp.zip
+
+\fBzipfs mkzip\fR $targetZip $sourceDirectory $sourceDirectory
+.CE
+.PP
+Encryption can be applied to ZIP archives by providing a password when
+building the ZIP and when mounting it.
+.PP
+.CS
+set zip myApp.zip
+set sourceDir [file normalize myApp]
+set password "hunter2"
+set base [file join [\fbzipfs root\fR] myApp]
+
+# Create with password
+\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password
+
+# Mount with password
+\fBzipfs mount\fR $base $zip $password
+.CE
+.PP
+When creating an executable image with a password, the password is placed
+within the executable in a shrouded form so that the application can read
+files inside the embedded ZIP archive yet casual inspection cannot read it.
+.PP
+.CS
+set appDir [file normalize myApp]
+set img "myApp.bin"
+set password "hunter2"
+
+# Create some simple content to define a basic application
+file mkdir $appDir
+set f [open $appDir/main.tcl]
+puts $f {
+ puts "Hi. This is [info script]"
+}
+close $f
+
+# Create the executable
+\fBzipfs mkimg\fR $img $appDir $appDir $password
+
+# Launch the executable, printing its output to stdout
+exec $img >@stdout
+# prints: \fIHi. This is //zipfs:/app/main.tcl\fR
+.CE
+.SH "SEE ALSO"
+tclsh(1), file(n), zipfs(3), zlib(n)
+.SH "KEYWORDS"
+compress, filesystem, zip
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index affcb48..4c8f15f 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -457,7 +457,7 @@ next(
if (ATEOS()) {
FAILW(REG_EESCAPE);
}
- (DISCARD)lexescape(v);
+ (void)lexescape(v);
switch (v->nexttype) { /* not all escapes okay here */
case PLAIN:
return 1;
@@ -716,7 +716,7 @@ next(
}
RETV(PLAIN, *v->now++);
}
- (DISCARD)lexescape(v);
+ (void)lexescape(v);
if (ISERR()) {
FAILW(REG_EESCAPE);
}
@@ -1143,7 +1143,7 @@ skip(
/*
- newline - return the chr for a newline
* This helps confine use of CHR to this source file.
- ^ static chr newline(NOPARMS);
+ ^ static chr newline(void);
*/
static chr
newline(void)
diff --git a/generic/regc_locale.c b/generic/regc_locale.c
index 2f79026..002b264 100644
--- a/generic/regc_locale.c
+++ b/generic/regc_locale.c
@@ -1240,7 +1240,7 @@ cmp(
const chr *x, const chr *y, /* strings to compare */
size_t len) /* exact length of comparison */
{
- return memcmp(VS(x), VS(y), len*sizeof(chr));
+ return memcmp((void*)(x), (void*)(y), len*sizeof(chr));
}
/*
diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c
index 088c6c0..240fcfe 100644
--- a/generic/regc_nfa.c
+++ b/generic/regc_nfa.c
@@ -843,7 +843,7 @@ moveins(
/*
- copyins - copy in arcs of a state to another state
- ^ static VOID copyins(struct nfa *, struct state *, struct state *, int);
+ ^ static void copyins(struct nfa *, struct state *, struct state *, int);
*/
static void
copyins(
@@ -1100,7 +1100,7 @@ moveouts(
/*
- copyouts - copy out arcs of a state to another state
- ^ static VOID copyouts(struct nfa *, struct state *, struct state *, int);
+ ^ static void copyouts(struct nfa *, struct state *, struct state *, int);
*/
static void
copyouts(
diff --git a/generic/regcomp.c b/generic/regcomp.c
index 211cd70..58d55fb 100644
--- a/generic/regcomp.c
+++ b/generic/regcomp.c
@@ -82,7 +82,7 @@ static int lexescape(struct vars *);
static int lexdigits(struct vars *, int, int, int);
static int brenext(struct vars *, pchr);
static void skip(struct vars *);
-static chr newline(NOPARMS);
+static chr newline(void);
static chr chrnamed(struct vars *, const chr *, const chr *, pchr);
/* === regc_color.c === */
static void initcm(struct vars *, struct colormap *);
@@ -341,13 +341,13 @@ compile(
re->re_info = 0; /* bits get set during parse */
re->re_csize = sizeof(chr);
re->re_guts = NULL;
- re->re_fns = VS(&functions);
+ re->re_fns = (void*)(&functions);
/*
* More complex setup, malloced things.
*/
- re->re_guts = VS(MALLOC(sizeof(struct guts)));
+ re->re_guts = (void*)(MALLOC(sizeof(struct guts)));
if (re->re_guts == NULL) {
return freev(v, REG_ESPACE);
}
@@ -434,7 +434,7 @@ compile(
* Can sacrifice main NFA now, so use it as work area.
*/
- (DISCARD) optimize(v->nfa, debug);
+ (void) optimize(v->nfa, debug);
CNOERR();
makesearch(v, v->nfa);
CNOERR();
@@ -1920,10 +1920,10 @@ nfatree(
assert(t != NULL && t->begin != NULL);
if (t->left != NULL) {
- (DISCARD) nfatree(v, t->left, f);
+ (void) nfatree(v, t->left, f);
}
if (t->right != NULL) {
- (DISCARD) nfatree(v, t->right, f);
+ (void) nfatree(v, t->right, f);
}
return nfanode(v, t, f);
diff --git a/generic/regcustom.h b/generic/regcustom.h
index 681b97d..095385d 100644
--- a/generic/regcustom.h
+++ b/generic/regcustom.h
@@ -36,10 +36,9 @@
* Overrides for regguts.h definitions, if any.
*/
-#define FUNCPTR(name, args) (*name)args
-#define MALLOC(n) VS(attemptckalloc(n))
-#define FREE(p) ckfree(VS(p))
-#define REALLOC(p,n) VS(attemptckrealloc(VS(p),n))
+#define MALLOC(n) (void*)(attemptckalloc(n))
+#define FREE(p) ckfree((void*)(p))
+#define REALLOC(p,n) (void*)(attemptckrealloc((void*)(p),n))
/*
* Do not insert extras between the "begin" and "end" lines - this chunk is
@@ -92,7 +91,7 @@ typedef int celt; /* Type to hold chr, or NOCELT */
#if TCL_UTF_MAX > 4
#define CHRBITS 32 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x00000000 /* Smallest and largest chr; the value */
-#define CHR_MAX 0xffffffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
+#define CHR_MAX 0x10ffff /* CHR_MAX-CHR_MIN+1 should fit in uchr */
#else
#define CHRBITS 16 /* Bits in a chr; must not use sizeof */
#define CHR_MIN 0x0000 /* Smallest and largest chr; the value */
diff --git a/generic/regexec.c b/generic/regexec.c
index 6d12827..128d439 100644
--- a/generic/regexec.c
+++ b/generic/regexec.c
@@ -44,7 +44,7 @@ struct sset { /* state set */
unsigned hash; /* hash of bitvector */
#define HASH(bv, nw) (((nw) == 1) ? *(bv) : hash(bv, nw))
#define HIT(h,bv,ss,nw) ((ss)->hash == (h) && ((nw) == 1 || \
- memcmp(VS(bv), VS((ss)->states), (nw)*sizeof(unsigned)) == 0))
+ memcmp((void*)(bv), (void*)((ss)->states), (nw)*sizeof(unsigned)) == 0))
int flags;
#define STARTER 01 /* the initial state set */
#define POSTSTATE 02 /* includes the goal state */
@@ -268,7 +268,7 @@ exec(
if (st == REG_OKAY && v->pmatch != pmatch && nmatch > 0) {
zapallsubs(pmatch, nmatch);
n = (nmatch < v->nmatch) ? nmatch : v->nmatch;
- memcpy(VS(pmatch), VS(v->pmatch), n*sizeof(regmatch_t));
+ memcpy((void*)(pmatch), (void*)(v->pmatch), n*sizeof(regmatch_t));
}
/*
diff --git a/generic/regguts.h b/generic/regguts.h
index 1ac2465..b3dbaa4 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -49,41 +49,15 @@
#include <assert.h>
#endif
-/* voids */
-#ifndef VOID
-#define VOID void /* for function return values */
-#endif
-#ifndef DISCARD
-#define DISCARD void /* for throwing values away */
-#endif
-#ifndef PVOID
-#define PVOID void * /* generic pointer */
-#endif
-#ifndef VS
-#define VS(x) ((void*)(x)) /* cast something to generic ptr */
-#endif
-#ifndef NOPARMS
-#define NOPARMS void /* for empty parm lists */
-#endif
-
-/* function-pointer declarator */
-#ifndef FUNCPTR
-#if __STDC__ >= 1
-#define FUNCPTR(name, args) (*name)args
-#else
-#define FUNCPTR(name, args) (*name)()
-#endif
-#endif
-
/* memory allocation */
#ifndef MALLOC
#define MALLOC(n) malloc(n)
#endif
#ifndef REALLOC
-#define REALLOC(p, n) realloc(VS(p), n)
+#define REALLOC(p, n) realloc(p, n)
#endif
#ifndef FREE
-#define FREE(p) free(VS(p))
+#define FREE(p) free(p)
#endif
/* want size of a char in bits, and max value in bounded quantifiers */
@@ -96,7 +70,6 @@
*/
#define NOTREACHED 0
-#define xxx 1
#define DUPMAX _POSIX2_RE_DUP_MAX
#define DUPINF (DUPMAX+1)
@@ -408,7 +381,7 @@ struct subre {
*/
struct fns {
- void FUNCPTR(free, (regex_t *));
+ void (*free) (regex_t *);
};
/*
@@ -425,7 +398,7 @@ struct guts {
struct cnfa search; /* for fast preliminary search */
int ntree; /* number of subre's, plus one */
struct colormap cmap;
- int FUNCPTR(compare, (const chr *, const chr *, size_t));
+ int (*compare) (const chr *, const chr *, size_t);
struct subre *lacons; /* lookahead-constraint vector */
int nlacons; /* size of lacons */
};
diff --git a/generic/tcl.decls b/generic/tcl.decls
index b62cd28..5b3afeb 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -32,7 +32,7 @@ declare 0 {
const char *version, const void *clientData)
}
declare 1 {
- CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp,
+ const char *Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
void *clientDataPtr)
}
@@ -104,7 +104,7 @@ declare 20 {
declare 21 {
int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
}
-declare 22 {
+declare 22 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
}
declare 23 {
@@ -119,7 +119,7 @@ declare 25 {
Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line)
}
-declare 26 {
+declare 26 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
}
declare 27 {
@@ -132,8 +132,9 @@ declare 28 {
declare 29 {
Tcl_Obj *Tcl_DuplicateObj(Tcl_Obj *objPtr)
}
+# Only available as stub-entry, for backwards-compatible stub-enabled extensions
declare 30 {
- void TclFreeObj(Tcl_Obj *objPtr)
+ void TclOldFreeObj(Tcl_Obj *objPtr)
}
declare 31 {
int Tcl_GetBoolean(Tcl_Interp *interp, const char *src, int *boolPtr)
@@ -152,9 +153,9 @@ declare 35 {
int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
double *doublePtr)
}
-declare 36 {
+declare 36 {deprecated {No longer in use, changed to macro}} {
int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr)
+ const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
}
declare 37 {
int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr)
@@ -198,7 +199,7 @@ declare 48 {
int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
int count, int objc, Tcl_Obj *const objv[])
}
-declare 49 {
+declare 49 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
}
declare 50 {
@@ -207,13 +208,13 @@ declare 50 {
declare 51 {
Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
}
-declare 52 {
+declare 52 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewIntObj(int intValue)
}
declare 53 {
Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
}
-declare 54 {
+declare 54 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_NewLongObj(long longValue)
}
declare 55 {
@@ -222,7 +223,7 @@ declare 55 {
declare 56 {
Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
}
-declare 57 {
+declare 57 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
}
declare 58 {
@@ -235,13 +236,13 @@ declare 59 {
declare 60 {
void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
}
-declare 61 {
+declare 61 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
}
declare 62 {
void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
}
-declare 63 {
+declare 63 {deprecated {No longer in use, changed to macro}} {
void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
}
declare 64 {
@@ -250,10 +251,10 @@ declare 64 {
declare 65 {
void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
}
-declare 66 {
+declare 66 {deprecated {No longer in use, changed to macro}} {
void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
}
-declare 67 {
+declare 67 {deprecated {No longer in use, changed to macro}} {
void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
int length)
}
@@ -282,10 +283,10 @@ declare 74 {
declare 75 {
int Tcl_AsyncReady(void)
}
-declare 76 {
+declare 76 {deprecated {No longer in use, changed to macro}} {
void Tcl_BackgroundError(Tcl_Interp *interp)
}
-declare 77 {
+declare 77 {deprecated {Use Tcl_UtfBackslash}} {
char Tcl_Backslash(const char *src, int *readPtr)
}
declare 78 {
@@ -306,7 +307,7 @@ declare 82 {
int Tcl_CommandComplete(const char *cmd)
}
declare 83 {
- char *Tcl_Concat(int argc, CONST84 char *const *argv)
+ char *Tcl_Concat(int argc, const char *const *argv)
}
declare 84 {
int Tcl_ConvertElement(const char *src, char *dst, int flags)
@@ -318,7 +319,7 @@ declare 85 {
declare 86 {
int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd,
Tcl_Interp *target, const char *targetCmd, int argc,
- CONST84 char *const *argv)
+ const char *const *argv)
}
declare 87 {
int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd,
@@ -352,7 +353,7 @@ declare 93 {
declare 94 {
Tcl_Interp *Tcl_CreateInterp(void)
}
-declare 95 {
+declare 95 {deprecated {}} {
void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
int numArgs, Tcl_ValueType *argTypes,
Tcl_MathProc *proc, ClientData clientData)
@@ -461,10 +462,10 @@ declare 126 {
int Tcl_Eof(Tcl_Channel chan)
}
declare 127 {
- CONST84_RETURN char *Tcl_ErrnoId(void)
+ const char *Tcl_ErrnoId(void)
}
declare 128 {
- CONST84_RETURN char *Tcl_ErrnoMsg(int err)
+ const char *Tcl_ErrnoMsg(int err)
}
declare 129 {
int Tcl_Eval(Tcl_Interp *interp, const char *script)
@@ -472,7 +473,7 @@ declare 129 {
declare 130 {
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
-declare 131 {
+declare 131 {deprecated {No longer in use, changed to macro}} {
int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 132 {
@@ -513,7 +514,7 @@ declare 142 {
declare 143 {
void Tcl_Finalize(void)
}
-declare 144 {
+declare 144 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_FindExecutable(const char *argv0)
}
declare 145 {
@@ -528,12 +529,12 @@ declare 147 {
}
declare 148 {
int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd,
- Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
- int *argcPtr, CONST84 char ***argvPtr)
+ Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
+ int *argcPtr, const char ***argvPtr)
}
declare 149 {
int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd,
- Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr,
+ Tcl_Interp **targetInterpPtr, const char **targetCmdPtr,
int *objcPtr, Tcl_Obj ***objv)
}
declare 150 {
@@ -558,7 +559,7 @@ declare 155 {
int Tcl_GetChannelMode(Tcl_Channel chan)
}
declare 156 {
- CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan)
+ const char *Tcl_GetChannelName(Tcl_Channel chan)
}
declare 157 {
int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan,
@@ -572,14 +573,14 @@ declare 159 {
Tcl_CmdInfo *infoPtr)
}
declare 160 {
- CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp,
+ const char *Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command)
}
declare 161 {
int Tcl_GetErrno(void)
}
declare 162 {
- CONST84_RETURN char *Tcl_GetHostName(void)
+ const char *Tcl_GetHostName(void)
}
declare 163 {
int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp)
@@ -622,20 +623,20 @@ declare 173 {
Tcl_Channel Tcl_GetStdChannel(int type)
}
declare 174 {
- CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp)
+ const char *Tcl_GetStringResult(Tcl_Interp *interp)
}
-declare 175 {
- CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
+declare 175 {deprecated {No longer in use, changed to macro}} {
+ const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
int flags)
}
declare 176 {
- CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
+ const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags)
}
declare 177 {
int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
}
-declare 178 {
+declare 178 {deprecated {No longer in use, changed to macro}} {
int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 179 {
@@ -662,7 +663,7 @@ declare 185 {
}
# Obsolete, use Tcl_FSJoinPath
declare 186 {
- char *Tcl_JoinPath(int argc, CONST84 char *const *argv,
+ char *Tcl_JoinPath(int argc, const char *const *argv,
Tcl_DString *resultPtr)
}
declare 187 {
@@ -685,7 +686,7 @@ declare 191 {
Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket)
}
declare 192 {
- char *Tcl_Merge(int argc, CONST84 char *const *argv)
+ char *Tcl_Merge(int argc, const char *const *argv)
}
declare 193 {
Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr)
@@ -703,7 +704,7 @@ declare 196 {
}
declare 197 {
Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
- CONST84 char **argv, int flags)
+ const char **argv, int flags)
}
# This is obsolete, use Tcl_FSOpenFileChannel
declare 198 {
@@ -729,7 +730,7 @@ declare 203 {
int Tcl_PutEnv(const char *assignment)
}
declare 204 {
- CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp)
+ const char *Tcl_PosixError(Tcl_Interp *interp)
}
declare 205 {
void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position)
@@ -765,7 +766,7 @@ declare 214 {
}
declare 215 {
void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
- CONST84 char **startPtr, CONST84 char **endPtr)
+ const char **startPtr, const char **endPtr)
}
declare 216 {
void Tcl_Release(ClientData clientData)
@@ -779,8 +780,7 @@ declare 218 {
declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
-# Obsolete
-declare 220 {
+declare 220 {deprecated {}} {
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 {
@@ -813,7 +813,7 @@ declare 228 {
declare 229 {
void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr)
}
-declare 230 {
+declare 230 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
}
declare 231 {
@@ -835,43 +835,42 @@ declare 235 {
declare 236 {
void Tcl_SetStdChannel(Tcl_Channel channel, int type)
}
-declare 237 {
- CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
+declare 237 {deprecated {No longer in use, changed to macro}} {
+ const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
const char *newValue, int flags)
}
declare 238 {
- CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
+ const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, const char *newValue, int flags)
}
declare 239 {
- CONST84_RETURN char *Tcl_SignalId(int sig)
+ const char *Tcl_SignalId(int sig)
}
declare 240 {
- CONST84_RETURN char *Tcl_SignalMsg(int sig)
+ const char *Tcl_SignalMsg(int sig)
}
declare 241 {
void Tcl_SourceRCFile(Tcl_Interp *interp)
}
declare 242 {
int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
- CONST84 char ***argvPtr)
+ const char ***argvPtr)
}
# Obsolete, use Tcl_FSSplitPath
declare 243 {
- void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr)
+ void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
}
-declare 244 {
+declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
}
declare 245 {
int Tcl_StringMatch(const char *str, const char *pattern)
}
-# Obsolete
-declare 246 {
+declare 246 {deprecated {}} {
int Tcl_TellOld(Tcl_Channel chan)
}
-declare 247 {
+declare 247 {deprecated {No longer in use, changed to macro}} {
int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
}
@@ -892,14 +891,14 @@ declare 251 {
declare 252 {
int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
}
-declare 253 {
+declare 253 {deprecated {No longer in use, changed to macro}} {
int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
}
declare 254 {
int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
int flags)
}
-declare 255 {
+declare 255 {deprecated {No longer in use, changed to macro}} {
void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
Tcl_VarTraceProc *proc, ClientData clientData)
}
@@ -911,7 +910,7 @@ declare 256 {
declare 257 {
void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
}
-declare 258 {
+declare 258 {deprecated {No longer in use, changed to macro}} {
int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
const char *varName, const char *localName, int flags)
}
@@ -922,7 +921,7 @@ declare 259 {
declare 260 {
int Tcl_VarEval(Tcl_Interp *interp, ...)
}
-declare 261 {
+declare 261 {deprecated {No longer in use, changed to macro}} {
ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
}
@@ -944,47 +943,47 @@ declare 265 {
declare 266 {
void Tcl_ValidateAllMemory(const char *file, int line)
}
-declare 267 {
+declare 267 {deprecated {see TIP #422}} {
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
-declare 268 {
+declare 268 {deprecated {see TIP #422}} {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 {
char *Tcl_HashStats(Tcl_HashTable *tablePtr)
}
declare 270 {
- CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
- CONST84 char **termPtr)
+ const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
+ const char **termPtr)
}
-declare 271 {
- CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
+declare 271 {deprecated {No longer in use, changed to macro}} {
+ const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
declare 272 {
- CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp,
+ const char *Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version, int exact,
void *clientDataPtr)
}
-declare 273 {
+declare 273 {deprecated {No longer in use, changed to macro}} {
int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
const char *version)
}
# TIP #268: The internally used new Require function is in slot 573.
-declare 274 {
- CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
+declare 274 {deprecated {No longer in use, changed to macro}} {
+ const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
-declare 275 {
+declare 275 {deprecated {see TIP #422}} {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
-declare 276 {
+declare 276 {deprecated {see TIP #422}} {
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
-declare 278 {
+declare 278 {deprecated {see TIP #422}} {
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
@@ -1058,7 +1057,7 @@ declare 293 {
int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 294 {
- void Tcl_ExitThread(int status)
+ TCL_NORETURN void Tcl_ExitThread(int status)
}
declare 295 {
int Tcl_ExternalToUtf(Tcl_Interp *interp, Tcl_Encoding encoding,
@@ -1086,7 +1085,7 @@ declare 301 {
Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name)
}
declare 302 {
- CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding)
+ const char *Tcl_GetEncodingName(Tcl_Encoding encoding)
}
declare 303 {
void Tcl_GetEncodingNames(Tcl_Interp *interp)
@@ -1147,22 +1146,22 @@ declare 319 {
Tcl_QueuePosition position)
}
declare 320 {
- Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index)
+ int Tcl_UniCharAtIndex(const char *src, int index)
}
declare 321 {
- Tcl_UniChar Tcl_UniCharToLower(int ch)
+ int Tcl_UniCharToLower(int ch)
}
declare 322 {
- Tcl_UniChar Tcl_UniCharToTitle(int ch)
+ int Tcl_UniCharToTitle(int ch)
}
declare 323 {
- Tcl_UniChar Tcl_UniCharToUpper(int ch)
+ int Tcl_UniCharToUpper(int ch)
}
declare 324 {
int Tcl_UniCharToUtf(int ch, char *buf)
}
declare 325 {
- CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index)
+ const char *Tcl_UtfAtIndex(const char *src, int index)
}
declare 326 {
int Tcl_UtfCharComplete(const char *src, int length)
@@ -1171,16 +1170,16 @@ declare 327 {
int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
}
declare 328 {
- CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch)
+ const char *Tcl_UtfFindFirst(const char *src, int ch)
}
declare 329 {
- CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch)
+ const char *Tcl_UtfFindLast(const char *src, int ch)
}
declare 330 {
- CONST84_RETURN char *Tcl_UtfNext(const char *src)
+ const char *Tcl_UtfNext(const char *src)
}
declare 331 {
- CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start)
+ const char *Tcl_UtfPrev(const char *src, const char *start)
}
declare 332 {
int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
@@ -1213,10 +1212,10 @@ declare 339 {
declare 340 {
char *Tcl_GetString(Tcl_Obj *objPtr)
}
-declare 341 {
- CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
+declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
+ const char *Tcl_GetDefaultEncodingDir(void)
}
-declare 342 {
+declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
void Tcl_SetDefaultEncodingDir(const char *path)
}
declare 343 {
@@ -1265,7 +1264,7 @@ declare 356 {
Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
int flags)
}
-declare 357 {
+declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count)
}
@@ -1278,7 +1277,7 @@ declare 359 {
}
declare 360 {
int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
- Tcl_Parse *parsePtr, int append, CONST84 char **termPtr)
+ Tcl_Parse *parsePtr, int append, const char **termPtr)
}
declare 361 {
int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
@@ -1291,7 +1290,7 @@ declare 362 {
declare 363 {
int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
int numBytes, Tcl_Parse *parsePtr, int append,
- CONST84 char **termPtr)
+ const char **termPtr)
}
declare 364 {
int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
@@ -1350,9 +1349,9 @@ declare 380 {
int Tcl_GetCharLength(Tcl_Obj *objPtr)
}
declare 381 {
- Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
+ int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
}
-declare 382 {
+declare 382 {deprecated {No longer in use, changed to macro}} {
Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
}
declare 383 {
@@ -1407,7 +1406,7 @@ declare 397 {
int Tcl_ChannelBuffered(Tcl_Channel chan)
}
declare 398 {
- CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
+ const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr)
}
declare 399 {
Tcl_ChannelTypeVersion Tcl_ChannelVersion(
@@ -1547,12 +1546,12 @@ declare 434 {
}
# TIP#15 (math function introspection) dkf
-declare 435 {
+declare 435 {deprecated {}} {
int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
int *numArgsPtr, Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
-declare 436 {
+declare 436 {deprecated {}} {
Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}
@@ -1870,7 +1869,7 @@ declare 518 {
}
# TIP#121 (exit handler) dkf for Joe Mistachkin
-declare 519 {
+declare 519 {nostub {Don't use this function in a stub-enabled extension}} {
Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
}
@@ -2325,6 +2324,63 @@ declare 630 {
# ----- BASELINE -- FOR -- 8.6.0 ----- #
+# TIP #456
+declare 631 {
+ Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp, const char *service,
+ const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData)
+}
+
+# TIP #430
+declare 632 {
+ int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
+ const char *zipname, const char *passwd)
+}
+declare 633 {
+ int TclZipfs_Unmount(Tcl_Interp *interp, const char *mountPoint)
+}
+declare 634 {
+ Tcl_Obj *TclZipfs_TclLibrary(void)
+}
+declare 635 {
+ int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
+ unsigned char *data, size_t datalen, int copy)
+}
+
+# TIP #445
+declare 636 {
+ void Tcl_FreeIntRep(Tcl_Obj *objPtr)
+}
+declare 637 {
+ char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
+ unsigned int numBytes)
+}
+declare 638 {
+ Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr)
+}
+declare 639 {
+ void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr,
+ const Tcl_ObjIntRep *irPtr)
+}
+declare 640 {
+ int Tcl_HasStringRep(Tcl_Obj *objPtr)
+}
+
+# TIP #506
+declare 641 {
+ void Tcl_IncrRefCount(Tcl_Obj *objPtr)
+}
+
+declare 642 {
+ void Tcl_DecrRefCount(Tcl_Obj *objPtr)
+}
+
+declare 643 {
+ int Tcl_IsShared(Tcl_Obj *objPtr)
+}
+
+# ----- BASELINE -- FOR -- 8.7.0 ----- #
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are only
@@ -2374,6 +2430,19 @@ export {
Tcl_Interp *interp)
}
export {
+ void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
+ Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
+}
+export {
+ void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
+}
+export {
+ Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc)
+}
+export {
+ void Tcl_FindExecutable(const char *argv0)
+}
+export {
const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
int exact)
}
diff --git a/generic/tcl.h b/generic/tcl.h
index 17ab2d3..c287a84 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -38,8 +38,8 @@ extern "C" {
* update the version numbers:
*
* library/init.tcl (1 LOC patch)
- * unix/configure.in (2 LOC Major, 2 LOC minor, 1 LOC patch)
- * win/configure.in (as above)
+ * unix/configure.ac (2 LOC Major, 2 LOC minor, 1 LOC patch)
+ * win/configure.ac (as above)
* win/tcl.m4 (not patchlevel)
* README (sections 0 and 2, with and without separator)
* macosx/Tcl-Common.xcconfig (not patchlevel) 1 LOC
@@ -49,13 +49,14 @@ extern "C" {
*/
#define TCL_MAJOR_VERSION 8
-#define TCL_MINOR_VERSION 6
-#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 9
+#define TCL_MINOR_VERSION 7
+#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
+#define TCL_RELEASE_SERIAL 2
-#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6.9"
+#define TCL_VERSION "8.7"
+#define TCL_PATCH_LEVEL "8.7a2"
+#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
*----------------------------------------------------------------------------
* The following definitions set up the proper options for Windows compilers.
@@ -85,6 +86,11 @@ extern "C" {
# define JOIN1(a,b) a##b
#endif
+#ifndef TCL_THREADS
+# define TCL_THREADS 1
+#endif
+#endif /* !TCL_NO_DEPRECATED */
+
/*
* A special definition used to allow this header file to be included from
* windows resource files so that they can obtain version information.
@@ -97,15 +103,10 @@ extern "C" {
#ifndef RC_INVOKED
/*
- * Special macro to define mutexes, that doesn't do anything if we are not
- * using threads.
+ * Special macro to define mutexes.
*/
-#ifdef TCL_THREADS
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
-#else
-#define TCL_DECLARE_MUTEX(name)
-#endif
/*
* Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
@@ -131,14 +132,15 @@ extern "C" {
*/
#include <stdarg.h>
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# 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)
-#endif
+#endif /* !TCL_NO_DEPRECATED */
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
# define TCL_NORETURN __attribute__ ((noreturn))
+# define TCL_NOINLINE __attribute__ ((noinline))
# if defined(BUILD_tcl) || defined(BUILD_tk)
# define TCL_NORETURN1 __attribute__ ((noreturn))
# else
@@ -148,8 +150,10 @@ extern "C" {
# define TCL_FORMAT_PRINTF(a,b)
# if defined(_MSC_VER) && (_MSC_VER >= 1310)
# define TCL_NORETURN _declspec(noreturn)
+# define TCL_NOINLINE __declspec(noinline)
# else
# define TCL_NORETURN /* nothing */
+# define TCL_NOINLINE /* nothing */
# endif
# define TCL_NORETURN1 /* nothing */
#endif
@@ -216,7 +220,7 @@ extern "C" {
* to be included in a shared library, then it should have the DLLEXPORT
* storage class. If is being declared for use by a module that is going to
* link against the shared library, then it should have the DLLIMPORT storage
- * class. If the symbol is beind declared for a static build or for use from a
+ * class. If the symbol is being declared for a static build or for use from a
* stub library, then the storage class should be empty.
*
* The convention is that a macro called BUILD_xxxx, where xxxx is the name of
@@ -245,10 +249,9 @@ extern "C" {
* New code should use prototypes.
*/
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# undef _ANSI_ARGS_
# define _ANSI_ARGS_(x) x
-#endif
/*
* Definitions that allow this header file to be used either with or without
@@ -258,34 +261,14 @@ extern "C" {
#ifndef INLINE
# define INLINE
#endif
-
-#ifdef NO_CONST
-# ifndef const
-# define const
-# endif
-#endif
#ifndef CONST
# define CONST const
#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
+#endif /* !TCL_NO_DEPRECATED */
#ifndef CONST86
-# define CONST86 CONST84
+# define CONST86 const
#endif
/*
@@ -309,6 +292,7 @@ extern "C" {
* VOID. This block is skipped under Cygwin and Mingw.
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID)
#ifndef VOID
#define VOID void
@@ -324,23 +308,16 @@ typedef long LONG;
*/
#ifndef __VXWORKS__
-# ifndef NO_VOID
-# define VOID void
-# else
-# define VOID char
-# endif
+# define VOID void
#endif
+#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
/*
* Miscellaneous declarations.
*/
#ifndef _CLIENTDATA
-# ifndef NO_VOID
- typedef void *ClientData;
-# else
- typedef int *ClientData;
-# endif
+ typedef void *ClientData;
# define _CLIENTDATA
#endif
@@ -386,56 +363,45 @@ typedef long LONG;
#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
# if defined(_WIN32)
# define TCL_WIDE_INT_TYPE __int64
-# ifdef __BORLANDC__
-# define TCL_LL_MODIFIER "L"
-# else /* __BORLANDC__ */
-# define TCL_LL_MODIFIER "I64"
-# endif /* __BORLANDC__ */
+# define TCL_LL_MODIFIER "I64"
+# if defined(_WIN64)
+# define TCL_Z_MODIFIER "I"
+# endif
# elif defined(__GNUC__)
-# define TCL_WIDE_INT_TYPE long long
-# define TCL_LL_MODIFIER "ll"
+# define TCL_Z_MODIFIER "z"
# else /* ! _WIN32 && ! __GNUC__ */
/*
* Don't know what platform it is and configure hasn't discovered what is
* going on for us. Try to guess...
*/
# include <limits.h>
-# if (INT_MAX < LONG_MAX)
+# if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
# define TCL_WIDE_INT_IS_LONG 1
-# else
-# define TCL_WIDE_INT_TYPE long long
# endif
# 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 */
+
+#ifndef TCL_WIDE_INT_TYPE
+# define TCL_WIDE_INT_TYPE long long
+#endif /* !TCL_WIDE_INT_TYPE */
typedef TCL_WIDE_INT_TYPE Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
-#ifdef TCL_WIDE_INT_IS_LONG
-# define Tcl_WideAsLong(val) ((long)(val))
-# define Tcl_LongAsWide(val) ((long)(val))
-# define Tcl_WideAsDouble(val) ((double)((long)(val)))
-# define Tcl_DoubleAsWide(val) ((long)((double)(val)))
-# ifndef TCL_LL_MODIFIER
-# define TCL_LL_MODIFIER "l"
-# endif /* !TCL_LL_MODIFIER */
-#else /* TCL_WIDE_INT_IS_LONG */
-/*
- * The next short section of defines are only done when not running on Windows
- * or some other strange platform.
- */
-# ifndef TCL_LL_MODIFIER
-# define TCL_LL_MODIFIER "ll"
-# endif /* !TCL_LL_MODIFIER */
-# 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 */
+#ifndef TCL_LL_MODIFIER
+# define TCL_LL_MODIFIER "ll"
+#endif /* !TCL_LL_MODIFIER */
+#ifndef TCL_Z_MODIFIER
+# if defined(__GNUC__) && !defined(_WIN32)
+# define TCL_Z_MODIFIER "z"
+# else
+# define TCL_Z_MODIFIER ""
+# endif
+#endif /* !TCL_Z_MODIFIER */
+#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)))
#if defined(_WIN32)
# ifdef __BORLANDC__
@@ -491,37 +457,15 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
*/
typedef struct Tcl_Interp
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{
/* TIP #330: Strongly discourage extensions from using the string
* result. */
-#ifdef USE_INTERP_RESULT
- char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
- /* If the last command returned a string
- * result, this points to it. */
- void (*freeProc) (char *blockPtr)
- TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
- /* Zero means the string result is statically
- * allocated. TCL_DYNAMIC means it was
- * allocated with ckalloc and should be freed
- * with ckfree. Other values give the address
- * of function to invoke to free the result.
- * Tcl_Eval must free it before executing next
- * command. */
-#else
char *resultDontUse; /* Don't use in extensions! */
void (*freeProcDontUse) (char *); /* Don't use in extensions! */
-#endif
-#ifdef USE_INTERP_ERRORLINE
- int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
- /* When TCL_ERROR is returned, this gives the
- * line number within the command where the
- * error occurred (1 if first line). */
-#else
int errorLineDontUse; /* Don't use in extensions! */
-#endif
}
-#endif /* TCL_NO_DEPRECATED */
+#endif /* !TCL_NO_DEPRECATED */
Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
@@ -671,7 +615,9 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_BREAK 3
#define TCL_CONTINUE 4
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TCL_RESULT_SIZE 200
+#endif
/*
*----------------------------------------------------------------------------
@@ -687,6 +633,7 @@ typedef struct stat *Tcl_OldStat_;
* Argument descriptors for math function callbacks in expressions:
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
typedef enum {
TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT
} Tcl_ValueType;
@@ -698,6 +645,10 @@ typedef struct Tcl_Value {
double doubleValue; /* Double-precision floating value. */
Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */
} Tcl_Value;
+#else
+#define Tcl_ValueType void /* Just enough to prevent compilation error in Tcl */
+#define Tcl_Value void /* Just enough to prevent compilation error in Tcl */
+#endif
/*
* Forward declaration of Tcl_Obj to prevent an error when the forward
@@ -718,10 +669,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask);
typedef void (Tcl_CloseProc) (ClientData data);
typedef void (Tcl_CmdDeleteProc) (ClientData clientData);
typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp,
- int argc, CONST84 char *argv[]);
+ int argc, const char *argv[]);
typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp,
int level, char *command, Tcl_CmdProc *proc,
- ClientData cmdClientData, int argc, CONST84 char *argv[]);
+ ClientData cmdClientData, int argc, const char *argv[]);
typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp,
int level, const char *command, Tcl_Command commandInfo, int objc,
struct Tcl_Obj *const *objv);
@@ -758,7 +709,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData);
typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr);
typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr);
typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp,
- CONST84 char *part1, CONST84 char *part2, int flags);
+ const char *part1, const char *part2, int flags);
typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp,
const char *oldName, const char *newName, int flags);
typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc,
@@ -796,6 +747,29 @@ typedef struct Tcl_ObjType {
} Tcl_ObjType;
/*
+ * The following structure stores an internal representation (intrep) for
+ * a Tcl value. An intrep is associated with an Tcl_ObjType when both
+ * are stored in the same Tcl_Obj. The routines of the Tcl_ObjType govern
+ * the handling of the intrep.
+ */
+
+typedef union Tcl_ObjIntRep { /* The internal representation: */
+ long longValue; /* - an long integer value. */
+ double doubleValue; /* - a double-precision floating value. */
+ void *otherValuePtr; /* - another, type-specific value, */
+ /* not used internally any more. */
+ Tcl_WideInt wideValue; /* - an integer value >= 64bits */
+ struct { /* - internal rep as two pointers. */
+ void *ptr1;
+ void *ptr2;
+ } twoPtrValue;
+ struct { /* - internal rep as a pointer and a long, */
+ void *ptr; /* not used internally any more. */
+ unsigned long value;
+ } ptrAndLongRep;
+} Tcl_ObjIntRep;
+
+/*
* One of the following structures exists for each object in the Tcl system.
* An object stores a value as either a string, some internal representation,
* or both.
@@ -820,39 +794,9 @@ typedef struct Tcl_Obj {
* corresponds to the type of the object's
* internal rep. NULL indicates the object has
* no internal rep (has no type). */
- union { /* The internal representation: */
- long longValue; /* - an long integer value. */
- double doubleValue; /* - a double-precision floating value. */
- void *otherValuePtr; /* - another, type-specific value,
- not used internally any more. */
- Tcl_WideInt wideValue; /* - a long long value. */
- struct { /* - internal rep as two pointers.
- * the main use of which is a bignum's
- * tightly packed fields, where the alloc,
- * used and signum flags are packed into
- * ptr2 with everything else hung off ptr1. */
- void *ptr1;
- void *ptr2;
- } twoPtrValue;
- struct { /* - internal rep as a pointer and a long,
- not used internally any more. */
- void *ptr;
- unsigned long value;
- } ptrAndLongRep;
- } internalRep;
+ Tcl_ObjIntRep internalRep; /* The internal representation: */
} 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). Note: clients
- * should use Tcl_DecrRefCount() when they are finished using an object, and
- * should never call TclFreeObj() directly. TclFreeObj() is only defined and
- * made public in tcl.h to support Tcl_DecrRefCount's macro definition.
- */
-
-void Tcl_IncrRefCount(Tcl_Obj *objPtr);
-void Tcl_DecrRefCount(Tcl_Obj *objPtr);
-int Tcl_IsShared(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------------------
@@ -868,7 +812,7 @@ typedef struct Tcl_SavedResult {
char *appendResult;
int appendAvl;
int appendUsed;
- char resultSpace[TCL_RESULT_SIZE+1];
+ char resultSpace[200+1];
} Tcl_SavedResult;
/*
@@ -994,7 +938,9 @@ typedef struct Tcl_DString {
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
-#define Tcl_DStringTrunc Tcl_DStringSetLength
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+# define Tcl_DStringTrunc Tcl_DStringSetLength
+#endif /* !TCL_NO_DEPRECATED */
/*
* Definitions for the maximum number of digits of precision that may be
@@ -1120,9 +1066,9 @@ typedef struct Tcl_DString {
* give the flag)
*/
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
# define TCL_PARSE_PART1 0x400
-#endif
+#endif /* !TCL_NO_DEPRECATED */
/*
* Types for linked variables:
@@ -1138,8 +1084,13 @@ typedef struct Tcl_DString {
#define TCL_LINK_SHORT 8
#define TCL_LINK_USHORT 9
#define TCL_LINK_UINT 10
+#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__)
+#define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
+#define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
+#else
#define TCL_LINK_LONG 11
#define TCL_LINK_ULONG 12
+#endif
#define TCL_LINK_FLOAT 13
#define TCL_LINK_WIDE_UINT 14
#define TCL_LINK_READ_ONLY 0x80
@@ -1149,29 +1100,21 @@ typedef struct Tcl_DString {
* Forward declarations of Tcl_HashTable and related types.
*/
+#ifndef TCL_HASH_TYPE
+# define TCL_HASH_TYPE unsigned
+#endif
+
typedef struct Tcl_HashKeyType Tcl_HashKeyType;
typedef struct Tcl_HashTable Tcl_HashTable;
typedef struct Tcl_HashEntry Tcl_HashEntry;
-typedef unsigned (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
+typedef TCL_HASH_TYPE (Tcl_HashKeyProc) (Tcl_HashTable *tablePtr, void *keyPtr);
typedef int (Tcl_CompareHashKeysProc) (void *keyPtr, Tcl_HashEntry *hPtr);
typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
void *keyPtr);
typedef void (Tcl_FreeHashEntryProc) (Tcl_HashEntry *hPtr);
/*
- * This flag controls whether the hash table stores the hash of a key, or
- * 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
-
-/*
* Structure definition for an entry in a hash table. No-one outside Tcl
* should access any of these fields directly; use the macros defined below.
*/
@@ -1180,15 +1123,9 @@ struct Tcl_HashEntry {
Tcl_HashEntry *nextPtr; /* Pointer to next entry in this hash bucket,
* or NULL for end of chain. */
Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */
-#if TCL_HASH_KEY_STORE_HASH
void *hash; /* Hash value, stored as pointer to ensure
* that the offsets of the fields in this
* structure are not changed. */
-#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: */
@@ -1348,8 +1285,8 @@ typedef struct Tcl_HashSearch {
typedef struct {
void *next; /* Search position for underlying hash
* table. */
- int epoch; /* Epoch marker for dictionary being searched,
- * or -1 if search has terminated. */
+ unsigned int epoch; /* Epoch marker for dictionary being searched,
+ * or 0 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
} Tcl_DictSearch;
@@ -1482,14 +1419,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData,
typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf,
int toRead, int *errorCodePtr);
typedef int (Tcl_DriverOutputProc) (ClientData instanceData,
- CONST84 char *buf, int toWrite, int *errorCodePtr);
+ const char *buf, int toWrite, int *errorCodePtr);
typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset,
int mode, int *errorCodePtr);
typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData,
Tcl_Interp *interp, const char *optionName,
const char *value);
typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData,
- Tcl_Interp *interp, CONST84 char *optionName,
+ Tcl_Interp *interp, const char *optionName,
Tcl_DString *dsPtr);
typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask);
typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData,
@@ -2196,16 +2133,16 @@ typedef struct Tcl_EncodingType {
/*
* The maximum number of bytes that are necessary to represent a single
- * Unicode character in UTF-8. The valid values should be 3, 4 or 6
- * (or perhaps 1 if we want to support a non-unicode enabled core). If 3 or
- * 4, then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
+ * Unicode character in UTF-8. The valid values are 4 and 6
+ * (or perhaps 1 if we want to support a non-unicode enabled core). If 4,
+ * then Tcl_UniChar must be 2-bytes in size (UCS-2) (the default). If 6,
* then Tcl_UniChar must be 4-bytes in size (UCS-4). At this time UCS-2 mode
* is the default and recommended mode. UCS-4 is experimental and not
* recommended. It works for the core, but most extensions expect UCS-2.
*/
#ifndef TCL_UTF_MAX
-#define TCL_UTF_MAX 3
+#define TCL_UTF_MAX 4
#endif
/*
@@ -2267,6 +2204,8 @@ typedef struct mp_int mp_int;
#define MP_INT_DECLARED
typedef unsigned int mp_digit;
#define MP_DIGIT_DECLARED
+typedef unsigned TCL_WIDE_INT_TYPE mp_word;
+#define MP_WORD_DECLARED
/*
*----------------------------------------------------------------------------
@@ -2377,6 +2316,20 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
/*
*----------------------------------------------------------------------------
+ * Definitions needed for the Tcl_OpenTcpServerEx function. [TIP #456]
+ */
+#define TCL_TCPSERVER_REUSEADDR (1<<0)
+#define TCL_TCPSERVER_REUSEPORT (1<<1)
+
+/*
+ * Constants for special int-typed values, see TIP #494
+ */
+
+#define TCL_IO_FAILURE (-1)
+#define TCL_AUTO_LENGTH (-1)
+
+/*
+ *----------------------------------------------------------------------------
* Single public declaration for NRE.
*/
@@ -2386,13 +2339,10 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
/*
*----------------------------------------------------------------------------
* The following constant is used to test for older versions of Tcl in the
- * stubs tables.
- *
- * Jan Nijtman's plus patch uses 0xFCA1BACF, so we need to pick a different
- * value since the stubs tables don't match.
+ * stubs tables. If TCL_UTF_MAX>4 use a different value.
*/
-#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
+#define TCL_STUB_MAGIC ((int) 0xFCA3BACF + (TCL_UTF_MAX>4))
/*
* The following function is required to be defined in all stubs aware
@@ -2402,22 +2352,38 @@ typedef int (Tcl_NRPostProc) (ClientData data[], Tcl_Interp *interp,
*/
const char * Tcl_InitStubs(Tcl_Interp *interp, const char *version,
- int exact);
+ int exact, int magic);
const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
const char *version, int epoch, int revision);
-
-/*
- * When not using stubs, make it a macro.
- */
-
-#ifndef USE_TCL_STUBS
-#define Tcl_InitStubs(interp, version, exact) \
- Tcl_PkgInitStubsCheck(interp, version, exact)
+#if defined(_WIN32)
+ TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...);
+#else
+# define Tcl_ConsolePanic ((Tcl_PanicProc *)0)
#endif
-/*
- * TODO - tommath stubs export goes here!
- */
+#ifdef USE_TCL_STUBS
+#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+# define Tcl_InitStubs(interp, version, exact) \
+ (Tcl_InitStubs)(interp, version, \
+ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
+ TCL_STUB_MAGIC)
+#else
+# define Tcl_InitStubs(interp, version, exact) \
+ (Tcl_InitStubs)(interp, TCL_PATCH_LEVEL, \
+ 1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
+ TCL_STUB_MAGIC)
+#endif
+#else
+#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+# define Tcl_InitStubs(interp, version, exact) \
+ Tcl_PkgInitStubsCheck(interp, version, \
+ (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
+#else
+# define Tcl_InitStubs(interp, version, exact) \
+ Tcl_PkgInitStubsCheck(interp, TCL_PATCH_LEVEL, \
+ 1|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
+#endif
+#endif
/*
* Public functions that are not accessible via the stubs table.
@@ -2425,12 +2391,15 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp,
*/
#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
- ((Tcl_CreateInterp)()))
+ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)()))
EXTERN void Tcl_MainEx(int argc, char **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
EXTERN const char * Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
const char *version, int exact);
EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
+#ifndef _WIN32
+EXTERN int TclZipfs_AppHook(int *argc, char ***argv);
+#endif
/*
*----------------------------------------------------------------------------
@@ -2501,26 +2470,39 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
#endif /* !TCL_MEM_DEBUG */
#ifdef TCL_MEM_DEBUG
+# undef Tcl_IncrRefCount
# define Tcl_IncrRefCount(objPtr) \
Tcl_DbIncrRefCount(objPtr, __FILE__, __LINE__)
+# undef Tcl_DecrRefCount
# define Tcl_DecrRefCount(objPtr) \
Tcl_DbDecrRefCount(objPtr, __FILE__, __LINE__)
+# undef Tcl_IsShared
# define Tcl_IsShared(objPtr) \
Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
-#else
+#elif (!defined(TCL_NO_DEPRECATED) && defined(USE_TCL_STUBS))
+/*
+ * When compiling stub-enabled extensions without -DTCL_NO_DEPRECATED,
+ * those extensions are expected to run fine with Tcl 8.6 as well.
+ * This means we must continue to use macro's for the above 3 functions,
+ * and the old stub entry for TclFreeObj. All other usage of TclFreeObj()
+ * is forbidden now, therefore it is changed to be MODULE_SCOPE internal.
+ */
+# undef Tcl_IncrRefCount
# define Tcl_IncrRefCount(objPtr) \
++(objPtr)->refCount
/*
* Use do/while0 idiom for optimum correctness without compiler warnings.
* http://c2.com/cgi/wiki?TrivialDoWhileLoop
*/
+# undef Tcl_DecrRefCount
# define Tcl_DecrRefCount(objPtr) \
do { \
Tcl_Obj *_objPtr = (objPtr); \
if ((_objPtr)->refCount-- <= 1) { \
- TclFreeObj(_objPtr); \
+ TclOldFreeObj(_objPtr); \
} \
} while(0)
+# undef Tcl_IsShared
# define Tcl_IsShared(objPtr) \
((objPtr)->refCount > 1)
#endif
@@ -2537,22 +2519,16 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
Tcl_DbNewBignumObj(val, __FILE__, __LINE__)
# undef Tcl_NewBooleanObj
# define Tcl_NewBooleanObj(val) \
- Tcl_DbNewBooleanObj(val, __FILE__, __LINE__)
+ Tcl_DbNewWideIntObj((val)!=0, __FILE__, __LINE__)
# undef Tcl_NewByteArrayObj
# define Tcl_NewByteArrayObj(bytes, len) \
Tcl_DbNewByteArrayObj(bytes, len, __FILE__, __LINE__)
# undef Tcl_NewDoubleObj
# define Tcl_NewDoubleObj(val) \
Tcl_DbNewDoubleObj(val, __FILE__, __LINE__)
-# undef Tcl_NewIntObj
-# define Tcl_NewIntObj(val) \
- Tcl_DbNewLongObj(val, __FILE__, __LINE__)
# undef Tcl_NewListObj
# define Tcl_NewListObj(objc, objv) \
Tcl_DbNewListObj(objc, objv, __FILE__, __LINE__)
-# undef Tcl_NewLongObj
-# define Tcl_NewLongObj(val) \
- Tcl_DbNewLongObj(val, __FILE__, __LINE__)
# undef Tcl_NewObj
# define Tcl_NewObj() \
Tcl_DbNewObj(__FILE__, __LINE__)
@@ -2591,31 +2567,10 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
/*
*----------------------------------------------------------------------------
- * Macros that eliminate the overhead of the thread synchronization functions
- * when compiling without thread support.
- */
-
-#ifndef TCL_THREADS
-#undef Tcl_MutexLock
-#define Tcl_MutexLock(mutexPtr)
-#undef Tcl_MutexUnlock
-#define Tcl_MutexUnlock(mutexPtr)
-#undef Tcl_MutexFinalize
-#define Tcl_MutexFinalize(mutexPtr)
-#undef Tcl_ConditionNotify
-#define Tcl_ConditionNotify(condPtr)
-#undef Tcl_ConditionWait
-#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
-#undef Tcl_ConditionFinalize
-#define Tcl_ConditionFinalize(condPtr)
-#endif /* TCL_THREADS */
-
-/*
- *----------------------------------------------------------------------------
* Deprecated Tcl functions:
*/
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* These function have been renamed. The old names are deprecated, but we
* define these macros for backwards compatibility.
@@ -2630,7 +2585,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# define panic Tcl_Panic
#endif
# define panicVA Tcl_PanicVA
-#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------------
@@ -2641,6 +2595,8 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
extern Tcl_AppInitProc Tcl_AppInit;
+#endif /* !TCL_NO_DEPRECATED */
+
#endif /* RC_INVOKED */
/*
diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index cda1f38..df1718b 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -22,7 +22,7 @@
*/
#include "tclInt.h"
-#if !defined(TCL_THREADS) || !defined(USE_THREAD_ALLOC)
+#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)
#if USE_TCLALLOC
@@ -32,7 +32,7 @@
*/
#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
-typedef unsigned long caddr_t;
+typedef size_t caddr_t;
#endif
/*
@@ -56,7 +56,7 @@ union overhead {
unsigned char magic1; /* other magic number */
#ifndef NDEBUG
unsigned short rmagic; /* range magic number */
- unsigned long size; /* actual block size */
+ size_t size; /* actual block size */
unsigned short unused2; /* padding to 8-byte align */
#endif
} ovu;
@@ -121,7 +121,7 @@ static struct block bigBlocks={ /* Big blocks aren't suballocated. */
* variable.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;
@@ -133,7 +133,7 @@ static int allocInit = 0;
* a given block size.
*/
-static unsigned int numMallocs[NBUCKETS+1];
+static size_t numMallocs[NBUCKETS+1];
#endif
#if !defined(NDEBUG)
@@ -148,7 +148,7 @@ static unsigned int numMallocs[NBUCKETS+1];
* Prototypes for functions used only in this file.
*/
-static void MoreCore(int bucket);
+static void MoreCore(size_t bucket);
/*
*-------------------------------------------------------------------------
@@ -171,7 +171,7 @@ TclInitAlloc(void)
{
if (!allocInit) {
allocInit = 1;
-#ifdef TCL_THREADS
+#if TCL_THREADS
allocMutexPtr = Tcl_GetAllocMutex();
#endif
}
@@ -254,7 +254,7 @@ TclpAlloc(
unsigned int numBytes) /* Number of bytes to allocate. */
{
register union overhead *overPtr;
- register long bucket;
+ register size_t bucket;
register unsigned amount;
struct block *bigBlockPtr = NULL;
@@ -385,12 +385,12 @@ TclpAlloc(
static void
MoreCore(
- int bucket) /* What bucket to allocat to. */
+ size_t bucket) /* What bucket to allocate to. */
{
register union overhead *overPtr;
- register long size; /* size of desired block */
- long amount; /* amount to allocate */
- int numBlocks; /* how many blocks we get */
+ register size_t size; /* size of desired block */
+ size_t amount; /* amount to allocate */
+ size_t numBlocks; /* how many blocks we get */
struct block *blockPtr;
/*
@@ -398,14 +398,14 @@ MoreCore(
* VAX, I think) or for a negative arg.
*/
- size = 1 << (bucket + 3);
+ size = ((size_t)1) << (bucket + 3);
ASSERT(size > 0);
amount = MAXMALLOC;
numBlocks = amount / size;
ASSERT(numBlocks*size == amount);
- blockPtr = (struct block *) TclpSysAlloc((unsigned)
+ blockPtr = (struct block *) TclpSysAlloc(
(sizeof(struct block) + amount), 1);
/* no more room! */
if (blockPtr == NULL) {
@@ -448,7 +448,7 @@ void
TclpFree(
char *oldPtr) /* Pointer to memory to free. */
{
- register long size;
+ register size_t size;
register union overhead *overPtr;
struct block *bigBlockPtr;
@@ -518,7 +518,7 @@ TclpRealloc(
union overhead *overPtr;
struct block *bigBlockPtr;
int expensive;
- unsigned long maxSize;
+ size_t maxSize;
if (oldPtr == NULL) {
return TclpAlloc(numBytes);
@@ -645,29 +645,29 @@ void
mstats(
char *s) /* Where to write info. */
{
- register int i, j;
+ register unsigned int i, j;
register union overhead *overPtr;
- int totalFree = 0, totalUsed = 0;
+ size_t totalFree = 0, totalUsed = 0;
Tcl_MutexLock(allocMutexPtr);
fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
for (i = 0; i < NBUCKETS; i++) {
for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
- fprintf(stderr, " %d", j);
+ fprintf(stderr, " %u", j);
}
- totalFree += j * (1 << (i + 3));
+ totalFree += ((size_t)j) * (1 << (i + 3));
}
fprintf(stderr, "\nused:\t");
for (i = 0; i < NBUCKETS; i++) {
- fprintf(stderr, " %d", numMallocs[i]);
+ fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
totalUsed += numMallocs[i] * (1 << (i + 3));
}
- fprintf(stderr, "\n\tTotal small in use: %d, total free: %d\n",
- totalUsed, totalFree);
- fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n",
+ fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
+ totalUsed, totalFree);
+ fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
MAXMALLOC, numMallocs[NBUCKETS]);
Tcl_MutexUnlock(allocMutexPtr);
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index b6bebb6..5db2676 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -32,6 +32,7 @@
#include "tclInt.h"
#include "tclCompile.h"
#include "tclOOInt.h"
+#include <assert.h>
/*
* Structure that represents a range of instructions in the bytecode.
@@ -271,15 +272,12 @@ static void CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
const TalInstDesc*);
static int DefineLabel(AssemblyEnv* envPtr, const char* label);
static void DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void DupAssembleCodeInternalRep(Tcl_Obj* src,
- Tcl_Obj* dest);
static void FillInJumpOffsets(AssemblyEnv*);
static int CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
Tcl_Obj* jumpTable);
static int FindLocalVar(AssemblyEnv* envPtr,
Tcl_Token** tokenPtrPtr);
static int FinishAssembly(AssemblyEnv*);
-static void FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
static void FreeAssemblyEnv(AssemblyEnv*);
static int GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
static int GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -318,6 +316,9 @@ static void UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
* Tcl_ObjType that describes bytecode emitted by the assembler.
*/
+static Tcl_FreeInternalRepProc FreeAssembleCodeInternalRep;
+static Tcl_DupInternalRepProc DupAssembleCodeInternalRep;
+
static const Tcl_ObjType assembleCodeType = {
"assemblecode",
FreeAssembleCodeInternalRep, /* freeIntRepProc */
@@ -802,7 +803,7 @@ TclNRAssembleObjCmd(
Tcl_AddErrorInfo(interp, "\n (\"");
Tcl_AppendObjToErrorInfo(interp, objv[0]);
Tcl_AddErrorInfo(interp, "\" body, line ");
- backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp));
+ backtrace = Tcl_NewWideIntObj(Tcl_GetErrorLine(interp));
Tcl_AppendObjToErrorInfo(interp, backtrace);
Tcl_AddErrorInfo(interp, ")");
return TCL_ERROR;
@@ -847,15 +848,15 @@ CompileAssembleObj(
const char* source; /* String representation of the source code */
int sourceLen; /* Length of the source code in bytes */
-
/*
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
- if (objPtr->typePtr == &assembleCodeType) {
+ ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+
+ if (codePtr) {
namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == namespacePtr)
@@ -869,7 +870,7 @@ CompileAssembleObj(
* Not valid, so free it and regenerate.
*/
- FreeAssembleCodeInternalRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
}
/*
@@ -894,15 +895,13 @@ CompileAssembleObj(
*/
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &assembleCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &assembleCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
/*
* Record the local variable context to which the bytecode pertains
*/
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1304,8 +1303,8 @@ AssembleOneLine(
if (GetNextOperand(assemEnvPtr, &tokenPtr, &operand1Obj) != TCL_OK) {
goto cleanup;
}
- operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
- litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+ operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
+ litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
BBEmitInst1or4(assemEnvPtr, tblIdx, litIndex, 0);
break;
@@ -1470,8 +1469,8 @@ AssembleOneLine(
&operand1Obj) != TCL_OK) {
goto cleanup;
} else {
- operand1 = Tcl_GetStringFromObj(operand1Obj, &operand1Len);
- litIndex = TclRegisterNewLiteral(envPtr, operand1, operand1Len);
+ operand1 = TclGetStringFromObj(operand1Obj, &operand1Len);
+ litIndex = TclRegisterLiteral(envPtr, operand1, operand1Len, 0);
/*
* Assumes that PUSH is the first slot!
@@ -1565,7 +1564,7 @@ AssembleOneLine(
* Add the (label_name, address) pair to the hash table.
*/
- if (DefineLabel(assemEnvPtr, Tcl_GetString(operand1Obj)) != TCL_OK) {
+ if (DefineLabel(assemEnvPtr, TclGetString(operand1Obj)) != TCL_OK) {
goto cleanup;
}
break;
@@ -1744,7 +1743,7 @@ AssembleOneLine(
default:
Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
- Tcl_GetString(instNameObj));
+ TclGetString(instNameObj));
}
status = TCL_OK;
@@ -2007,15 +2006,15 @@ CreateMirrorJumpTable(
DEBUG_PRINT("jump table {\n");
for (i = 0; i < objc; i+=2) {
- DEBUG_PRINT(" %s -> %s\n", Tcl_GetString(objv[i]),
- Tcl_GetString(objv[i+1]));
- hashEntry = Tcl_CreateHashEntry(jtHashPtr, Tcl_GetString(objv[i]),
+ DEBUG_PRINT(" %s -> %s\n", TclGetString(objv[i]),
+ TclGetString(objv[i+1]));
+ hashEntry = Tcl_CreateHashEntry(jtHashPtr, TclGetString(objv[i]),
&isNew);
if (!isNew) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"duplicate entry in jump table for \"%s\"",
- Tcl_GetString(objv[i])));
+ TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
@@ -2255,7 +2254,7 @@ GetListIndexOperand(
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
return TCL_ERROR;
}
-
+
/* Convert to an integer, advance to the next token and return. */
/*
* NOTE: Indexing a list with an index before it yields the
@@ -2263,7 +2262,7 @@ GetListIndexOperand(
* when list size limits grow.
*/
status = TclIndexEncode(interp, value,
- TCL_INDEX_BEFORE,TCL_INDEX_BEFORE, result);
+ TCL_INDEX_NONE,TCL_INDEX_NONE, result);
Tcl_DecrRefCount(value);
*tokenPtrPtr = TokenAfter(tokenPtr);
@@ -2311,7 +2310,7 @@ FindLocalVar(
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
return -1;
}
- varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
+ varNameStr = TclGetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
Tcl_DecrRefCount(varNameObj);
return -1;
@@ -2824,7 +2823,7 @@ CalculateJumpRelocations(
if (bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ TclGetString(bbPtr->jumpTarget));
if (entry == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr,
bbPtr->jumpTarget);
@@ -2905,10 +2904,10 @@ CheckJumpTableLabels(
symEntryPtr = Tcl_NextHashEntry(&search)) {
symbolObj = Tcl_GetHashValue(symEntryPtr);
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(symbolObj));
+ TclGetString(symbolObj));
DEBUG_PRINT(" %s -> %s (%d)\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj), (valEntryPtr != NULL));
+ TclGetString(symbolObj), (valEntryPtr != NULL));
if (valEntryPtr == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
return TCL_ERROR;
@@ -2946,9 +2945,9 @@ ReportUndefinedLabel(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "undefined label \"%s\"", Tcl_GetString(jumpTarget)));
+ "undefined label \"%s\"", TclGetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
- Tcl_GetString(jumpTarget), NULL);
+ TclGetString(jumpTarget), NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
}
}
@@ -3031,7 +3030,7 @@ FillInJumpOffsets(
bbPtr = bbPtr->successor1) {
if (bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ TclGetString(bbPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
fromOffset = bbPtr->jumpOffset;
targetOffset = jumpTarget->startOffset;
@@ -3103,17 +3102,17 @@ ResolveJumpTableTargets(
symEntryPtr != NULL;
symEntryPtr = Tcl_NextHashEntry(&search)) {
symbolObj = Tcl_GetHashValue(symEntryPtr);
- DEBUG_PRINT(" symbol %s\n", Tcl_GetString(symbolObj));
+ DEBUG_PRINT(" symbol %s\n", TclGetString(symbolObj));
valEntryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(symbolObj));
+ TclGetString(symbolObj));
jumpTargetBBPtr = Tcl_GetHashValue(valEntryPtr);
realJumpEntryPtr = Tcl_CreateHashEntry(realJumpHashPtr,
Tcl_GetHashKey(symHash, symEntryPtr), &junk);
DEBUG_PRINT(" %s -> %s -> bb %p (pc %d) hash entry %p\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj), jumpTargetBBPtr,
+ TclGetString(symbolObj), jumpTargetBBPtr,
jumpTargetBBPtr->startOffset, realJumpEntryPtr);
Tcl_SetHashValue(realJumpEntryPtr,
@@ -3485,7 +3484,7 @@ StackCheckBasicBlock(
if (result == TCL_OK && blockPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(blockPtr->jumpTarget));
+ TclGetString(blockPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget, blockPtr,
stackDepth);
@@ -3502,7 +3501,7 @@ StackCheckBasicBlock(
jtEntry = Tcl_NextHashEntry(&jtSearch)) {
targetLabel = Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(targetLabel));
+ TclGetString(targetLabel));
jumpTarget = Tcl_GetHashValue(entry);
result = StackCheckBasicBlock(assemEnvPtr, jumpTarget,
blockPtr, stackDepth);
@@ -3564,7 +3563,7 @@ StackCheckExit(
* Emit a 'push' of the empty literal.
*/
- litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+ litIndex = TclRegisterLiteral(envPtr, "", 0, 0);
/*
* Assumes that 'push' is at slot 0 in TalInstructionTable.
@@ -3807,7 +3806,7 @@ ProcessCatchesInBasicBlock(
}
if (result == TCL_OK && bbPtr->jumpTarget != NULL) {
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(bbPtr->jumpTarget));
+ TclGetString(bbPtr->jumpTarget));
jumpTarget = Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
jumpEnclosing, jumpState, catchDepth);
@@ -3823,7 +3822,7 @@ ProcessCatchesInBasicBlock(
jtEntry = Tcl_NextHashEntry(&jtSearch)) {
targetLabel = Tcl_GetHashValue(jtEntry);
entry = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(targetLabel));
+ TclGetString(targetLabel));
jumpTarget = Tcl_GetHashValue(entry);
result = ProcessCatchesInBasicBlock(assemEnvPtr, jumpTarget,
jumpEnclosing, jumpState, catchDepth);
@@ -4127,7 +4126,7 @@ StackFreshCatches(
range->codeOffset = bbPtr->startOffset;
entryPtr = Tcl_FindHashEntry(&assemEnvPtr->labelHash,
- Tcl_GetString(catch->jumpTarget));
+ TclGetString(catch->jumpTarget));
if (entryPtr == NULL) {
Tcl_Panic("undefined label in tclAssembly.c:"
"BuildExceptionRanges, can't happen");
@@ -4264,12 +4263,12 @@ AddBasicBlockRangeToErrorInfo(
Tcl_Obj* lineNo; /* Line number in the source */
Tcl_AddErrorInfo(interp, "\n in assembly code between lines ");
- lineNo = Tcl_NewIntObj(bbPtr->startLine);
+ lineNo = Tcl_NewWideIntObj(bbPtr->startLine);
Tcl_IncrRefCount(lineNo);
Tcl_AppendObjToErrorInfo(interp, lineNo);
Tcl_AddErrorInfo(interp, " and ");
if (bbPtr->successor1 != NULL) {
- Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine);
+ TclSetIntObj(lineNo, bbPtr->successor1->startLine);
Tcl_AppendObjToErrorInfo(interp, lineNo);
} else {
Tcl_AddErrorInfo(interp, "end of assembly code");
@@ -4334,13 +4333,12 @@ static void
FreeAssembleCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
- }
- objPtr->typePtr = NULL;
+ ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+ assert(codePtr != NULL);
+
+ TclReleaseByteCode(codePtr);
}
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e014b06..3747c90 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -71,7 +71,18 @@ typedef struct {
} CancelInfo;
static Tcl_HashTable cancelTable;
static int cancelTableInitialized = 0; /* 0 means not yet initialized. */
-TCL_DECLARE_MUTEX(cancelLock)
+TCL_DECLARE_MUTEX(cancelLock);
+
+/*
+ * Table used to map command implementation functions to a human-readable type
+ * name, for [info type]. The keys in the table are function addresses, and
+ * the values in the table are static char* containing strings in Tcl's
+ * internal encoding (almost UTF-8).
+ */
+
+static Tcl_HashTable commandTypeTable;
+static int commandTypeInit = 0;
+TCL_DECLARE_MUTEX(commandTypeLock);
/*
* Declarations for managing contexts for non-recursive coroutines. Contexts
@@ -94,6 +105,7 @@ TCL_DECLARE_MUTEX(cancelLock)
* Static functions in this file:
*/
+static Tcl_ObjCmdProc BadEnsembleSubcommand;
static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
const char *oldName, const char *newName,
int flags);
@@ -114,10 +126,11 @@ static Tcl_ObjCmdProc ExprBinaryFunc;
static Tcl_ObjCmdProc ExprBoolFunc;
static Tcl_ObjCmdProc ExprCeilFunc;
static Tcl_ObjCmdProc ExprDoubleFunc;
-static Tcl_ObjCmdProc ExprEntierFunc;
static Tcl_ObjCmdProc ExprFloorFunc;
static Tcl_ObjCmdProc ExprIntFunc;
static Tcl_ObjCmdProc ExprIsqrtFunc;
+static Tcl_ObjCmdProc ExprMaxFunc;
+static Tcl_ObjCmdProc ExprMinFunc;
static Tcl_ObjCmdProc ExprRandFunc;
static Tcl_ObjCmdProc ExprRoundFunc;
static Tcl_ObjCmdProc ExprSqrtFunc;
@@ -130,8 +143,10 @@ static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
static Tcl_NRPostProc NRCommand;
+#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
+#endif /* !defined(TCL_NO_DEPRECATED) */
static void ProcessUnexpectedResult(Tcl_Interp *interp,
int returnCode);
static int RewindCoroutine(CoroutineData *corPtr, int result);
@@ -192,6 +207,24 @@ typedef struct {
* it for it. Defined in tclInt.h. */
/*
+ * The following struct states that the command it talks about (a subcommand
+ * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
+ * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
+ * structs.) Alas, we can't sensibly just store the information directly in
+ * the commands.
+ */
+
+typedef struct {
+ const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
+ * the end of the list of commands to hide. */
+ const char *commandName; /* The name of the command within the
+ * ensemble. If this is NULL, we want to also
+ * make the overall command be hidden, an ugly
+ * hack because it is expected by security
+ * policies in the wild. */
+} UnsafeEnsembleInfo;
+
+/*
* The built-in commands, and the functions that implement them:
*/
@@ -203,7 +236,7 @@ static const CmdInfo builtInCmds[] = {
{"append", Tcl_AppendObjCmd, TclCompileAppendCmd, NULL, CMD_IS_SAFE},
{"apply", Tcl_ApplyObjCmd, NULL, TclNRApplyObjCmd, CMD_IS_SAFE},
{"break", Tcl_BreakObjCmd, TclCompileBreakCmd, NULL, CMD_IS_SAFE},
-#ifndef EXCLUDE_OBSOLETE_COMMANDS
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
{"case", Tcl_CaseObjCmd, NULL, NULL, CMD_IS_SAFE},
#endif
{"catch", Tcl_CatchObjCmd, TclCompileCatchCmd, TclNRCatchObjCmd, CMD_IS_SAFE},
@@ -227,6 +260,7 @@ static const CmdInfo builtInCmds[] = {
{"list", Tcl_ListObjCmd, TclCompileListCmd, NULL, CMD_IS_SAFE|CMD_COMPILES_EXPANDED},
{"llength", Tcl_LlengthObjCmd, TclCompileLlengthCmd, NULL, CMD_IS_SAFE},
{"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE},
+ {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE},
{"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE},
{"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE},
@@ -292,6 +326,68 @@ static const CmdInfo builtInCmds[] = {
};
/*
+ * Information about which pieces of ensembles to hide when making an
+ * interpreter safe:
+ */
+
+static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
+ /* [encoding] has two unsafe commands. Assumed by older security policies
+ * to be overall unsafe; it isn't but... */
+ {"encoding", NULL},
+ {"encoding", "dirs"},
+ {"encoding", "system"},
+ /* [file] has MANY unsafe commands! Assumed by older security policies to
+ * be overall unsafe; it isn't but... */
+ {"file", NULL},
+ {"file", "atime"},
+ {"file", "attributes"},
+ {"file", "copy"},
+ {"file", "delete"},
+ {"file", "dirname"},
+ {"file", "executable"},
+ {"file", "exists"},
+ {"file", "extension"},
+ {"file", "isdirectory"},
+ {"file", "isfile"},
+ {"file", "link"},
+ {"file", "lstat"},
+ {"file", "mtime"},
+ {"file", "mkdir"},
+ {"file", "nativename"},
+ {"file", "normalize"},
+ {"file", "owned"},
+ {"file", "readable"},
+ {"file", "readlink"},
+ {"file", "rename"},
+ {"file", "rootname"},
+ {"file", "size"},
+ {"file", "stat"},
+ {"file", "tail"},
+ {"file", "tempfile"},
+ {"file", "type"},
+ {"file", "volumes"},
+ {"file", "writable"},
+ /* [info] has two unsafe commands */
+ {"info", "cmdtype"},
+ {"info", "nameofexecutable"},
+ /* [tcl::process] has ONLY unsafe commands! */
+ {"process", "list"},
+ {"process", "status"},
+ {"process", "purge"},
+ {"process", "autopurge"},
+ /* [zipfs] has MANY unsafe commands! */
+ {"zipfs", "lmkimg"},
+ {"zipfs", "lmkzip"},
+ {"zipfs", "mkimg"},
+ {"zipfs", "mkkey"},
+ {"zipfs", "mkzip"},
+ {"zipfs", "mount"},
+ {"zipfs", "mount_data"},
+ {"zipfs", "unmount"},
+ {NULL, NULL}
+};
+
+/*
* Math functions. All are safe.
*/
@@ -312,7 +408,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "cos", ExprUnaryFunc, (ClientData) cos },
{ "cosh", ExprUnaryFunc, (ClientData) cosh },
{ "double", ExprDoubleFunc, NULL },
- { "entier", ExprEntierFunc, NULL },
+ { "entier", ExprIntFunc, NULL },
{ "exp", ExprUnaryFunc, (ClientData) exp },
{ "floor", ExprFloorFunc, NULL },
{ "fmod", ExprBinaryFunc, (ClientData) fmod },
@@ -321,6 +417,8 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
{ "isqrt", ExprIsqrtFunc, NULL },
{ "log", ExprUnaryFunc, (ClientData) log },
{ "log10", ExprUnaryFunc, (ClientData) log10 },
+ { "max", ExprMaxFunc, NULL },
+ { "min", ExprMinFunc, NULL },
{ "pow", ExprBinaryFunc, (ClientData) pow },
{ "rand", ExprRandFunc, NULL },
{ "round", ExprRoundFunc, NULL },
@@ -425,6 +523,13 @@ TclFinalizeEvaluation(void)
cancelTableInitialized = 0;
}
Tcl_MutexUnlock(&cancelLock);
+
+ Tcl_MutexLock(&commandTypeLock);
+ if (commandTypeInit) {
+ Tcl_DeleteHashTable(&commandTypeTable);
+ commandTypeInit = 0;
+ }
+ Tcl_MutexUnlock(&commandTypeLock);
}
/*
@@ -498,9 +603,23 @@ Tcl_CreateInterp(void)
Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
cancelTableInitialized = 1;
}
+
Tcl_MutexUnlock(&cancelLock);
}
+ if (commandTypeInit == 0) {
+ TclRegisterCommandTypeName(TclObjInterpProc, "proc");
+ TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
+ TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
+ TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
+ TclRegisterCommandTypeName(TclSlaveObjCmd, "slave");
+ TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
+ TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
+ TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
+ TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass");
+ TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
+ }
+
/*
* Initialize support for namespaces and create the global namespace
* (whose name is ""; an alias is "::"). This also initializes the Tcl
@@ -510,7 +629,11 @@ Tcl_CreateInterp(void)
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
+#ifdef TCL_NO_DEPRECATED
+ iPtr->result = &tclEmptyString;
+#else
iPtr->result = iPtr->resultSpace;
+#endif
iPtr->freeProc = NULL;
iPtr->errorLine = 0;
iPtr->objResultPtr = Tcl_NewObj();
@@ -570,23 +693,26 @@ Tcl_CreateInterp(void)
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
iPtr->lookupNsPtr = NULL;
+#ifndef TCL_NO_DEPRECATED
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
+#endif
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
/* TIP #268 */
+#if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
iPtr->packagePrefer = PKG_PREFER_STABLE;
- } else {
+ } else
+#endif
iPtr->packagePrefer = PKG_PREFER_LATEST;
- }
iPtr->cmdCount = 0;
TclInitLiteralTable(&iPtr->literalTable);
- iPtr->compileEpoch = 0;
+ iPtr->compileEpoch = 1;
iPtr->compiledProcPtr = NULL;
iPtr->resolverPtr = NULL;
iPtr->evalFlags = 0;
@@ -601,7 +727,9 @@ Tcl_CreateInterp(void)
iPtr->emptyObjPtr = Tcl_NewObj();
/* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
+#ifndef TCL_NO_DEPRECATED
iPtr->resultSpace[0] = 0;
+#endif
iPtr->threadId = Tcl_GetCurrentThread();
/* TIP #378 */
@@ -734,7 +862,7 @@ Tcl_CreateInterp(void)
* cache was already initialised by the call to alloc the interp struct.
*/
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
iPtr->allocCache = TclpGetAllocCache();
#else
iPtr->allocCache = NULL;
@@ -804,6 +932,7 @@ Tcl_CreateInterp(void)
TclInitNamespaceCmd(interp);
TclInitStringCmd(interp);
TclInitPrefixCmd(interp);
+ TclInitProcessCmd(interp);
/*
* Register "clock" subcommands. These *do* go through
@@ -929,24 +1058,26 @@ Tcl_CreateInterp(void)
TCL_GLOBAL_ONLY);
Tcl_SetVar2Ex(interp, "tcl_platform", "wordSize",
- Tcl_NewLongObj((long) sizeof(long)), TCL_GLOBAL_ONLY);
+ Tcl_NewWideIntObj(sizeof(long)), TCL_GLOBAL_ONLY);
/* TIP #291 */
Tcl_SetVar2Ex(interp, "tcl_platform", "pointerSize",
- Tcl_NewLongObj((long) sizeof(void *)), TCL_GLOBAL_ONLY);
+ Tcl_NewWideIntObj(sizeof(void *)), TCL_GLOBAL_ONLY);
/*
* Set up other variables such as tcl_version and tcl_library
*/
- Tcl_SetVar(interp, "tcl_patchLevel", TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_version", TCL_VERSION, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_patchLevel", NULL, TCL_PATCH_LEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_version", NULL, TCL_VERSION, TCL_GLOBAL_ONLY);
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Tcl_TraceVar2(interp, "tcl_precision", NULL,
TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
TclPrecTraceProc, NULL);
+#endif /* !TCL_NO_DEPRECATED */
TclpSetVariables(interp);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The existence of the "threaded" element of the tcl_platform array
* indicates that this particular Tcl shell has been compiled with threads
@@ -965,11 +1096,11 @@ Tcl_CreateInterp(void)
Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
if (TclTommath_Init(interp) != TCL_OK) {
- Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
}
if (TclOOInit(interp) != TCL_OK) {
- Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+ Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
}
/*
@@ -979,6 +1110,9 @@ Tcl_CreateInterp(void)
#ifdef HAVE_ZLIB
if (TclZlibInit(interp) != TCL_OK) {
+ Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
+ }
+ if (TclZipfs_Init(interp) != TCL_OK) {
Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
}
#endif
@@ -997,6 +1131,71 @@ DeleteOpCmdClientData(
}
/*
+ * ---------------------------------------------------------------------
+ *
+ * TclRegisterCommandTypeName, TclGetCommandTypeName --
+ *
+ * Command type registration and lookup mechanism. Everything is keyed by
+ * the Tcl_ObjCmdProc for the command, and that is used as the *key* into
+ * the hash table that maps to constant strings that are names. (It is
+ * recommended that those names be ASCII.)
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclRegisterCommandTypeName(
+ Tcl_ObjCmdProc *implementationProc,
+ const char *nameStr)
+{
+ Tcl_HashEntry *hPtr;
+
+ Tcl_MutexLock(&commandTypeLock);
+ if (commandTypeInit == 0) {
+ Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
+ commandTypeInit = 1;
+ }
+ if (nameStr != NULL) {
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(&commandTypeTable,
+ (void *) implementationProc, &isNew);
+ Tcl_SetHashValue(hPtr, (void *) nameStr);
+ } else {
+ hPtr = Tcl_FindHashEntry(&commandTypeTable,
+ (void *) implementationProc);
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ }
+ Tcl_MutexUnlock(&commandTypeLock);
+}
+
+const char *
+TclGetCommandTypeName(
+ Tcl_Command command)
+{
+ Command *cmdPtr = (Command *) command;
+ void *procPtr = cmdPtr->objProc;
+ const char *name = "native";
+
+ if (procPtr == NULL) {
+ procPtr = cmdPtr->nreProc;
+ }
+ Tcl_MutexLock(&commandTypeLock);
+ if (commandTypeInit) {
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);
+
+ if (hPtr && Tcl_GetHashValue(hPtr)) {
+ name = (const char *) Tcl_GetHashValue(hPtr);
+ }
+ }
+ Tcl_MutexUnlock(&commandTypeLock);
+
+ return name;
+}
+
+/*
*----------------------------------------------------------------------
*
* TclHideUnsafeCommands --
@@ -1017,6 +1216,7 @@ TclHideUnsafeCommands(
Tcl_Interp *interp) /* Hide commands in this interpreter. */
{
register const CmdInfo *cmdInfoPtr;
+ register const UnsafeEnsembleInfo *unsafePtr;
if (interp == NULL) {
return TCL_ERROR;
@@ -1026,12 +1226,83 @@ TclHideUnsafeCommands(
Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
}
}
- TclMakeEncodingCommandSafe(interp); /* Ugh! */
- TclMakeFileCommandSafe(interp); /* Ugh! */
+
+ for (unsafePtr = unsafeEnsembleCommands;
+ unsafePtr->ensembleNsName; unsafePtr++) {
+ if (unsafePtr->commandName) {
+ /*
+ * Hide an ensemble subcommand.
+ */
+
+ Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
+ unsafePtr->ensembleNsName, unsafePtr->commandName);
+ Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
+ unsafePtr->ensembleNsName, unsafePtr->commandName);
+
+ if (TclRenameCommand(interp, TclGetString(cmdName),
+ "___tmp") != TCL_OK
+ || Tcl_HideCommand(interp, "___tmp",
+ TclGetString(hideName)) != TCL_OK) {
+ Tcl_Panic("problem making '%s %s' safe: %s",
+ unsafePtr->ensembleNsName, unsafePtr->commandName,
+ Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+ Tcl_CreateObjCommand(interp, TclGetString(cmdName),
+ BadEnsembleSubcommand, (ClientData) unsafePtr, NULL);
+ TclDecrRefCount(cmdName);
+ TclDecrRefCount(hideName);
+ } else {
+ /*
+ * Hide an ensemble main command (for compatibility).
+ */
+
+ if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
+ unsafePtr->ensembleNsName) != TCL_OK) {
+ Tcl_Panic("problem making '%s' safe: %s",
+ unsafePtr->ensembleNsName,
+ Tcl_GetString(Tcl_GetObjResult(interp)));
+ }
+ }
+ }
+
return TCL_OK;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * BadEnsembleSubcommand --
+ *
+ * Command used to act as a backstop implementation when subcommands of
+ * ensembles are unsafe (the real implementations of the subcommands are
+ * hidden). The clientData is description of what was hidden.
+ *
+ * Results:
+ * A standard Tcl result (always a TCL_ERROR).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BadEnsembleSubcommand(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ const UnsafeEnsembleInfo *infoPtr = clientData;
+
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "not allowed to invoke subcommand %s of %s",
+ infoPtr->commandName, infoPtr->ensembleNsName));
+ Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
+ return TCL_ERROR;
+}
+
+/*
*--------------------------------------------------------------
*
* Tcl_CallWhenDeleted --
@@ -1062,7 +1333,7 @@ Tcl_CallWhenDeleted(
Interp *iPtr = (Interp *) interp;
static Tcl_ThreadDataKey assocDataCounterKey;
int *assocDataCounterPtr =
- Tcl_GetThreadData(&assocDataCounterKey, (int)sizeof(int));
+ Tcl_GetThreadData(&assocDataCounterKey, sizeof(int));
int isNew;
char buffer[32 + TCL_INTEGER_SPACE];
AssocData *dPtr = ckalloc(sizeof(AssocData));
@@ -1534,10 +1805,12 @@ DeleteInterpProc(
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
+#ifndef TCL_NO_DEPRECATED
if (iPtr->appendResult != NULL) {
ckfree(iPtr->appendResult);
iPtr->appendResult = NULL;
}
+#endif
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
@@ -1635,7 +1908,7 @@ DeleteInterpProc(
}
Tcl_DeleteHashTable(iPtr->lineLAPtr);
- ckfree((char *) iPtr->lineLAPtr);
+ ckfree(iPtr->lineLAPtr);
iPtr->lineLAPtr = NULL;
if (iPtr->lineLABCPtr->numEntries && !TclInExit()) {
@@ -2275,30 +2548,33 @@ Tcl_CreateObjCommand(
}
Tcl_Command
-TclCreateObjCommandInNs (
+TclCreateObjCommandInNs(
Tcl_Interp *interp,
- const char *cmdName, /* Name of command, without any namespace components */
+ const char *cmdName, /* Name of command, without any namespace
+ * components. */
Tcl_Namespace *namespace, /* The namespace to create the command in */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
ClientData clientData, /* Arbitrary value to pass to object
* function. */
- Tcl_CmdDeleteProc *deleteProc
+ Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
-) {
+{
int deleted = 0, isNew = 0;
Command *cmdPtr;
ImportRef *oldRefPtr = NULL;
ImportedCmdData *dataPtr;
Tcl_HashEntry *hPtr;
Namespace *nsPtr = (Namespace *) namespace;
+
/*
- * If the command name we seek to create already exists, we need to
- * delete that first. That can be tricky in the presence of traces.
- * Loop until we no longer find an existing command in the way, or
- * until we've deleted one command and that didn't finish the job.
+ * If the command name we seek to create already exists, we need to delete
+ * that first. That can be tricky in the presence of traces. Loop until we
+ * no longer find an existing command in the way, or until we've deleted
+ * one command and that didn't finish the job.
*/
+
while (1) {
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew);
@@ -2310,16 +2586,18 @@ TclCreateObjCommandInNs (
break;
}
+ /*
+ * An existing command conflicts. Try to delete it.
+ */
- /* An existing command conflicts. Try to delete it.. */
cmdPtr = Tcl_GetHashValue(hPtr);
/*
- * [***] This is wrong. See Tcl Bug a16752c252.
- * However, this buggy behavior is kept under particular
- * circumstances to accommodate deployed binaries of the
- * "tclcompiler" program. http://sourceforge.net/projects/tclpro/
- * that crash if the bug is fixed.
+ * [***] This is wrong. See Tcl Bug a16752c252. However, this buggy
+ * behavior is kept under particular circumstances to accommodate
+ * deployed binaries of the "tclcompiler" program
+ * http://sourceforge.net/projects/tclpro/
+ * that crash if the bug is fixed.
*/
if (cmdPtr->objProc == TclInvokeStringCommand
@@ -2343,12 +2621,15 @@ TclCreateObjCommandInNs (
cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
}
- /* Make sure namespace doesn't get deallocated. */
+ /*
+ * Make sure namespace doesn't get deallocated.
+ */
+
cmdPtr->nsPtr->refCount++;
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
nsPtr = (Namespace *) TclEnsureNamespace(interp,
- (Tcl_Namespace *)cmdPtr->nsPtr);
+ (Tcl_Namespace *) cmdPtr->nsPtr);
TclNsDecrRefCount(cmdPtr->nsPtr);
if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
@@ -2360,9 +2641,9 @@ TclCreateObjCommandInNs (
}
if (!isNew) {
/*
- * If the deletion callback recreated the command, just throw away
- * the new command (if we try to delete it again, we could get
- * stuck in an infinite loop).
+ * If the deletion callback recreated the command, just throw away the
+ * new command (if we try to delete it again, we could get stuck in an
+ * infinite loop).
*/
ckfree(Tcl_GetHashValue(hPtr));
@@ -2417,6 +2698,7 @@ TclCreateObjCommandInNs (
cmdPtr->importRefPtr = oldRefPtr;
while (oldRefPtr != NULL) {
Command *refCmdPtr = oldRefPtr->importedCmdPtr;
+
dataPtr = refCmdPtr->objClientData;
dataPtr->realCmdPtr = cmdPtr;
oldRefPtr = oldRefPtr->nextPtr;
@@ -2465,10 +2747,10 @@ TclInvokeStringCommand(
Command *cmdPtr = clientData;
int i, result;
const char **argv =
- TclStackAlloc(interp, (unsigned)(objc + 1) * sizeof(char *));
+ TclStackAlloc(interp, (objc + 1) * sizeof(char *));
for (i = 0; i < objc; i++) {
- argv[i] = Tcl_GetString(objv[i]);
+ argv[i] = TclGetString(objv[i]);
}
argv[objc] = 0;
@@ -2494,7 +2776,7 @@ TclInvokeStringCommand(
* in the Command structure.
*
* Results:
- * A standard Tcl string result value.
+ * A standard Tcl result value.
*
* Side effects:
* Besides those side effects of the called Tcl_ObjCmdProc,
@@ -2514,7 +2796,7 @@ TclInvokeObjectCommand(
Tcl_Obj *objPtr;
int i, length, result;
Tcl_Obj **objv =
- TclStackAlloc(interp, (unsigned)(argc * sizeof(Tcl_Obj *)));
+ TclStackAlloc(interp, (argc * sizeof(Tcl_Obj *)));
for (i = 0; i < argc; i++) {
length = strlen(argv[i]);
@@ -2722,7 +3004,7 @@ TclRenameCommand(
}
Tcl_DStringAppend(&newFullName, newTail, -1);
cmdPtr->refCount++;
- CallCommandTraces(iPtr, cmdPtr, Tcl_GetString(oldFullName),
+ CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName),
Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME);
Tcl_DStringFree(&newFullName);
@@ -3089,13 +3371,6 @@ Tcl_DeleteCommandFromToken(
Tcl_Command importCmd;
/*
- * Bump the command epoch counter. This will invalidate all cached
- * references that point to this command.
- */
-
- cmdPtr->cmdEpoch++;
-
- /*
* The code here is tricky. We can't delete the hash table entry before
* invoking the deletion callback because there are cases where the
* deletion callback needs to invoke the command (e.g. object systems such
@@ -3117,6 +3392,14 @@ Tcl_DeleteCommandFromToken(
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
}
+
+ /*
+ * Bump the command epoch counter. This will invalidate all cached
+ * references that point to this command.
+ */
+
+ cmdPtr->cmdEpoch++;
+
return 0;
}
@@ -3222,6 +3505,13 @@ Tcl_DeleteCommandFromToken(
if (cmdPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(cmdPtr->hPtr);
cmdPtr->hPtr = NULL;
+
+ /*
+ * Bump the command epoch counter. This will invalidate all cached
+ * references that point to this command.
+ */
+
+ cmdPtr->cmdEpoch++;
}
/*
@@ -3468,8 +3758,7 @@ TclCleanupCommand(
register Command *cmdPtr) /* Points to the Command structure to
* be freed. */
{
- cmdPtr->refCount--;
- if (cmdPtr->refCount <= 0) {
+ if (cmdPtr->refCount-- <= 1) {
ckfree(cmdPtr);
}
}
@@ -3496,6 +3785,7 @@ TclCleanupCommand(
*----------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED)
void
Tcl_CreateMathFunc(
Tcl_Interp *interp, /* Interpreter in which function is to be
@@ -3546,7 +3836,7 @@ Tcl_CreateMathFunc(
static int
OldMathFuncProc(
- ClientData clientData, /* Ponter to OldMathFuncData describing the
+ ClientData clientData, /* Pointer to OldMathFuncData describing the
* function being called */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Actual parameter count */
@@ -3578,9 +3868,14 @@ OldMathFuncProc(
valuePtr = objv[j];
result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
#ifdef ACCEPT_NAN
- if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
- d = valuePtr->internalRep.doubleValue;
- result = TCL_OK;
+ if (result != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr
+ = TclFetchIntRep(valuePtr, &tclDoubleType);
+
+ if (irPtr) {
+ d = irPtr->doubleValue;
+ result = TCL_OK;
+ }
}
#endif
if (result != TCL_OK) {
@@ -3591,7 +3886,7 @@ OldMathFuncProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
- TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
+ TclCheckBadOctal(interp, TclGetString(valuePtr));
ckfree(args);
return TCL_ERROR;
}
@@ -3659,7 +3954,7 @@ OldMathFuncProc(
*/
if (funcResult.type == TCL_INT) {
- TclNewLongObj(valuePtr, funcResult.intValue);
+ TclNewIntObj(valuePtr, funcResult.intValue);
} else if (funcResult.type == TCL_WIDE_INT) {
valuePtr = Tcl_NewWideIntObj(funcResult.wideValue);
} else {
@@ -3827,6 +4122,7 @@ Tcl_ListMathFuncs(
return result;
}
+#endif /* !defined(TCL_NO_DEPRECATED) */
/*
*----------------------------------------------------------------------
@@ -4011,7 +4307,7 @@ Tcl_Canceled(
*/
if (iPtr->asyncCancelMsg != NULL) {
- message = Tcl_GetStringFromObj(iPtr->asyncCancelMsg, &length);
+ message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length);
} else {
length = 0;
}
@@ -4110,7 +4406,7 @@ Tcl_CancelEval(
*/
if (resultObjPtr != NULL) {
- result = Tcl_GetStringFromObj(resultObjPtr, &cancelInfo->length);
+ result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length);
cancelInfo->result = ckrealloc(cancelInfo->result,cancelInfo->length);
memcpy(cancelInfo->result, result, (size_t) cancelInfo->length);
TclDecrRefCount(resultObjPtr); /* Discard their result object. */
@@ -4434,7 +4730,9 @@ TclNRRunCallbacks(
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
Interp *iPtr = (Interp *) interp;
+#endif /* !defined(TCL_NO_DEPRECATED) */
NRE_callback *callbackPtr;
Tcl_NRPostProc *procPtr;
@@ -4448,9 +4746,11 @@ TclNRRunCallbacks(
* are for NR function calls, and those are Tcl_Obj based.
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
if (*(iPtr->result) != 0) {
(void) Tcl_GetObjResult(interp);
}
+#endif /* !defined(TCL_NO_DEPRECATED) */
/* This is the trampoline. */
@@ -4624,7 +4924,7 @@ TEOV_Error(
*/
listPtr = Tcl_NewListObj(objc, objv);
- cmdString = Tcl_GetStringFromObj(listPtr, &cmdLen);
+ cmdString = TclGetStringFromObj(listPtr, &cmdLen);
Tcl_LogCommandInfo(interp, cmdString, cmdString, cmdLen);
Tcl_DecrRefCount(listPtr);
}
@@ -4676,7 +4976,7 @@ TEOV_NotFound(
Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
&handlerObjc, &handlerObjv);
newObjc = objc + handlerObjc;
- newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);
+ newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
/*
* Copy command prefix from unknown handler and add on the real command's
@@ -4688,7 +4988,7 @@ TEOV_NotFound(
newObjv[i] = handlerObjv[i];
Tcl_IncrRefCount(newObjv[i]);
}
- memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * (unsigned)objc);
+ memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc);
/*
* Look up and invoke the handler (by recursive call to this function). If
@@ -4768,9 +5068,9 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
- int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ unsigned int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
int length, traceCode = TCL_OK;
- const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+ const char *command = TclGetStringFromObj(commandPtr, &length);
/*
* Call trace functions.
@@ -4822,7 +5122,7 @@ TEOV_RunLeaveTraces(
Command *cmdPtr = data[2];
Tcl_Obj **objv = data[3];
int length;
- const char *command = Tcl_GetStringFromObj(commandPtr, &length);
+ const char *command = TclGetStringFromObj(commandPtr, &length);
if (!(cmdPtr->flags & CMD_IS_DELETED)) {
if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){
@@ -4911,6 +5211,7 @@ Tcl_EvalTokensStandard(
NULL, NULL);
}
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
*----------------------------------------------------------------------
*
@@ -4958,6 +5259,7 @@ Tcl_EvalTokens(
Tcl_ResetResult(interp);
return resPtr;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -5648,8 +5950,7 @@ TclArgumentRelease(
}
cfwPtr = Tcl_GetHashValue(hPtr);
- cfwPtr->refCount--;
- if (cfwPtr->refCount > 0) {
+ if (cfwPtr->refCount-- > 1) {
continue;
}
@@ -5856,7 +6157,7 @@ TclArgumentGet(
* up by the caller. It knows better than us.
*/
- if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
+ if (!TclHasStringRep(obj) || TclListObjIsCanonical(obj)) {
return;
}
@@ -5914,6 +6215,7 @@ TclArgumentGet(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_Eval
int
Tcl_Eval(
@@ -5966,6 +6268,7 @@ Tcl_GlobalEvalObj(
{
return Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6119,7 +6422,7 @@ TclNREvalObjEx(
TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr,
objPtr, NULL);
- ListObjGetElements(listPtr, objc, objv);
+ TclListObjGetElements(NULL, listPtr, &objc, &objv);
return TclNREvalObjv(interp, objc, objv, flags, NULL);
}
@@ -6187,7 +6490,7 @@ TclNREvalObjEx(
Tcl_IncrRefCount(objPtr);
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ script = TclGetStringFromObj(objPtr, &numSrcBytes);
result = Tcl_EvalEx(interp, script, numSrcBytes, flags);
TclDecrRefCount(objPtr);
@@ -6218,7 +6521,7 @@ TEOEx_ByteCodeCallback(
ProcessUnexpectedResult(interp, result);
result = TCL_ERROR;
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
+ script = TclGetStringFromObj(objPtr, &numSrcBytes);
Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
}
@@ -6475,8 +6778,7 @@ Tcl_ExprLongObj(
resultPtr = Tcl_NewBignumObj(&big);
/* FALLTHROUGH */
}
- case TCL_NUMBER_LONG:
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
case TCL_NUMBER_BIG:
result = TclGetLongFromObj(interp, resultPtr, ptr);
break;
@@ -6719,7 +7021,7 @@ Tcl_ExprString(
* An empty string. Just set the interpreter's result to 0.
*/
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
} else {
Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1);
@@ -6766,11 +7068,10 @@ Tcl_AppendObjToErrorInfo(
* pertains. */
Tcl_Obj *objPtr) /* Message to record. */
{
- int length;
- const char *message = TclGetStringFromObj(objPtr, &length);
+ const char *message = TclGetString(objPtr);
Tcl_IncrRefCount(objPtr);
- Tcl_AddObjErrorInfo(interp, message, length);
+ Tcl_AddObjErrorInfo(interp, message, objPtr->length);
Tcl_DecrRefCount(objPtr);
}
@@ -6793,6 +7094,7 @@ Tcl_AppendObjToErrorInfo(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_AddErrorInfo
void
Tcl_AddErrorInfo(
@@ -6802,6 +7104,7 @@ Tcl_AddErrorInfo(
{
Tcl_AddObjErrorInfo(interp, message, -1);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6842,7 +7145,8 @@ Tcl_AddObjErrorInfo(
iPtr->flags |= ERR_LEGACY_COPY;
if (iPtr->errorInfo == NULL) {
- if (iPtr->result[0] != 0) {
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+ if (*(iPtr->result) != 0) {
/*
* The interp's string result is set, apparently by some extension
* making a deprecated direct write to it. That extension may
@@ -6852,9 +7156,9 @@ Tcl_AddObjErrorInfo(
*/
iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
- } else {
+ } else
+#endif /* !defined(TCL_NO_DEPRECATED) */
iPtr->errorInfo = iPtr->objResultPtr;
- }
Tcl_IncrRefCount(iPtr->errorInfo);
if (!iPtr->errorCode) {
Tcl_SetErrorCode(interp, "NONE", NULL);
@@ -6917,7 +7221,7 @@ Tcl_VarEvalVA(
Tcl_DStringAppend(&buf, string, -1);
}
- result = Tcl_Eval(interp, Tcl_DStringValue(&buf));
+ result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0);
Tcl_DStringFree(&buf);
return result;
}
@@ -6974,6 +7278,7 @@ Tcl_VarEval(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_GlobalEval
int
Tcl_GlobalEval(
@@ -6987,10 +7292,11 @@ Tcl_GlobalEval(
savedVarFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = iPtr->rootFramePtr;
- result = Tcl_Eval(interp, command);
+ result = Tcl_EvalEx(interp, command, -1, 0);
iPtr->varFramePtr = savedVarFramePtr;
return result;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -7128,9 +7434,13 @@ ExprCeilFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7164,9 +7474,13 @@ ExprFloorFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7300,9 +7614,13 @@ ExprSqrtFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- Tcl_SetObjResult(interp, objv[1]);
- return TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7343,10 +7661,14 @@ ExprUnaryFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- d = objv[1]->internalRep.doubleValue;
- Tcl_ResetResult(interp);
- code = TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ d = irPtr->doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7403,10 +7725,14 @@ ExprBinaryFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
- d1 = objv[1]->internalRep.doubleValue;
- Tcl_ResetResult(interp);
- code = TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ d1 = irPtr->doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7414,10 +7740,14 @@ ExprBinaryFunc(
}
code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
#ifdef ACCEPT_NAN
- if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
- d2 = objv[2]->internalRep.doubleValue;
- Tcl_ResetResult(interp);
- code = TCL_OK;
+ if (code != TCL_OK) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objv[1], &tclDoubleType);
+
+ if (irPtr) {
+ d2 = irPtr->doubleValue;
+ Tcl_ResetResult(interp);
+ code = TCL_OK;
+ }
}
#endif
if (code != TCL_OK) {
@@ -7448,28 +7778,30 @@ ExprAbsFunc(
return TCL_ERROR;
}
- if (type == TCL_NUMBER_LONG) {
- long l = *((const long *) ptr);
+ if (type == TCL_NUMBER_INT) {
+ Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
- if (l > (long)0) {
+ if (l > (Tcl_WideInt)0) {
goto unChanged;
- } else if (l == (long)0) {
- const char *string = objv[1]->bytes;
- if (string) {
- while (*string != '0') {
- if (*string == '-') {
- Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
+ } else if (l == (Tcl_WideInt)0) {
+ if (TclHasStringRep(objv[1])) {
+ int numBytes;
+ const char *bytes = TclGetStringFromObj(objv[1], &numBytes);
+
+ while (numBytes) {
+ if (*bytes == '-') {
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
return TCL_OK;
}
- string++;
+ bytes++; numBytes--;
}
}
goto unChanged;
- } else if (l == LONG_MIN) {
- TclBNInitBignumFromLong(&big, l);
+ } else if (l == WIDE_MIN) {
+ TclInitBignumFromWideInt(&big, l);
goto tooLarge;
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj(-l));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-l));
return TCL_OK;
}
@@ -7493,24 +7825,8 @@ ExprAbsFunc(
return TCL_OK;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type == TCL_NUMBER_WIDE) {
- Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
-
- if (w >= (Tcl_WideInt)0) {
- goto unChanged;
- }
- if (w == LLONG_MIN) {
- TclBNInitBignumFromWideInt(&big, w);
- goto tooLarge;
- }
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w));
- return TCL_OK;
- }
-#endif
-
if (type == TCL_NUMBER_BIG) {
- if (mp_cmp_d((const mp_int *) ptr, 0) == MP_LT) {
+ if (mp_isneg((const mp_int *) ptr)) {
Tcl_GetBignumFromObj(NULL, objv[1], &big);
tooLarge:
mp_neg(&big, &big);
@@ -7573,7 +7889,7 @@ ExprDoubleFunc(
}
if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (objv[1]->typePtr == &tclDoubleType) {
+ if (TclHasIntRep(objv[1], &tclDoubleType)) {
Tcl_SetObjResult(interp, objv[1]);
return TCL_OK;
}
@@ -7585,7 +7901,7 @@ ExprDoubleFunc(
}
static int
-ExprEntierFunc(
+ExprIntFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
@@ -7606,19 +7922,7 @@ ExprEntierFunc(
if (type == TCL_NUMBER_DOUBLE) {
d = *((const double *) ptr);
- if ((d < (double)LONG_MAX) && (d > (double)LONG_MIN)) {
- long result = (long) d;
-
- Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
- return TCL_OK;
-#ifndef TCL_WIDE_INT_IS_LONG
- } else if ((d < (double)LLONG_MAX) && (d > (double)LLONG_MIN)) {
- Tcl_WideInt result = (Tcl_WideInt) d;
-
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
- return TCL_OK;
-#endif
- } else {
+ if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
mp_int big;
if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
@@ -7627,6 +7931,11 @@ ExprEntierFunc(
}
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
return TCL_OK;
+ } else {
+ Tcl_WideInt result = (Tcl_WideInt) d;
+
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
+ return TCL_OK;
}
}
@@ -7648,71 +7957,89 @@ ExprEntierFunc(
}
static int
-ExprIntFunc(
+ExprWideFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
- long iResult;
- Tcl_Obj *objPtr;
- if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
- return TCL_ERROR;
- }
- objPtr = Tcl_GetObjResult(interp);
- if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
- /*
- * Truncate the bignum; keep only bits in long range.
- */
-
- mp_int big;
+ Tcl_WideInt wResult;
- Tcl_GetBignumFromObj(NULL, objPtr, &big);
- mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
- objPtr = Tcl_NewBignumObj(&big);
- Tcl_IncrRefCount(objPtr);
- TclGetLongFromObj(NULL, objPtr, &iResult);
- Tcl_DecrRefCount(objPtr);
+ if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
+ return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
+ TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
return TCL_OK;
}
+/*
+ * Common implmentation of max() and min().
+ */
static int
-ExprWideFunc(
+ExprMaxMinFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
* function. */
int objc, /* Actual parameter count. */
- Tcl_Obj *const *objv) /* Actual parameter vector. */
+ Tcl_Obj *const *objv, /* Actual parameter vector. */
+ int op) /* Comparison direction */
{
- Tcl_WideInt wResult;
- Tcl_Obj *objPtr;
+ Tcl_Obj *res;
+ double d;
+ int type, i;
+ ClientData ptr;
- if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
+ if (objc < 2) {
+ MathFuncWrongNumArgs(interp, 2, objc, objv);
return TCL_ERROR;
}
- objPtr = Tcl_GetObjResult(interp);
- if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
- /*
- * Truncate the bignum; keep only bits in wide int range.
- */
-
- mp_int big;
+ res = objv[1];
+ for (i = 1; i < objc; i++) {
+ if (TclGetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (type == TCL_NUMBER_NAN) {
+ /*
+ * Get the error message for NaN.
+ */
- Tcl_GetBignumFromObj(NULL, objPtr, &big);
- mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
- objPtr = Tcl_NewBignumObj(&big);
- Tcl_IncrRefCount(objPtr);
- TclGetWideIntFromObj(NULL, objPtr, &wResult);
- Tcl_DecrRefCount(objPtr);
+ Tcl_GetDoubleFromObj(interp, objv[i], &d);
+ return TCL_ERROR;
+ }
+ if (TclCompareTwoNumbers(objv[i], res) == op) {
+ res = objv[i];
+ }
}
- Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
+
+ Tcl_SetObjResult(interp, res);
return TCL_OK;
}
static int
+ExprMaxFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
+{
+ return ExprMaxMinFunc(clientData, interp, objc, objv, MP_GT);
+}
+
+static int
+ExprMinFunc(
+ ClientData clientData, /* Ignored. */
+ Tcl_Interp *interp, /* The interpreter in which to execute the
+ * function. */
+ int objc, /* Actual parameter count. */
+ Tcl_Obj *const *objv) /* Actual parameter vector. */
+{
+ return ExprMaxMinFunc(clientData, interp, objc, objv, MP_LT);
+}
+
+static int
ExprRandFunc(
ClientData clientData, /* Ignored. */
Tcl_Interp *interp, /* The interpreter in which to execute the
@@ -7735,7 +8062,7 @@ ExprRandFunc(
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
- * To ensure different seeds in different threads (bug #416643),
+ * To ensure different seeds in different threads (bug #416643),
* take into consideration the thread this interp is running in.
*/
@@ -7745,7 +8072,7 @@ ExprRandFunc(
* Make sure 1 <= randSeed <= (2^31) - 2. See below.
*/
- iPtr->randSeed &= (unsigned long) 0x7fffffff;
+ iPtr->randSeed &= 0x7fffffff;
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
iPtr->randSeed ^= 123459876;
}
@@ -7828,7 +8155,7 @@ ExprRoundFunc(
if (type == TCL_NUMBER_DOUBLE) {
double fractPart, intPart;
- long max = LONG_MAX, min = LONG_MIN;
+ Tcl_WideInt max = WIDE_MAX, min = WIDE_MIN;
fractPart = modf(*((const double *) ptr), &intPart);
if (fractPart <= -0.5) {
@@ -7851,14 +8178,14 @@ ExprRoundFunc(
Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
return TCL_OK;
} else {
- long result = (long)intPart;
+ Tcl_WideInt result = (Tcl_WideInt)intPart;
if (fractPart <= -0.5) {
result--;
} else if (fractPart >= 0.5) {
result++;
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
}
}
@@ -7889,7 +8216,7 @@ ExprSrandFunc(
Tcl_Obj *const *objv) /* Parameter vector. */
{
Interp *iPtr = (Interp *) interp;
- long i = 0; /* Initialized to avoid compiler warning. */
+ Tcl_WideInt w = 0; /* Initialized to avoid compiler warning. */
/*
* Convert argument and use it to reset the seed.
@@ -7900,20 +8227,8 @@ ExprSrandFunc(
return TCL_ERROR;
}
- if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
- Tcl_Obj *objPtr;
- mp_int big;
-
- if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
- /* TODO: more ::errorInfo here? or in caller? */
- return TCL_ERROR;
- }
-
- mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
- objPtr = Tcl_NewBignumObj(&big);
- Tcl_IncrRefCount(objPtr);
- TclGetLongFromObj(NULL, objPtr, &i);
- Tcl_DecrRefCount(objPtr);
+ if (TclGetWideBitsFromObj(NULL, objv[1], &w) != TCL_OK) {
+ return TCL_ERROR;
}
/*
@@ -7922,8 +8237,7 @@ ExprSrandFunc(
*/
iPtr->flags |= RAND_SEED_INITIALIZED;
- iPtr->randSeed = i;
- iPtr->randSeed &= (unsigned long) 0x7fffffff;
+ iPtr->randSeed = (long) w & 0x7fffffff;
if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
iPtr->randSeed ^= 123459876;
}
@@ -7961,7 +8275,7 @@ MathFuncWrongNumArgs(
int found, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter vector. */
{
- const char *name = Tcl_GetString(objv[0]);
+ const char *name = TclGetString(objv[0]);
const char *tail = name + strlen(name);
while (tail > name+1) {
@@ -8195,23 +8509,26 @@ Tcl_NRCreateCommand(
* this command is deleted. */
{
Command *cmdPtr = (Command *)
- Tcl_CreateObjCommand(interp,cmdName,proc,clientData,deleteProc);
+ Tcl_CreateObjCommand(interp, cmdName, proc, clientData,
+ deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
}
Tcl_Command
-TclNRCreateCommandInNs (
+TclNRCreateCommandInNs(
Tcl_Interp *interp,
const char *cmdName,
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
ClientData clientData,
- Tcl_CmdDeleteProc *deleteProc) {
+ Tcl_CmdDeleteProc *deleteProc)
+{
Command *cmdPtr = (Command *)
- TclCreateObjCommandInNs(interp,cmdName,nsPtr,proc,clientData,deleteProc);
+ TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData,
+ deleteProc);
cmdPtr->nreProc = nreProc;
return (Tcl_Command) cmdPtr;
@@ -8315,7 +8632,6 @@ TclPushTailcallPoint(
TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
((Interp *) interp)->numLevels++;
}
-
/*
*----------------------------------------------------------------------
@@ -8351,7 +8667,6 @@ TclSetTailcall(
}
runPtr->data[1] = listPtr;
}
-
/*
*----------------------------------------------------------------------
@@ -8421,7 +8736,6 @@ TclNRTailcallObjCmd(
}
return TCL_RETURN;
}
-
/*
*----------------------------------------------------------------------
@@ -8489,7 +8803,6 @@ TclNRReleaseValues(
}
return result;
}
-
void
Tcl_NRAddCallback(
@@ -8934,7 +9247,7 @@ TclNRInterpCoroutine(
if (!COR_IS_SUSPENDED(corPtr)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"coroutine \"%s\" is already running",
- Tcl_GetString(objv[0])));
+ TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 2874ea8..ab9262f 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -15,6 +15,7 @@
#include "tommath.h"
#include <math.h>
+#include <assert.h>
/*
* The following constants are used by GetFormatSpec to indicate various
@@ -56,9 +57,12 @@
static void DupByteArrayInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
+static void DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
+ Tcl_Obj *copyPtr);
static int FormatNumber(Tcl_Interp *interp, int type,
Tcl_Obj *src, unsigned char **cursorPtr);
static void FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static void FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
static int GetFormatSpec(const char **formatPtr, char *cmdPtr,
int *countPtr, int *flagsPtr);
static Tcl_Obj * ScanNumber(unsigned char *buffer, int type,
@@ -155,35 +159,108 @@ static const EnsembleImplMap decodeMap[] = {
};
/*
- * The following object type represents an array of bytes. An array of bytes
- * is not equivalent to an internationalized string. Conceptually, a string is
- * an array of 16-bit quantities organized as a sequence of properly formed
- * UTF-8 characters, while a ByteArray is an array of 8-bit quantities.
- * Accessor functions are provided to convert a ByteArray to a String or a
- * String to a ByteArray. Two or more consecutive bytes in an array of bytes
- * may look like a single UTF-8 character if the array is casually treated as
- * a string. But obtaining the String from a ByteArray is guaranteed to
- * produced properly formed UTF-8 sequences so that there is a one-to-one map
- * between bytes and characters.
- *
- * Converting a ByteArray to a String proceeds by casting each byte in the
- * array to a 16-bit quantity, treating that number as a Unicode character,
- * and storing the UTF-8 version of that Unicode character in the String. For
- * ByteArrays consisting entirely of values 1..127, the corresponding String
- * representation is the same as the ByteArray representation.
- *
- * Converting a String to a ByteArray proceeds by getting the Unicode
- * representation of each character in the String, casting it to a byte by
- * truncating the upper 8 bits, and then storing the byte in the ByteArray.
- * Converting from ByteArray to String and back to ByteArray is not lossy, but
- * converting an arbitrary String to a ByteArray may be.
+ * The following object types represent an array of bytes. The intent is
+ * to allow arbitrary binary data to pass through Tcl as a Tcl value
+ * without loss or damage. Such values are useful for things like
+ * encoded strings or Tk images to name just two.
+ *
+ * It's strange to have two Tcl_ObjTypes in place for this task when
+ * one would do, so a bit of detail and history how we got to this point
+ * and where we might go from here.
+ *
+ * A bytearray is an ordered sequence of bytes. Each byte is an integer
+ * value in the range [0-255]. To be a Tcl value type, we need a way to
+ * encode each value in the value set as a Tcl string. The simplest
+ * encoding is to represent each byte value as the same codepoint value.
+ * A bytearray of N bytes is encoded into a Tcl string of N characters
+ * where the codepoint of each character is the value of corresponding byte.
+ * This approach creates a one-to-one map between all bytearray values
+ * and a subset of Tcl string values.
+ *
+ * When converting a Tcl string value to the bytearray internal rep, the
+ * question arises what to do with strings outside that subset? That is,
+ * those Tcl strings containing at least one codepoint greater than 255?
+ * The obviously correct answer is to raise an error! That string value
+ * does not represent any valid bytearray value. Full Stop. The
+ * setFromAnyProc signature has a completion code return value for just
+ * this reason, to reject invalid inputs.
+ *
+ * Unfortunately this was not the path taken by the authors of the
+ * original tclByteArrayType. They chose to accept all Tcl string values
+ * as acceptable string encodings of the bytearray values that result
+ * from masking away the high bits of any codepoint value at all. This
+ * meant that every bytearray value had multiple accepted string
+ * representations.
+ *
+ * The implications of this choice are truly ugly. When a Tcl value has
+ * a string representation, we are required to accept that as the true
+ * value. Bytearray values that possess a string representation cannot
+ * be processed as bytearrays because we cannot know which true value
+ * that bytearray represents. The consequence is that we drag around
+ * an internal rep that we cannot make any use of. This painful price
+ * is extracted at any point after a string rep happens to be generated
+ * for the value. This happens even when the troublesome codepoints
+ * outside the byte range never show up. This happens rather routinely
+ * in normal Tcl operations unless we burden the script writer with the
+ * cognitive burden of avoiding it. The price is also paid by callers
+ * of the C interface. The routine
+ *
+ * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr)
+ *
+ * has a guarantee to always return a non-NULL value, but that value
+ * points to a byte sequence that cannot be used by the caller to
+ * process the Tcl value absent some sideband testing that objPtr
+ * is "pure". Tcl offers no public interface to perform this test,
+ * so callers either break encapsulation or are unavoidably buggy. Tcl
+ * has defined a public interface that cannot be used correctly. The
+ * Tcl source code itself suffers the same problem, and has been buggy,
+ * but progressively less so as more and more portions of the code have
+ * been retrofitted with the required "purity testing". The set of values
+ * able to pass the purity test can be increased via the introduction of
+ * a "canonical" flag marker, but the only way the broken interface itself
+ * can be discarded is to start over and define the Tcl_ObjType properly.
+ * Bytearrays should simply be usable as bytearrays without a kabuki
+ * dance of testing.
+ *
+ * The Tcl_ObjType "properByteArrayType" is (nearly) a correct
+ * implementation of bytearrays. Any Tcl value with the type
+ * properByteArrayType can have its bytearray value fetched and
+ * used with confidence that acting on that value is equivalent to
+ * acting on the true Tcl string value. This still implies a side
+ * testing burden -- past mistakes will not let us avoid that
+ * immediately, but it is at least a conventional test of type, and
+ * can be implemented entirely by examining the objPtr fields, with
+ * no need to query the intrep, as a canonical flag would require.
+ *
+ * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can
+ * be revised to admit the possibility of returning NULL when the true
+ * value is not a valid bytearray, we need a mechanism to retain
+ * compatibility with the deployed callers of the broken interface.
+ * That's what the retained "tclByteArrayType" provides. In those
+ * unusual circumstances where we convert an invalid bytearray value
+ * to a bytearray type, it is to this legacy type. Essentially any
+ * time this legacy type gets used, it's a signal of a bug being ignored.
+ * A TIP should be drafted to remove this connection to the broken past
+ * so that Tcl 9 will no longer have any trace of it. Prescribing a
+ * migration path will be the key element of that work. The internal
+ * changes now in place are the limit of what can be done short of
+ * interface repair. They provide a great expansion of the histories
+ * over which bytearray values can be useful in the meanwhile.
*/
+static const Tcl_ObjType properByteArrayType = {
+ "bytearray",
+ FreeProperByteArrayInternalRep,
+ DupProperByteArrayInternalRep,
+ UpdateStringOfByteArray,
+ NULL
+};
+
const Tcl_ObjType tclByteArrayType = {
"bytearray",
FreeByteArrayInternalRep,
DupByteArrayInternalRep,
- UpdateStringOfByteArray,
+ NULL,
SetByteArrayFromAny
};
@@ -195,9 +272,9 @@ const Tcl_ObjType tclByteArrayType = {
*/
typedef struct ByteArray {
- int used; /* The number of bytes used in the byte
+ unsigned int used; /* The number of bytes used in the byte
* array. */
- int allocated; /* The amount of space actually allocated
+ unsigned int allocated; /* The amount of space actually allocated
* minus 1 byte. */
unsigned char bytes[1]; /* The array of bytes. The actual size of this
* field depends on the 'allocated' field
@@ -206,11 +283,16 @@ typedef struct ByteArray {
#define BYTEARRAY_SIZE(len) \
((unsigned) (TclOffset(ByteArray, bytes) + (len)))
-#define GET_BYTEARRAY(objPtr) \
- ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_BYTEARRAY(objPtr, baPtr) \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
+#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
+#define SET_BYTEARRAY(irPtr, baPtr) \
+ (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
+int
+TclIsPureByteArray(
+ Tcl_Obj * objPtr)
+{
+ return TclHasIntRep(objPtr, &properByteArrayType);
+}
/*
*----------------------------------------------------------------------
@@ -324,11 +406,11 @@ Tcl_SetByteArrayObj(
be >= 0. */
{
ByteArray *byteArrayPtr;
+ Tcl_ObjIntRep ir;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
}
- TclFreeIntRep(objPtr);
TclInvalidateStringRep(objPtr);
if (length < 0) {
@@ -341,8 +423,9 @@ Tcl_SetByteArrayObj(
if ((bytes != NULL) && (length > 0)) {
memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
}
- objPtr->typePtr = &tclByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(&ir, byteArrayPtr);
+
+ Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
}
/*
@@ -370,16 +453,24 @@ Tcl_GetByteArrayFromObj(
* array of bytes in the ByteArray object. */
{
ByteArray *baPtr;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
- if (objPtr->typePtr != &tclByteArrayType) {
- SetByteArrayFromAny(NULL, objPtr);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- baPtr = GET_BYTEARRAY(objPtr);
+ baPtr = GET_BYTEARRAY(irPtr);
if (lengthPtr != NULL) {
*lengthPtr = baPtr->used;
}
- return (unsigned char *) baPtr->bytes;
+ return baPtr->bytes;
}
/*
@@ -410,22 +501,36 @@ Tcl_SetByteArrayLength(
int length) /* New length for internal byte array. */
{
ByteArray *byteArrayPtr;
+ unsigned newLength;
+ Tcl_ObjIntRep *irPtr;
+
+ assert(length >= 0);
+ newLength = (unsigned int)length;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
}
- if (objPtr->typePtr != &tclByteArrayType) {
- SetByteArrayFromAny(NULL, objPtr);
+
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- byteArrayPtr = GET_BYTEARRAY(objPtr);
- if (length > byteArrayPtr->allocated) {
- byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
- byteArrayPtr->allocated = length;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ byteArrayPtr = GET_BYTEARRAY(irPtr);
+ if (newLength > byteArrayPtr->allocated) {
+ byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
+ byteArrayPtr->allocated = newLength;
+ SET_BYTEARRAY(irPtr, byteArrayPtr);
}
TclInvalidateStringRep(objPtr);
- byteArrayPtr->used = length;
+ byteArrayPtr->used = newLength;
return byteArrayPtr->bytes;
}
@@ -450,29 +555,38 @@ SetByteArrayFromAny(
Tcl_Interp *interp, /* Not used. */
Tcl_Obj *objPtr) /* The object to convert to type ByteArray. */
{
- int length;
+ size_t length;
+ int improper = 0;
const char *src, *srcEnd;
unsigned char *dst;
- ByteArray *byteArrayPtr;
Tcl_UniChar ch = 0;
+ ByteArray *byteArrayPtr;
+ Tcl_ObjIntRep ir;
- if (objPtr->typePtr != &tclByteArrayType) {
- src = TclGetStringFromObj(objPtr, &length);
- srcEnd = src + length;
-
- byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
- for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
- src += TclUtfToUniChar(src, &ch);
- *dst++ = UCHAR(ch);
- }
+ if (TclHasIntRep(objPtr, &properByteArrayType)) {
+ return TCL_OK;
+ }
+ if (TclHasIntRep(objPtr, &tclByteArrayType)) {
+ return TCL_OK;
+ }
- byteArrayPtr->used = dst - byteArrayPtr->bytes;
- byteArrayPtr->allocated = length;
+ src = TclGetString(objPtr);
+ length = objPtr->length;
+ srcEnd = src + length;
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &tclByteArrayType;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+ for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+ src += TclUtfToUniChar(src, &ch);
+ improper = improper || (ch > 255);
+ *dst++ = UCHAR(ch);
}
+
+ byteArrayPtr->used = dst - byteArrayPtr->bytes;
+ byteArrayPtr->allocated = length;
+
+ SET_BYTEARRAY(&ir, byteArrayPtr);
+ Tcl_StoreIntRep(objPtr,
+ improper ? &tclByteArrayType : &properByteArrayType, &ir);
return TCL_OK;
}
@@ -497,8 +611,14 @@ static void
FreeByteArrayInternalRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ckfree(GET_BYTEARRAY(objPtr));
- objPtr->typePtr = NULL;
+ ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &tclByteArrayType)));
+}
+
+static void
+FreeProperByteArrayInternalRep(
+ Tcl_Obj *objPtr) /* Object with internal rep to free. */
+{
+ ckfree(GET_BYTEARRAY(TclFetchIntRep(objPtr, &properByteArrayType)));
}
/*
@@ -523,19 +643,41 @@ DupByteArrayInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- int length;
+ unsigned int length;
+ ByteArray *srcArrayPtr, *copyArrayPtr;
+ Tcl_ObjIntRep ir;
+
+ srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &tclByteArrayType));
+ length = srcArrayPtr->used;
+
+ copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+ copyArrayPtr->used = length;
+ copyArrayPtr->allocated = length;
+ memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
+
+ SET_BYTEARRAY(&ir, copyArrayPtr);
+ Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
+}
+
+static void
+DupProperByteArrayInternalRep(
+ Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
+ Tcl_Obj *copyPtr) /* Object with internal rep to set. */
+{
+ unsigned int length;
ByteArray *srcArrayPtr, *copyArrayPtr;
+ Tcl_ObjIntRep ir;
- srcArrayPtr = GET_BYTEARRAY(srcPtr);
+ srcArrayPtr = GET_BYTEARRAY(TclFetchIntRep(srcPtr, &properByteArrayType));
length = srcArrayPtr->used;
copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
copyArrayPtr->used = length;
copyArrayPtr->allocated = length;
memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
- SET_BYTEARRAY(copyPtr, copyArrayPtr);
- copyPtr->typePtr = &tclByteArrayType;
+ SET_BYTEARRAY(&ir, copyArrayPtr);
+ Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
}
/*
@@ -543,9 +685,7 @@ DupByteArrayInternalRep(
*
* UpdateStringOfByteArray --
*
- * Update the string representation for a ByteArray data object. Note:
- * This procedure does not invalidate an existing old string rep so
- * storage will be lost if this has not already been done.
+ * Update the string representation for a ByteArray data object.
*
* Results:
* None.
@@ -554,9 +694,6 @@ DupByteArrayInternalRep(
* The object's string is set to a valid string that results from the
* ByteArray-to-string conversion.
*
- * The object becomes a string object -- the internal rep is discarded
- * and the typePtr becomes NULL.
- *
*----------------------------------------------------------------------
*/
@@ -565,41 +702,35 @@ UpdateStringOfByteArray(
Tcl_Obj *objPtr) /* ByteArray object whose string rep to
* update. */
{
- int i, length, size;
- unsigned char *src;
- char *dst;
- ByteArray *byteArrayPtr;
-
- byteArrayPtr = GET_BYTEARRAY(objPtr);
- src = byteArrayPtr->bytes;
- length = byteArrayPtr->used;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
+ unsigned char *src = byteArrayPtr->bytes;
+ unsigned int i, length = byteArrayPtr->used;
+ unsigned int size = length;
/*
* How much space will string rep need?
*/
- size = length;
- for (i = 0; i < length && size >= 0; i++) {
+ for (i = 0; i < length && size <= INT_MAX; i++) {
if ((src[i] == 0) || (src[i] > 127)) {
size++;
}
}
- if (size < 0) {
+ if (size > INT_MAX) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- dst = ckalloc(size + 1);
- objPtr->bytes = dst;
- objPtr->length = size;
-
if (size == length) {
- memcpy(dst, src, (size_t) size);
- dst[size] = '\0';
+ char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);
+ TclOOM(dst, size);
} else {
+ char *dst = Tcl_InitStringRep(objPtr, NULL, size);
+ TclOOM(dst, size);
for (i = 0; i < length; i++) {
dst += Tcl_UniCharToUtf(src[i], dst);
}
- *dst = '\0';
+ (void)Tcl_InitStringRep(objPtr, NULL, size);
}
}
@@ -629,7 +760,8 @@ TclAppendBytesToByteArray(
int len)
{
ByteArray *byteArrayPtr;
- int needed;
+ unsigned int length, needed;
+ Tcl_ObjIntRep *irPtr;
if (Tcl_IsShared(objPtr)) {
Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -642,23 +774,34 @@ TclAppendBytesToByteArray(
/* Append zero bytes is a no-op. */
return;
}
- if (objPtr->typePtr != &tclByteArrayType) {
- SetByteArrayFromAny(NULL, objPtr);
+
+ length = (unsigned int)len;
+
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ if (irPtr == NULL) {
+ SetByteArrayFromAny(NULL, objPtr);
+ irPtr = TclFetchIntRep(objPtr, &properByteArrayType);
+ if (irPtr == NULL) {
+ irPtr = TclFetchIntRep(objPtr, &tclByteArrayType);
+ }
+ }
}
- byteArrayPtr = GET_BYTEARRAY(objPtr);
+ byteArrayPtr = GET_BYTEARRAY(irPtr);
- if (len > INT_MAX - byteArrayPtr->used) {
+ if (length > INT_MAX - byteArrayPtr->used) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- needed = byteArrayPtr->used + len;
+ needed = byteArrayPtr->used + length;
/*
* If we need to, resize the allocated space in the byte array.
*/
if (needed > byteArrayPtr->allocated) {
ByteArray *ptr = NULL;
- int attempt;
+ unsigned int attempt;
if (needed <= INT_MAX/2) {
/* Try to allocate double the total space that is needed. */
@@ -668,7 +811,7 @@ TclAppendBytesToByteArray(
if (ptr == NULL) {
/* Try to allocate double the increment that is needed (plus). */
unsigned int limit = INT_MAX - needed;
- unsigned int extra = len + TCL_MIN_GROWTH;
+ unsigned int extra = length + TCL_MIN_GROWTH;
int growth = (int) ((extra > limit) ? limit : extra);
attempt = needed + growth;
@@ -681,13 +824,13 @@ TclAppendBytesToByteArray(
}
byteArrayPtr = ptr;
byteArrayPtr->allocated = attempt;
- SET_BYTEARRAY(objPtr, byteArrayPtr);
+ SET_BYTEARRAY(irPtr, byteArrayPtr);
}
if (bytes) {
- memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+ memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length);
}
- byteArrayPtr->used += len;
+ byteArrayPtr->used += length;
TclInvalidateStringRep(objPtr);
}
@@ -1565,7 +1708,7 @@ BinaryScanCmd(
*/
done:
- Tcl_SetObjResult(interp, Tcl_NewLongObj(arg - 3));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(arg - 3));
DeleteScanNumberCache(numberCachePtr);
return TCL_OK;
@@ -1873,7 +2016,6 @@ FormatNumber(
Tcl_Obj *src, /* Number to format. */
unsigned char **cursorPtr) /* Pointer to index into destination buffer. */
{
- long value;
double dvalue;
Tcl_WideInt wvalue;
float fvalue;
@@ -1889,10 +2031,11 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if (src->typePtr != &tclDoubleType) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType);
+ if (irPtr == NULL) {
return TCL_ERROR;
}
- dvalue = src->internalRep.doubleValue;
+ dvalue = irPtr->doubleValue;
}
CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
*cursorPtr += sizeof(double);
@@ -1908,10 +2051,11 @@ FormatNumber(
*/
if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
- if (src->typePtr != &tclDoubleType) {
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType);
+ if (irPtr == NULL) {
return TCL_ERROR;
}
- dvalue = src->internalRep.doubleValue;
+ dvalue = irPtr->doubleValue;
}
/*
@@ -1935,7 +2079,7 @@ FormatNumber(
case 'w':
case 'W':
case 'm':
- if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
@@ -1965,19 +2109,19 @@ FormatNumber(
case 'i':
case 'I':
case 'n':
- if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = UCHAR(value);
- *(*cursorPtr)++ = UCHAR(value >> 8);
- *(*cursorPtr)++ = UCHAR(value >> 16);
- *(*cursorPtr)++ = UCHAR(value >> 24);
+ *(*cursorPtr)++ = UCHAR(wvalue);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 24);
} else {
- *(*cursorPtr)++ = UCHAR(value >> 24);
- *(*cursorPtr)++ = UCHAR(value >> 16);
- *(*cursorPtr)++ = UCHAR(value >> 8);
- *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 24);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
}
return TCL_OK;
@@ -1987,15 +2131,15 @@ FormatNumber(
case 's':
case 'S':
case 't':
- if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
if (NeedReversing(type)) {
- *(*cursorPtr)++ = UCHAR(value);
- *(*cursorPtr)++ = UCHAR(value >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
} else {
- *(*cursorPtr)++ = UCHAR(value >> 8);
- *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+ *(*cursorPtr)++ = UCHAR(wvalue);
}
return TCL_OK;
@@ -2003,10 +2147,10 @@ FormatNumber(
* 8-bit integer values.
*/
case 'c':
- if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+ if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
return TCL_ERROR;
}
- *(*cursorPtr)++ = UCHAR(value);
+ *(*cursorPtr)++ = UCHAR(wvalue);
return TCL_OK;
default:
@@ -2131,7 +2275,7 @@ ScanNumber(
returnNumericObject:
if (*numberCachePtrPtr == NULL) {
- return Tcl_NewLongObj(value);
+ return Tcl_NewWideIntObj(value);
} else {
register Tcl_HashTable *tablePtr = *numberCachePtrPtr;
register Tcl_HashEntry *hPtr;
@@ -2142,7 +2286,7 @@ ScanNumber(
return Tcl_GetHashValue(hPtr);
}
if (tablePtr->numEntries <= BINARY_SCAN_MAX_CACHE) {
- register Tcl_Obj *objPtr = Tcl_NewLongObj(value);
+ register Tcl_Obj *objPtr = Tcl_NewWideIntObj(value);
Tcl_IncrRefCount(objPtr);
Tcl_SetHashValue(hPtr, objPtr);
@@ -2160,7 +2304,7 @@ ScanNumber(
DeleteScanNumberCache(tablePtr);
*numberCachePtrPtr = NULL;
- return Tcl_NewLongObj(value);
+ return Tcl_NewWideIntObj(value);
}
/*
@@ -2194,7 +2338,7 @@ ScanNumber(
Tcl_Obj *bigObj = NULL;
mp_int big;
- TclBNInitBignumFromWideUInt(&big, uwvalue);
+ TclInitBignumFromWideUInt(&big, uwvalue);
bigObj = Tcl_NewBignumObj(&big);
return bigObj;
}
@@ -2394,7 +2538,7 @@ BinaryDecodeHex(
}
c = *data++;
- if (!isxdigit((int) c)) {
+ if (!isxdigit(UCHAR(c))) {
if (strict || !TclIsSpaceProc(c)) {
goto badChar;
}
@@ -2508,7 +2652,7 @@ BinaryEncode64(
}
break;
case OPT_WRAPCHAR:
- wrapchar = Tcl_GetStringFromObj(objv[i+1], &wrapcharlen);
+ wrapchar = TclGetStringFromObj(objv[i+1], &wrapcharlen);
if (wrapcharlen == 0) {
maxlen = 0;
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 70e64f0..e3fb98e 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -34,14 +34,14 @@
*/
typedef struct MemTag {
- int refCount; /* Number of mem_headers referencing this
+ size_t refCount; /* Number of mem_headers referencing this
* tag. */
char string[1]; /* Actual size of string will be as large as
* needed for actual tag. This must be the
* last field in the structure. */
} MemTag;
-#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString))
+#define TAG_SIZE(bytesInString) ((TclOffset(MemTag, string) + 1) + bytesInString)
static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* by "memory tag" command). */
@@ -52,14 +52,14 @@ static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set
* to help detect chunk under-runs.
*/
-#define LOW_GUARD_SIZE (8 + (32 - (sizeof(long) + sizeof(int)))%8)
+#define LOW_GUARD_SIZE (8 + (32 - (sizeof(size_t) + sizeof(int)))%8)
struct mem_header {
struct mem_header *flink;
struct mem_header *blink;
MemTag *tagPtr; /* Tag from "memory tag" command; may be
* NULL. */
const char *file;
- long length;
+ size_t length;
int line;
unsigned char low_guard[LOW_GUARD_SIZE];
/* Aligns body on 8-byte boundary, plus
@@ -89,14 +89,14 @@ static struct mem_header *allocHead = NULL; /* List of allocated structures */
#define BODY_OFFSET \
((size_t) (&((struct mem_header *) 0)->body))
-static int total_mallocs = 0;
-static int total_frees = 0;
+static unsigned int total_mallocs = 0;
+static unsigned int total_frees = 0;
static size_t current_bytes_malloced = 0;
static size_t maximum_bytes_malloced = 0;
-static int current_malloc_packets = 0;
-static int maximum_malloc_packets = 0;
-static int break_on_malloc = 0;
-static int trace_on_at_malloc = 0;
+static unsigned int current_malloc_packets = 0;
+static unsigned int maximum_malloc_packets = 0;
+static unsigned int break_on_malloc = 0;
+static unsigned int trace_on_at_malloc = 0;
static int alloc_tracing = FALSE;
static int init_malloced_bodies = TRUE;
#ifdef MEM_VALIDATE
@@ -156,7 +156,7 @@ TclInitDbCkalloc(void)
if (!ckallocInit) {
ckallocInit = 1;
ckallocMutexPtr = Tcl_GetAllocMutex();
-#ifndef TCL_THREADS
+#if !TCL_THREADS
/* Silence compiler warning */
(void)ckallocMutexPtr;
#endif
@@ -184,18 +184,18 @@ TclDumpMemoryInfo(
return 0;
}
sprintf(buf,
- "total mallocs %10d\n"
- "total frees %10d\n"
- "current packets allocated %10d\n"
- "current bytes allocated %10lu\n"
- "maximum packets allocated %10d\n"
- "maximum bytes allocated %10lu\n",
+ "total mallocs %10u\n"
+ "total frees %10u\n"
+ "current packets allocated %10u\n"
+ "current bytes allocated %10" TCL_Z_MODIFIER "u\n"
+ "maximum packets allocated %10u\n"
+ "maximum bytes allocated %10" TCL_Z_MODIFIER "u\n",
total_mallocs,
total_frees,
current_malloc_packets,
- (unsigned long)current_bytes_malloced,
+ current_bytes_malloced,
maximum_malloc_packets,
- (unsigned long)maximum_bytes_malloced);
+ maximum_bytes_malloced);
if (flags == 0) {
fprintf((FILE *)clientData, "%s", buf);
} else {
@@ -251,10 +251,10 @@ ValidateMemory(
}
if (guard_failed) {
TclDumpMemoryInfo((ClientData) stderr, 0);
- fprintf(stderr, "low guard failed at %lx, %s %d\n",
- (long unsigned) memHeaderP->body, file, line);
+ fprintf(stderr, "low guard failed at %p, %s %d\n",
+ memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
- fprintf(stderr, "%ld bytes allocated at (%s %d)\n", memHeaderP->length,
+ fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n", memHeaderP->length,
memHeaderP->file, memHeaderP->line);
Tcl_Panic("Memory validation failure");
}
@@ -273,10 +273,10 @@ ValidateMemory(
if (guard_failed) {
TclDumpMemoryInfo((ClientData) stderr, 0);
- fprintf(stderr, "high guard failed at %lx, %s %d\n",
- (long unsigned) memHeaderP->body, file, line);
+ fprintf(stderr, "high guard failed at %p, %s %d\n",
+ memHeaderP->body, file, line);
fflush(stderr); /* In case name pointer is bad. */
- fprintf(stderr, "%ld bytes allocated at (%s %d)\n",
+ fprintf(stderr, "%" TCL_Z_MODIFIER "u bytes allocated at (%s %d)\n",
memHeaderP->length, memHeaderP->file,
memHeaderP->line);
Tcl_Panic("Memory validation failure");
@@ -359,9 +359,8 @@ Tcl_DumpActiveMemory(
Tcl_MutexLock(ckallocMutexPtr);
for (memScanP = allocHead; memScanP != NULL; memScanP = memScanP->flink) {
address = &memScanP->body[0];
- fprintf(fileP, "%8lx - %8lx %7ld @ %s %d %s",
- (long unsigned) address,
- (long unsigned) address + memScanP->length - 1,
+ fprintf(fileP, "%p - %p %" TCL_Z_MODIFIER "u @ %s %d %s",
+ address, address + memScanP->length - 1,
memScanP->length, memScanP->file, memScanP->line,
(memScanP->tagPtr == NULL) ? "" : memScanP->tagPtr->string);
(void) fputc('\n', fileP);
@@ -450,7 +449,7 @@ Tcl_DbCkalloc(
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",
+ fprintf(stderr, "reached malloc trace enable point (%u)\n",
total_mallocs);
fflush(stderr);
alloc_tracing = TRUE;
@@ -458,14 +457,14 @@ Tcl_DbCkalloc(
}
if (alloc_tracing) {
- fprintf(stderr,"ckalloc %lx %u %s %d\n",
- (long unsigned int) result->body, size, file, line);
+ fprintf(stderr,"ckalloc %p %u %s %d\n",
+ result->body, size, file, line);
}
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
break_on_malloc = 0;
(void) fflush(stdout);
- Tcl_Panic("reached malloc break limit (%d)", total_mallocs);
+ Tcl_Panic("reached malloc break limit (%u)", total_mallocs);
}
current_malloc_packets++;
@@ -547,8 +546,8 @@ Tcl_AttemptDbCkalloc(
}
if (alloc_tracing) {
- fprintf(stderr,"ckalloc %lx %u %s %d\n",
- (long unsigned int) result->body, size, file, line);
+ fprintf(stderr,"ckalloc %p %u %s %d\n",
+ result->body, size, file, line);
}
if (break_on_malloc && (total_mallocs >= break_on_malloc)) {
@@ -612,8 +611,8 @@ Tcl_DbCkfree(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
if (alloc_tracing) {
- fprintf(stderr, "ckfree %lx %ld %s %d\n",
- (long unsigned int) memp->body, memp->length, file, line);
+ fprintf(stderr, "ckfree %p %" TCL_Z_MODIFIER "u %s %d\n",
+ memp->body, memp->length, file, line);
}
if (validate_memory) {
@@ -623,7 +622,7 @@ Tcl_DbCkfree(
Tcl_MutexLock(ckallocMutexPtr);
ValidateMemory(memp, file, line, TRUE);
if (init_malloced_bodies) {
- memset(ptr, GUARD_VALUE, (size_t) memp->length);
+ memset(ptr, GUARD_VALUE, memp->length);
}
total_frees++;
@@ -631,8 +630,7 @@ Tcl_DbCkfree(
current_bytes_malloced -= memp->length;
if (memp->tagPtr != NULL) {
- memp->tagPtr->refCount--;
- if ((memp->tagPtr->refCount == 0) && (curTagPtr != memp->tagPtr)) {
+ if ((memp->tagPtr->refCount-- <= 1) && (curTagPtr != memp->tagPtr)) {
TclpFree((char *) memp->tagPtr);
}
}
@@ -675,7 +673,7 @@ Tcl_DbCkrealloc(
int line)
{
char *newPtr;
- unsigned int copySize;
+ size_t copySize;
struct mem_header *memp;
if (ptr == NULL) {
@@ -689,7 +687,7 @@ Tcl_DbCkrealloc(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
- if (copySize > (unsigned int) memp->length) {
+ if (copySize > memp->length) {
copySize = memp->length;
}
newPtr = Tcl_DbCkalloc(size, file, line);
@@ -706,7 +704,7 @@ Tcl_AttemptDbCkrealloc(
int line)
{
char *newPtr;
- unsigned int copySize;
+ size_t copySize;
struct mem_header *memp;
if (ptr == NULL) {
@@ -720,7 +718,7 @@ Tcl_AttemptDbCkrealloc(
memp = (struct mem_header *) (((size_t) ptr) - BODY_OFFSET);
copySize = size;
- if (copySize > (unsigned int) memp->length) {
+ if (copySize > memp->length) {
copySize = memp->length;
}
newPtr = Tcl_AttemptDbCkalloc(size, file, line);
@@ -849,22 +847,24 @@ MemoryCmd(
return TCL_OK;
}
if (strcmp(argv[1],"break_on_malloc") == 0) {
+ int value;
if (argc != 3) {
goto argError;
}
- if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
return TCL_ERROR;
}
+ break_on_malloc = (unsigned int) value;
return TCL_OK;
}
if (strcmp(argv[1],"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
+ "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
- "current bytes allocated", (unsigned long)current_bytes_malloced,
+ "current bytes allocated", current_bytes_malloced,
"maximum packets allocated", maximum_malloc_packets,
- "maximum bytes allocated", (unsigned long)maximum_bytes_malloced));
+ "maximum bytes allocated", maximum_bytes_malloced));
return TCL_OK;
}
if (strcmp(argv[1], "init") == 0) {
@@ -935,12 +935,14 @@ MemoryCmd(
}
if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
+ int value;
if (argc != 3) {
goto argError;
}
- if (Tcl_GetInt(interp, argv[2], &trace_on_at_malloc) != TCL_OK) {
+ if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
return TCL_ERROR;
}
+ trace_on_at_malloc = value;
return TCL_OK;
}
if (strcmp(argv[1],"validate") == 0) {
diff --git a/generic/tclClock.c b/generic/tclClock.c
index bbfc83b..233ddd2 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -452,7 +452,7 @@ ClockGetdatefieldsObjCmd(
* that it isn't.
*/
- if (objv[1]->typePtr == &tclBignumType) {
+ if (TclHasIntRep(objv[1], &tclBignumType)) {
Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
return TCL_ERROR;
}
@@ -488,27 +488,27 @@ ClockGetdatefieldsObjCmd(
Tcl_DictObjPut(NULL, dict, literals[LIT_TZNAME], fields.tzName);
Tcl_DecrRefCount(fields.tzName);
Tcl_DictObjPut(NULL, dict, literals[LIT_TZOFFSET],
- Tcl_NewIntObj(fields.tzOffset));
+ Tcl_NewWideIntObj(fields.tzOffset));
Tcl_DictObjPut(NULL, dict, literals[LIT_JULIANDAY],
- Tcl_NewIntObj(fields.julianDay));
+ Tcl_NewWideIntObj(fields.julianDay));
Tcl_DictObjPut(NULL, dict, literals[LIT_GREGORIAN],
- Tcl_NewIntObj(fields.gregorian));
+ Tcl_NewWideIntObj(fields.gregorian));
Tcl_DictObjPut(NULL, dict, literals[LIT_ERA],
literals[fields.era ? LIT_BCE : LIT_CE]);
Tcl_DictObjPut(NULL, dict, literals[LIT_YEAR],
- Tcl_NewIntObj(fields.year));
+ Tcl_NewWideIntObj(fields.year));
Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFYEAR],
- Tcl_NewIntObj(fields.dayOfYear));
+ Tcl_NewWideIntObj(fields.dayOfYear));
Tcl_DictObjPut(NULL, dict, literals[LIT_MONTH],
- Tcl_NewIntObj(fields.month));
+ Tcl_NewWideIntObj(fields.month));
Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFMONTH],
- Tcl_NewIntObj(fields.dayOfMonth));
+ Tcl_NewWideIntObj(fields.dayOfMonth));
Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601YEAR],
- Tcl_NewIntObj(fields.iso8601Year));
+ Tcl_NewWideIntObj(fields.iso8601Year));
Tcl_DictObjPut(NULL, dict, literals[LIT_ISO8601WEEK],
- Tcl_NewIntObj(fields.iso8601Week));
+ Tcl_NewWideIntObj(fields.iso8601Week));
Tcl_DictObjPut(NULL, dict, literals[LIT_DAYOFWEEK],
- Tcl_NewIntObj(fields.dayOfWeek));
+ Tcl_NewWideIntObj(fields.dayOfWeek));
Tcl_SetObjResult(interp, dict);
return TCL_OK;
@@ -628,7 +628,7 @@ ClockGetjuliandayfromerayearmonthdayObjCmd(
copied = 1;
}
status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
- Tcl_NewIntObj(fields.julianDay));
+ Tcl_NewWideIntObj(fields.julianDay));
if (status == TCL_OK) {
Tcl_SetObjResult(interp, dict);
}
@@ -712,7 +712,7 @@ ClockGetjuliandayfromerayearweekdayObjCmd(
copied = 1;
}
status = Tcl_DictObjPut(interp, dict, literals[LIT_JULIANDAY],
- Tcl_NewIntObj(fields.julianDay));
+ Tcl_NewWideIntObj(fields.julianDay));
if (status == TCL_OK) {
Tcl_SetObjResult(interp, dict);
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index e6f1cd5..331f791 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -46,9 +46,6 @@ struct ForeachState {
static int CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
int mode);
-static int BadEncodingSubcommand(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
static int EncodingConvertfromObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -84,7 +81,6 @@ static Tcl_NRPostProc ForPostNextCallback;
static Tcl_NRPostProc ForeachLoopStep;
static Tcl_NRPostProc EvalCmdErrMsg;
-static Tcl_ObjCmdProc BadFileSubcommand;
static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
@@ -164,7 +160,7 @@ Tcl_BreakObjCmd(
*
*----------------------------------------------------------------------
*/
-
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/* ARGSUSED */
int
Tcl_CaseObjCmd(
@@ -282,6 +278,7 @@ Tcl_CaseObjCmd(
return TCL_OK;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -385,7 +382,7 @@ CatchObjCmdCallback(
}
Tcl_ResetResult(interp);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
return TCL_OK;
}
@@ -535,9 +532,9 @@ TclInitEncodingCmd(
static const EnsembleImplMap encodingImplMap[] = {
{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"convertto", EncodingConverttoObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"dirs", EncodingDirsObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{"names", EncodingNamesObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
- {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+ {"system", EncodingSystemObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -545,113 +542,6 @@ TclInitEncodingCmd(
}
/*
- *-----------------------------------------------------------------------------
- *
- * TclMakeEncodingCommandSafe --
- *
- * This function hides the unsafe 'dirs' and 'system' subcommands of
- * the "encoding" Tcl command ensemble. It must be called only from
- * TclHideUnsafeCommands.
- *
- * Results:
- * A standard Tcl result
- *
- * Side effects:
- * Adds commands to the table of hidden commands.
- *
- *-----------------------------------------------------------------------------
- */
-
-int
-TclMakeEncodingCommandSafe(
- Tcl_Interp* interp) /* Tcl interpreter */
-{
- static const struct {
- const char *cmdName;
- int unsafe;
- } unsafeInfo[] = {
- {"convertfrom", 0},
- {"convertto", 0},
- {"dirs", 1},
- {"names", 0},
- {"system", 0},
- {NULL, 0}
- };
-
- int i;
- Tcl_DString oldBuf, newBuf;
-
- Tcl_DStringInit(&oldBuf);
- TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
- Tcl_DStringInit(&newBuf);
- TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
- for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
- if (unsafeInfo[i].unsafe) {
- const char *oldName, *newName;
-
- Tcl_DStringSetLength(&oldBuf, 17);
- oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
- Tcl_DStringSetLength(&newBuf, 13);
- newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
- if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
- || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
- Tcl_Panic("problem making 'encoding %s' safe: %s",
- unsafeInfo[i].cmdName,
- Tcl_GetString(Tcl_GetObjResult(interp)));
- }
- Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
- (ClientData) unsafeInfo[i].cmdName, NULL);
- }
- }
- Tcl_DStringFree(&oldBuf);
- Tcl_DStringFree(&newBuf);
-
- /*
- * Ugh. The [encoding] command is now actually safe, but it is assumed by
- * scripts that it is not, which messes up security policies.
- */
-
- if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
- Tcl_Panic("problem making 'encoding' safe: %s",
- Tcl_GetString(Tcl_GetObjResult(interp)));
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BadEncodingSubcommand --
- *
- * Command used to act as a backstop implementation when subcommands of
- * "encoding" are unsafe (the real implementations of the subcommands are
- * hidden). The clientData is always the full official subcommand name.
- *
- * Results:
- * A standard Tcl result (always a TCL_ERROR).
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BadEncodingSubcommand(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- const char *subcommandName = (const char *) clientData;
-
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "not allowed to invoke subcommand %s of encoding", subcommandName));
- Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
- return TCL_ERROR;
-}
-
-/*
*----------------------------------------------------------------------
*
* EncodingConvertfromObjCmd --
@@ -1173,40 +1063,40 @@ TclInitFileCmd(
*/
static const EnsembleImplMap initMap[] = {
- {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 0},
+ {"atime", FileAttrAccessTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
+ {"attributes", TclFileAttrsCmd, NULL, NULL, NULL, 1},
{"channels", TclChannelNamesCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
- {"copy", TclFileCopyCmd, NULL, NULL, NULL, 0},
- {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
- {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"copy", TclFileCopyCmd, NULL, NULL, NULL, 1},
+ {"delete", TclFileDeleteCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
+ {"dirname", PathDirNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"executable", FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"exists", FileAttrIsExistingCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"extension", PathExtensionCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"isdirectory", FileAttrIsDirectoryCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"isfile", FileAttrIsFileCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"join", PathJoinCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
- {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
- {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
- {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
- {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
- {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"link", TclFileLinkCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
+ {"lstat", FileAttrLinkStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1},
+ {"mtime", FileAttrModifyTimeCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
+ {"mkdir", TclFileMakeDirsCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
+ {"nativename", PathNativeNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"normalize", PathNormalizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"owned", FileAttrIsOwnedCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"pathtype", PathTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"rename", TclFileRenameCmd, NULL, NULL, NULL, 0},
- {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"readable", FileAttrIsReadableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"readlink", TclFileReadLinkCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"rename", TclFileRenameCmd, NULL, NULL, NULL, 1},
+ {"rootname", PathRootNameCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"separator", FilesystemSeparatorCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
- {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"size", FileAttrSizeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"split", PathSplitCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"stat", FileAttrStatCmd, TclCompileBasic2ArgCmd, NULL, NULL, 1},
{"system", PathFilesystemCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
- {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
- {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
- {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"tail", PathTailCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"tempfile", TclFileTemporaryCmd, TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
+ {"type", FileAttrTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+ {"volumes", FilesystemVolumesCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
+ {"writable", FileAttrIsWritableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{NULL, NULL, NULL, NULL, NULL, 0}
};
return TclMakeEnsemble(interp, "file", initMap);
@@ -1215,141 +1105,6 @@ TclInitFileCmd(
/*
*----------------------------------------------------------------------
*
- * TclMakeFileCommandSafe --
- *
- * This function hides the unsafe subcommands of the "file" Tcl command
- * ensemble. It must only be called from TclHideUnsafeCommands.
- *
- * Results:
- * A standard Tcl result.
- *
- * Side effects:
- * Adds commands to the table of hidden commands.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclMakeFileCommandSafe(
- Tcl_Interp *interp)
-{
- static const struct {
- const char *cmdName;
- int unsafe;
- } unsafeInfo[] = {
- {"atime", 1},
- {"attributes", 1},
- {"channels", 0},
- {"copy", 1},
- {"delete", 1},
- {"dirname", 1},
- {"executable", 1},
- {"exists", 1},
- {"extension", 1},
- {"isdirectory", 1},
- {"isfile", 1},
- {"join", 0},
- {"link", 1},
- {"lstat", 1},
- {"mtime", 1},
- {"mkdir", 1},
- {"nativename", 1},
- {"normalize", 1},
- {"owned", 1},
- {"pathtype", 0},
- {"readable", 1},
- {"readlink", 1},
- {"rename", 1},
- {"rootname", 1},
- {"separator", 0},
- {"size", 1},
- {"split", 0},
- {"stat", 1},
- {"system", 0},
- {"tail", 1},
- {"tempfile", 1},
- {"type", 1},
- {"volumes", 1},
- {"writable", 1},
- {NULL, 0}
- };
- int i;
- Tcl_DString oldBuf, newBuf;
-
- Tcl_DStringInit(&oldBuf);
- TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
- Tcl_DStringInit(&newBuf);
- TclDStringAppendLiteral(&newBuf, "tcl:file:");
- for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
- if (unsafeInfo[i].unsafe) {
- const char *oldName, *newName;
-
- Tcl_DStringSetLength(&oldBuf, 13);
- oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
- Tcl_DStringSetLength(&newBuf, 9);
- newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
- if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
- || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
- Tcl_Panic("problem making 'file %s' safe: %s",
- unsafeInfo[i].cmdName,
- Tcl_GetString(Tcl_GetObjResult(interp)));
- }
- Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
- (ClientData) unsafeInfo[i].cmdName, NULL);
- }
- }
- Tcl_DStringFree(&oldBuf);
- Tcl_DStringFree(&newBuf);
-
- /*
- * Ugh. The [file] command is now actually safe, but it is assumed by
- * scripts that it is not, which messes up security policies. [Bug
- * 3211758]
- */
-
- if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
- Tcl_Panic("problem making 'file' safe: %s",
- Tcl_GetString(Tcl_GetObjResult(interp)));
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BadFileSubcommand --
- *
- * Command used to act as a backstop implementation when subcommands of
- * "file" are unsafe (the real implementations of the subcommands are
- * hidden). The clientData is always the full official subcommand name.
- *
- * Results:
- * A standard Tcl result (always a TCL_ERROR).
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BadFileSubcommand(
- ClientData clientData,
- Tcl_Interp *interp,
- int objc,
- Tcl_Obj *const objv[])
-{
- const char *subcommandName = (const char *) clientData;
-
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "not allowed to invoke subcommand %s of file", subcommandName));
- Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* FileAttrAccessTimeCmd --
*
* This function is invoked to process the "file atime" Tcl command. See
@@ -1397,9 +1152,9 @@ FileAttrAccessTimeCmd(
* platforms. [Bug 698146]
*/
- long newTime;
+ Tcl_WideInt newTime;
- if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
+ if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
return TCL_ERROR;
}
@@ -1424,7 +1179,7 @@ FileAttrAccessTimeCmd(
}
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_atime));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((long) buf.st_atime));
return TCL_OK;
}
@@ -1478,9 +1233,9 @@ FileAttrModifyTimeCmd(
* platforms. [Bug 698146]
*/
- long newTime;
+ Tcl_WideInt newTime;
- if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
+ if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
return TCL_ERROR;
}
@@ -1504,7 +1259,7 @@ FileAttrModifyTimeCmd(
}
}
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long) buf.st_mtime));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj((long) buf.st_mtime));
return TCL_OK;
}
@@ -2523,23 +2278,23 @@ StoreStatData(
* cast might fail when there isn't a real arithmetic 'long long' type...
*/
- STORE_ARY("dev", Tcl_NewLongObj((long)statPtr->st_dev));
+ STORE_ARY("dev", Tcl_NewWideIntObj((long)statPtr->st_dev));
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("nlink", Tcl_NewWideIntObj((long)statPtr->st_nlink));
+ STORE_ARY("uid", Tcl_NewWideIntObj((long)statPtr->st_uid));
+ STORE_ARY("gid", Tcl_NewWideIntObj((long)statPtr->st_gid));
STORE_ARY("size", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
#ifdef HAVE_STRUCT_STAT_ST_BLOCKS
STORE_ARY("blocks", Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
#endif
#ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
- STORE_ARY("blksize", Tcl_NewLongObj((long)statPtr->st_blksize));
+ STORE_ARY("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
#endif
- STORE_ARY("atime", Tcl_NewLongObj((long)statPtr->st_atime));
- STORE_ARY("mtime", Tcl_NewLongObj((long)statPtr->st_mtime));
- STORE_ARY("ctime", Tcl_NewLongObj((long)statPtr->st_ctime));
+ STORE_ARY("atime", Tcl_NewWideIntObj((long)statPtr->st_atime));
+ STORE_ARY("mtime", Tcl_NewWideIntObj((long)statPtr->st_mtime));
+ STORE_ARY("ctime", Tcl_NewWideIntObj((long)statPtr->st_ctime));
mode = (unsigned short) statPtr->st_mode;
- STORE_ARY("mode", Tcl_NewIntObj(mode));
+ STORE_ARY("mode", Tcl_NewWideIntObj(mode));
STORE_ARY("type", Tcl_NewStringObj(GetTypeFromMode(mode), -1));
#undef STORE_ARY
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 10fbd3f..a1a7f3e 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -138,6 +138,8 @@ static int InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
+static int InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const objv[]);
static int InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static SortElement * MergeLists(SortElement *leftPtr, SortElement *rightPtr,
@@ -156,6 +158,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
{"args", InfoArgsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"body", InfoBodyCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"cmdcount", InfoCmdCountCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"cmdtype", InfoCmdTypeCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
{"commands", InfoCommandsCmd, TclCompileInfoCommandsCmd, NULL, NULL, 0},
{"complete", InfoCompleteCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"coroutine", TclInfoCoroutineCmd, TclCompileInfoCoroutineCmd, NULL, NULL, 0},
@@ -170,7 +173,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
{"library", InfoLibraryCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"loaded", InfoLoadedCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"locals", TclInfoLocalsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
- {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+ {"nameofexecutable", InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
{"patchlevel", InfoPatchLevelCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
{"procs", InfoProcsCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
{"script", InfoScriptCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
@@ -401,7 +404,7 @@ Tcl_IncrObjCmd(
if (objc == 3) {
incrPtr = objv[2];
} else {
- incrPtr = Tcl_NewIntObj(1);
+ incrPtr = Tcl_NewWideIntObj(1);
}
Tcl_IncrRefCount(incrPtr);
newValuePtr = TclIncrObjVar2(interp, objv[1], NULL,
@@ -536,9 +539,9 @@ InfoBodyCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
register Interp *iPtr = (Interp *) interp;
- const char *name;
+ const char *name, *bytes;
Proc *procPtr;
- Tcl_Obj *bodyPtr, *resultPtr;
+ int numBytes;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "procname");
@@ -563,18 +566,8 @@ InfoBodyCmd(
* the object do not invalidate the internal rep.
*/
- bodyPtr = procPtr->bodyPtr;
- if (bodyPtr->bytes == NULL) {
- /*
- * The string rep might not be valid if the procedure has never been
- * run before. [Bug #545644]
- */
-
- TclGetString(bodyPtr);
- }
- resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-
- Tcl_SetObjResult(interp, resultPtr);
+ bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
return TCL_OK;
}
@@ -613,7 +606,7 @@ InfoCmdCountCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->cmdCount));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->cmdCount));
return TCL_OK;
}
@@ -995,7 +988,7 @@ InfoDefaultCmd(
if (valueObjPtr == NULL) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
} else {
Tcl_Obj *nullObjPtr = Tcl_NewObj();
@@ -1004,7 +997,7 @@ InfoDefaultCmd(
if (valueObjPtr == NULL) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
}
return TCL_OK;
}
@@ -1178,7 +1171,7 @@ InfoFrameCmd(
* Just "info frame".
*/
- Tcl_SetObjResult(interp, Tcl_NewIntObj(topLevel));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(topLevel));
goto done;
}
@@ -1300,9 +1293,9 @@ TclInfoFrame(
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
if (framePtr->line) {
- ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0]));
} else {
- ADD_PAIR("line", Tcl_NewIntObj(1));
+ ADD_PAIR("line", Tcl_NewWideIntObj(1));
}
ADD_PAIR("cmd", TclGetSourceFromFrame(framePtr, 0, NULL));
break;
@@ -1339,7 +1332,7 @@ TclInfoFrame(
ADD_PAIR("type", Tcl_NewStringObj(typeString[fPtr->type], -1));
if (fPtr->line) {
- ADD_PAIR("line", Tcl_NewIntObj(fPtr->line[0]));
+ ADD_PAIR("line", Tcl_NewWideIntObj(fPtr->line[0]));
}
if (fPtr->type == TCL_LOCATION_SOURCE) {
@@ -1366,7 +1359,7 @@ TclInfoFrame(
*/
ADD_PAIR("type", Tcl_NewStringObj(typeString[framePtr->type], -1));
- ADD_PAIR("line", Tcl_NewIntObj(framePtr->line[0]));
+ ADD_PAIR("line", Tcl_NewWideIntObj(framePtr->line[0]));
ADD_PAIR("file", framePtr->data.eval.path);
/*
@@ -1437,7 +1430,7 @@ TclInfoFrame(
int c = framePtr->framePtr->level;
int t = iPtr->varFramePtr->level;
- ADD_PAIR("level", Tcl_NewIntObj(t - c));
+ ADD_PAIR("level", Tcl_NewWideIntObj(t - c));
break;
}
}
@@ -1592,7 +1585,7 @@ InfoLevelCmd(
Interp *iPtr = (Interp *) interp;
if (objc == 1) { /* Just "info level" */
- Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(iPtr->varFramePtr->level));
return TCL_OK;
}
@@ -1670,7 +1663,7 @@ InfoLibraryCmd(
return TCL_ERROR;
}
- libDirName = Tcl_GetVar(interp, "tcl_library", TCL_GLOBAL_ONLY);
+ libDirName = Tcl_GetVar2(interp, "tcl_library", NULL, TCL_GLOBAL_ONLY);
if (libDirName != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(libDirName, -1));
return TCL_OK;
@@ -1710,19 +1703,24 @@ InfoLoadedCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- const char *interpName;
+ const char *interpName, *packageName;
- if ((objc != 1) && (objc != 2)) {
- Tcl_WrongNumArgs(interp, 1, objv, "?interp?");
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?interp? ?packageName?");
return TCL_ERROR;
}
- if (objc == 1) { /* Get loaded pkgs in all interpreters. */
+ if (objc < 2) { /* Get loaded pkgs in all interpreters. */
interpName = NULL;
} else { /* Get pkgs just in specified interp. */
interpName = TclGetString(objv[1]);
}
- return TclGetLoadedPackages(interp, interpName);
+ if (objc < 3) { /* Get loaded files in all packages. */
+ packageName = NULL;
+ } else { /* Get pkgs just in specified interp. */
+ packageName = TclGetString(objv[2]);
+ }
+ return TclGetLoadedPackagesEx(interp, interpName, packageName);
}
/*
@@ -1796,7 +1794,7 @@ InfoPatchLevelCmd(
return TCL_ERROR;
}
- patchlevel = Tcl_GetVar(interp, "tcl_patchLevel",
+ patchlevel = Tcl_GetVar2(interp, "tcl_patchLevel", NULL,
(TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG));
if (patchlevel != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(patchlevel, -1));
@@ -2127,6 +2125,60 @@ InfoTclVersionCmd(
/*
*----------------------------------------------------------------------
*
+ * InfoCmdTypeCmd --
+ *
+ * Called to implement the "info cmdtype" command that returns the type
+ * of a given command. Handles the following syntax:
+ *
+ * info cmdtype cmdName
+ *
+ * Results:
+ * Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ * Returns a type name. If there is an error, the result is an error
+ * message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCmdTypeCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Command command;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "commandName");
+ return TCL_ERROR;
+ }
+ command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL,
+ TCL_LEAVE_ERR_MSG);
+ if (command == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * There's one special case: safe slave interpreters can't see aliases as
+ * aliases as they're part of the security mechanisms.
+ */
+
+ if (Tcl_IsSafe(interp)
+ && (((Command *) command)->objProc == TclAliasObjCmd)) {
+ Tcl_AppendResult(interp, "native", NULL);
+ } else {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_JoinObjCmd --
*
* This procedure is invoked to process the "join" Tcl command. See the
@@ -2148,8 +2200,8 @@ Tcl_JoinObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
- int listLen, i;
- Tcl_Obj *resObjPtr, *joinObjPtr, **elemPtrs;
+ int length, listLen;
+ Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
if ((objc < 2) || (objc > 3)) {
Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
@@ -2166,27 +2218,47 @@ Tcl_JoinObjCmd(
return TCL_ERROR;
}
+ if (listLen == 0) {
+ /* No elements to join; default empty result is correct. */
+ return TCL_OK;
+ }
+ if (listLen == 1) {
+ /* One element; return it */
+ Tcl_SetObjResult(interp, elemPtrs[0]);
+ return TCL_OK;
+ }
+
joinObjPtr = (objc == 2) ? Tcl_NewStringObj(" ", 1) : objv[2];
Tcl_IncrRefCount(joinObjPtr);
- resObjPtr = Tcl_NewObj();
- for (i = 0; i < listLen; i++) {
- if (i > 0) {
+ (void) Tcl_GetStringFromObj(joinObjPtr, &length);
+ if (length == 0) {
+ resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
+ } else {
+ int i;
+
+ resObjPtr = Tcl_NewObj();
+ for (i = 0; i < listLen; i++) {
+ if (i > 0) {
- /*
- * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
- * to shimmer joinObjPtr. If it did, then the case where
- * objv[1] and objv[2] are the same value would not be safe.
- * Accessing elemPtrs would crash.
- */
+ /*
+ * NOTE: This code is relying on Tcl_AppendObjToObj() **NOT**
+ * to shimmer joinObjPtr. If it did, then the case where
+ * objv[1] and objv[2] are the same value would not be safe.
+ * Accessing elemPtrs would crash.
+ */
- Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
+ Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
+ }
+ Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
- Tcl_AppendObjToObj(resObjPtr, elemPtrs[i]);
}
Tcl_DecrRefCount(joinObjPtr);
- Tcl_SetObjResult(interp, resObjPtr);
- return TCL_OK;
+ if (resObjPtr) {
+ Tcl_SetObjResult(interp, resObjPtr);
+ return TCL_OK;
+ }
+ return TCL_ERROR;
}
/*
@@ -2482,7 +2554,97 @@ Tcl_LlengthObjCmd(
* length.
*/
- Tcl_SetObjResult(interp, Tcl_NewIntObj(listLen));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(listLen));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LpopObjCmd --
+ *
+ * This procedure is invoked to process the "lpop" Tcl command. See the
+ * user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl object result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_LpopObjCmd(
+ ClientData notUsed, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ register Tcl_Obj *const objv[])
+ /* Argument objects. */
+{
+ int listLen, result;
+ Tcl_Obj *elemPtr;
+ Tcl_Obj *listPtr, **elemPtrs;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "listvar ?index?");
+ return TCL_ERROR;
+ }
+
+ listPtr = Tcl_ObjGetVar2(interp, objv[1], NULL, TCL_LEAVE_ERR_MSG);
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ result = TclListObjGetElements(interp, listPtr, &listLen, &elemPtrs);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * First, extract the element to be returned.
+ * TclLindexFlat adds a ref count which is handled.
+ */
+
+ if (objc == 2) {
+ elemPtr = elemPtrs[listLen - 1];
+ Tcl_IncrRefCount(elemPtr);
+ } else {
+ elemPtr = TclLindexFlat(interp, listPtr, objc-2, objv+2);
+
+ if (elemPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetObjResult(interp, elemPtr);
+ Tcl_DecrRefCount(elemPtr);
+
+ /*
+ * Second, remove the element.
+ */
+
+ if (objc == 2) {
+ if (Tcl_IsShared(listPtr)) {
+ listPtr = TclListObjCopy(NULL, listPtr);
+ }
+ result = Tcl_ListObjReplace(interp, listPtr, listLen - 1, 1, 0, NULL);
+ if (result != TCL_OK) {
+ return result;
+ }
+ } else {
+ listPtr = TclLsetFlat(interp, listPtr, objc-2, objv+2, NULL);
+
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ listPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, listPtr, TCL_LEAVE_ERR_MSG);
+ if (listPtr == NULL) {
+ return TCL_ERROR;
+ }
+
return TCL_OK;
}
@@ -2511,7 +2673,6 @@ Tcl_LrangeObjCmd(
register Tcl_Obj *const objv[])
/* Argument objects. */
{
- Tcl_Obj **elemPtrs;
int listLen, first, last, result;
if (objc != 4) {
@@ -2529,55 +2690,14 @@ Tcl_LrangeObjCmd(
if (result != TCL_OK) {
return result;
}
- if (first < 0) {
- first = 0;
- }
result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
&last);
if (result != TCL_OK) {
return result;
}
- if (last >= listLen) {
- last = listLen - 1;
- }
-
- if (first > last) {
- /*
- * Returning an empty list is easy.
- */
-
- return TCL_OK;
- }
-
- result = TclListObjGetElements(interp, objv[1], &listLen, &elemPtrs);
- if (result != TCL_OK) {
- return result;
- }
-
- if (Tcl_IsShared(objv[1]) ||
- ((ListRepPtr(objv[1])->refCount > 1))) {
- Tcl_SetObjResult(interp, Tcl_NewListObj(last - first + 1,
- &elemPtrs[first]));
- } else {
- /*
- * In-place is possible.
- */
-
- if (last < (listLen - 1)) {
- Tcl_ListObjReplace(interp, objv[1], last + 1, listLen - 1 - last,
- 0, NULL);
- }
-
- /*
- * This one is not conditioned on (first > 0) in order to preserve the
- * string-canonizing effect of [lrange 0 end].
- */
-
- Tcl_ListObjReplace(interp, objv[1], 0, first, 0, NULL);
- Tcl_SetObjResult(interp, objv[1]);
- }
+ Tcl_SetObjResult(interp, TclListObjRange(objv[1], first, last));
return TCL_OK;
}
@@ -2896,19 +3016,20 @@ Tcl_LsearchObjCmd(
{
const char *bytes, *patternBytes;
int i, match, index, result=TCL_OK, listc, length, elemLen, bisect;
- int dataType, isIncreasing, lower, upper, offset;
+ int allocatedIndexVector = 0;
+ int dataType, isIncreasing, lower, upper, start, groupSize, groupOffset;
Tcl_WideInt patWide, objWide;
int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
double patDouble, objDouble;
SortInfo sortInfo;
Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
- SortStrCmpFn_t strCmpFn = strcmp;
+ SortStrCmpFn_t strCmpFn = TclUtfCmp;
Tcl_RegExp regexp = NULL;
static const char *const options[] = {
"-all", "-ascii", "-bisect", "-decreasing", "-dictionary",
"-exact", "-glob", "-increasing", "-index",
"-inline", "-integer", "-nocase", "-not",
- "-real", "-regexp", "-sorted", "-start",
+ "-real", "-regexp", "-sorted", "-start", "-stride",
"-subindices", NULL
};
enum options {
@@ -2916,7 +3037,7 @@ Tcl_LsearchObjCmd(
LSEARCH_DICTIONARY, LSEARCH_EXACT, LSEARCH_GLOB, LSEARCH_INCREASING,
LSEARCH_INDEX, LSEARCH_INLINE, LSEARCH_INTEGER, LSEARCH_NOCASE,
LSEARCH_NOT, LSEARCH_REAL, LSEARCH_REGEXP, LSEARCH_SORTED,
- LSEARCH_START, LSEARCH_SUBINDICES
+ LSEARCH_START, LSEARCH_STRIDE, LSEARCH_SUBINDICES
};
enum datatypes {
ASCII, DICTIONARY, INTEGER, REAL
@@ -2936,7 +3057,9 @@ Tcl_LsearchObjCmd(
bisect = 0;
listPtr = NULL;
startPtr = NULL;
- offset = 0;
+ groupSize = 1;
+ groupOffset = 0;
+ start = 0;
noCase = 0;
sortInfo.compareCmdPtr = NULL;
sortInfo.isIncreasing = 1;
@@ -2954,9 +3077,6 @@ Tcl_LsearchObjCmd(
for (i = 1; i < objc-2; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0, &index)
!= TCL_OK) {
- if (startPtr != NULL) {
- Tcl_DecrRefCount(startPtr);
- }
result = TCL_ERROR;
goto done;
}
@@ -3021,6 +3141,7 @@ Tcl_LsearchObjCmd(
if (startPtr != NULL) {
Tcl_DecrRefCount(startPtr);
+ startPtr = NULL;
}
if (i > objc-4) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -3041,25 +3162,47 @@ Tcl_LsearchObjCmd(
startPtr = Tcl_DuplicateObj(objv[i]);
} else {
startPtr = objv[i];
- Tcl_IncrRefCount(startPtr);
}
+ Tcl_IncrRefCount(startPtr);
+ break;
+ case LSEARCH_STRIDE: /* -stride */
+ if (i > objc-4) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "\"-stride\" option must be "
+ "followed by stride length", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (Tcl_GetIntFromObj(interp, objv[i+1], &groupSize) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (groupSize < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "stride length must be at least 1", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSORT",
+ "BADSTRIDE", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ i++;
break;
case LSEARCH_INDEX: { /* -index */
Tcl_Obj **indices;
int j;
- if (sortInfo.indexc > 1) {
+ if (allocatedIndexVector) {
TclStackFree(interp, sortInfo.indexv);
+ allocatedIndexVector = 0;
}
if (i > objc-4) {
- if (startPtr != NULL) {
- Tcl_DecrRefCount(startPtr);
- }
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"\"-index\" option must be followed by list index",
-1));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING", NULL);
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
/*
@@ -3071,10 +3214,8 @@ Tcl_LsearchObjCmd(
i++;
if (TclListObjGetElements(interp, objv[i],
&sortInfo.indexc, &indices) != TCL_OK) {
- if (startPtr != NULL) {
- Tcl_DecrRefCount(startPtr);
- }
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
switch (sortInfo.indexc) {
case 0:
@@ -3086,6 +3227,8 @@ Tcl_LsearchObjCmd(
default:
sortInfo.indexv =
TclStackAlloc(interp, sizeof(int) * sortInfo.indexc);
+ allocatedIndexVector = 1; /* Cannot use indexc field, as it
+ * might be decreased by 1 later. */
}
/*
@@ -3096,12 +3239,11 @@ Tcl_LsearchObjCmd(
for (j=0 ; j<sortInfo.indexc ; j++) {
int encoded = 0;
- if (TclIndexEncode(interp, indices[j], TCL_INDEX_BEFORE,
- TCL_INDEX_AFTER, &encoded) != TCL_OK) {
+ if (TclIndexEncode(interp, indices[j], TCL_INDEX_NONE,
+ TCL_INDEX_NONE, &encoded) != TCL_OK) {
result = TCL_ERROR;
}
- if ((encoded == TCL_INDEX_BEFORE)
- || (encoded == TCL_INDEX_AFTER)) {
+ if (encoded == TCL_INDEX_NONE) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%s\" cannot select an element "
"from any list", Tcl_GetString(indices[j])));
@@ -3126,14 +3268,12 @@ Tcl_LsearchObjCmd(
*/
if (returnSubindices && sortInfo.indexc==0) {
- if (startPtr != NULL) {
- Tcl_DecrRefCount(startPtr);
- }
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"-subindices cannot be used without -index option", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
"BAD_OPTION_MIX", NULL);
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
if (bisect && (allMatches || negatedMatch)) {
@@ -3141,7 +3281,8 @@ Tcl_LsearchObjCmd(
"-bisect is not compatible with -all or -not", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
"BAD_OPTION_MIX", NULL);
- return TCL_ERROR;
+ result = TCL_ERROR;
+ goto done;
}
if (mode == REGEXP) {
@@ -3167,9 +3308,6 @@ Tcl_LsearchObjCmd(
}
if (regexp == NULL) {
- if (startPtr != NULL) {
- Tcl_DecrRefCount(startPtr);
- }
result = TCL_ERROR;
goto done;
}
@@ -3182,24 +3320,64 @@ Tcl_LsearchObjCmd(
result = TclListObjGetElements(interp, objv[objc - 2], &listc, &listv);
if (result != TCL_OK) {
- if (startPtr != NULL) {
- Tcl_DecrRefCount(startPtr);
- }
goto done;
}
/*
+ * Check for sanity when grouping elements of the overall list together
+ * because of the -stride option. [TIP #351]
+ */
+
+ if (groupSize > 1) {
+ if (listc % groupSize) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "list size must be a multiple of the stride length",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH", "BADSTRIDE",
+ NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (sortInfo.indexc > 0) {
+ /*
+ * Use the first value in the list supplied to -index as the
+ * offset of the element within each group by which to sort.
+ */
+
+ groupOffset = TclIndexDecode(sortInfo.indexv[0], groupSize - 1);
+ if (groupOffset < 0 || groupOffset >= groupSize) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "when used with \"-stride\", the leading \"-index\""
+ " value must be within the group", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSEARCH",
+ "BADINDEX", NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (sortInfo.indexc == 1) {
+ sortInfo.indexc = 0;
+ sortInfo.indexv = NULL;
+ } else {
+ sortInfo.indexc--;
+
+ for (i = 0; i < sortInfo.indexc; i++) {
+ sortInfo.indexv[i] = sortInfo.indexv[i+1];
+ }
+ }
+ }
+ }
+
+ /*
* Get the user-specified start offset.
*/
if (startPtr) {
- result = TclGetIntForIndexM(interp, startPtr, listc-1, &offset);
- Tcl_DecrRefCount(startPtr);
+ result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
if (result != TCL_OK) {
goto done;
}
- if (offset < 0) {
- offset = 0;
+ if (start < 0) {
+ start = 0;
}
/*
@@ -3207,16 +3385,21 @@ Tcl_LsearchObjCmd(
* "did not match anything at all" result straight away. [Bug 1374778]
*/
- if (offset > listc-1) {
- if (sortInfo.indexc > 1) {
- TclStackFree(interp, sortInfo.indexv);
- }
+ if (start > listc-1) {
if (allMatches || inlineReturn) {
Tcl_ResetResult(interp);
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(-1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-1));
}
- return TCL_OK;
+ goto done;
+ }
+
+ /*
+ * If start points within a group, it points to the start of the group.
+ */
+
+ if (groupSize > 1) {
+ start -= (start % groupSize);
}
}
@@ -3275,18 +3458,23 @@ Tcl_LsearchObjCmd(
* sense in doing this when the match sense is inverted.
*/
- lower = offset - 1;
+ /*
+ * With -stride, lower, upper and i are kept as multiples of groupSize.
+ */
+
+ lower = start - groupSize;
upper = listc;
- while (lower + 1 != upper && sortInfo.resultCode == TCL_OK) {
+ while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
i = (lower + upper)/2;
+ i -= i % groupSize;
if (sortInfo.indexc != 0) {
- itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+ itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
result = sortInfo.resultCode;
goto done;
}
} else {
- itemPtr = listv[i];
+ itemPtr = listv[i+groupOffset];
}
switch ((enum datatypes) dataType) {
case ASCII:
@@ -3375,10 +3563,10 @@ Tcl_LsearchObjCmd(
if (allMatches) {
listPtr = Tcl_NewListObj(0, NULL);
}
- for (i = offset; i < listc; i++) {
+ for (i = start; i < listc; i += groupSize) {
match = 0;
if (sortInfo.indexc != 0) {
- itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+ itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
if (sortInfo.resultCode != TCL_OK) {
if (listPtr != NULL) {
Tcl_DecrRefCount(listPtr);
@@ -3387,7 +3575,7 @@ Tcl_LsearchObjCmd(
goto done;
}
} else {
- itemPtr = listv[i];
+ itemPtr = listv[i+groupOffset];
}
switch (mode) {
@@ -3477,22 +3665,27 @@ Tcl_LsearchObjCmd(
*/
if (returnSubindices && (sortInfo.indexc != 0)) {
- itemPtr = SelectObjFromSublist(listv[i], &sortInfo);
+ itemPtr = SelectObjFromSublist(listv[i+groupOffset],
+ &sortInfo);
+ Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+ } else if (groupSize > 1) {
+ Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
+ groupSize, &listv[i]);
} else {
itemPtr = listv[i];
+ Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
}
- Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else if (returnSubindices) {
int j;
- itemPtr = Tcl_NewIntObj(i);
+ itemPtr = Tcl_NewWideIntObj(i+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
- Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
+ Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewWideIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
}
Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
} else {
- Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(i));
+ Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
}
}
}
@@ -3507,14 +3700,14 @@ Tcl_LsearchObjCmd(
if (returnSubindices) {
int j;
- itemPtr = Tcl_NewIntObj(index);
+ itemPtr = Tcl_NewWideIntObj(index+groupOffset);
for (j=0 ; j<sortInfo.indexc ; j++) {
- Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewIntObj(
+ Tcl_ListObjAppendElement(interp, itemPtr, Tcl_NewWideIntObj(
TclIndexDecode(sortInfo.indexv[j], listc)));
}
Tcl_SetObjResult(interp, itemPtr);
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(index));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(index));
}
} else if (index < 0) {
/*
@@ -3524,7 +3717,14 @@ Tcl_LsearchObjCmd(
Tcl_SetObjResult(interp, Tcl_NewObj());
} else {
- Tcl_SetObjResult(interp, listv[index]);
+ if (returnSubindices) {
+ Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
+ &sortInfo));
+ } else if (groupSize > 1) {
+ Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
+ } else {
+ Tcl_SetObjResult(interp, listv[index]);
+ }
}
result = TCL_OK;
@@ -3533,7 +3733,10 @@ Tcl_LsearchObjCmd(
*/
done:
- if (sortInfo.indexc > 1) {
+ if (startPtr != NULL) {
+ Tcl_DecrRefCount(startPtr);
+ }
+ if (allocatedIndexVector) {
TclStackFree(interp, sortInfo.indexv);
}
return result;
@@ -3755,10 +3958,9 @@ Tcl_LsortObjCmd(
for (j=0 ; j<indexc ; j++) {
int encoded = 0;
int result = TclIndexEncode(interp, indexv[j],
- TCL_INDEX_BEFORE, TCL_INDEX_AFTER, &encoded);
+ TCL_INDEX_NONE, TCL_INDEX_NONE, &encoded);
- if ((result == TCL_OK) && ((encoded == TCL_INDEX_BEFORE)
- || (encoded == TCL_INDEX_AFTER))) {
+ if ((result == TCL_OK) && (encoded == TCL_INDEX_NONE)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"index \"%s\" cannot select an element "
"from any list", Tcl_GetString(indexv[j])));
@@ -3847,7 +4049,8 @@ Tcl_LsortObjCmd(
}
for (j=0 ; j<sortInfo.indexc ; j++) {
/* Prescreened values, no errors or out of range possible */
- TclIndexEncode(NULL, indexv[j], 0, 0, &sortInfo.indexv[j]);
+ TclIndexEncode(NULL, indexv[j], TCL_INDEX_NONE,
+ TCL_INDEX_NONE, &sortInfo.indexv[j]);
}
}
@@ -3937,7 +4140,7 @@ Tcl_LsortObjCmd(
/*
* Do not shrink the actual memory block used; that doesn't
* work with TclStackAlloc-allocated memory. [Bug 2918962]
- *
+ *
* TODO: Consider a pointer increment to replace this
* array shift.
*/
@@ -4073,7 +4276,7 @@ Tcl_LsortObjCmd(
idx = elementPtr->payload.index;
for (j = 0; j < groupSize; j++) {
if (indices) {
- objPtr = Tcl_NewIntObj(idx + j - groupOffset);
+ objPtr = Tcl_NewWideIntObj(idx + j - groupOffset);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
} else {
@@ -4085,7 +4288,7 @@ Tcl_LsortObjCmd(
}
} else if (indices) {
for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
- objPtr = Tcl_NewIntObj(elementPtr->payload.index);
+ objPtr = Tcl_NewWideIntObj(elementPtr->payload.index);
newArray[i++] = objPtr;
Tcl_IncrRefCount(objPtr);
}
@@ -4245,7 +4448,7 @@ SortCompare(
int order = 0;
if (infoPtr->sortMode == SORTMODE_ASCII) {
- order = strcmp(elemPtr1->collationKey.strValuePtr,
+ order = TclUtfCmp(elemPtr1->collationKey.strValuePtr,
elemPtr2->collationKey.strValuePtr);
} else if (infoPtr->sortMode == SORTMODE_ASCII_NC) {
order = TclUtfCasecmp(elemPtr1->collationKey.strValuePtr,
@@ -4517,9 +4720,16 @@ SelectObjFromSublist(
return NULL;
}
if (currentObj == NULL) {
- Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
- "element %d missing from sublist \"%s\"",
- index, TclGetString(objPtr)));
+ if (index == TCL_INDEX_NONE) {
+ index = TCL_INDEX_END - infoPtr->indexv[i];
+ Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
+ "element end-%d missing from sublist \"%s\"",
+ index, TclGetString(objPtr)));
+ } else {
+ Tcl_SetObjResult(infoPtr->interp, Tcl_ObjPrintf(
+ "element %d missing from sublist \"%s\"",
+ index, TclGetString(objPtr)));
+ }
Tcl_SetErrorCode(infoPtr->interp, "TCL", "OPERATION", "LSORT",
"INDEXFAILED", NULL);
infoPtr->resultCode = TCL_ERROR;
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 3a712f9..2dea688 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -258,7 +258,7 @@ Tcl_RegexpObjCmd(
stringLength = Tcl_GetCharLength(objPtr);
if (startIndex) {
- TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
+ TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (offset < 0) {
offset = 0;
@@ -323,7 +323,7 @@ Tcl_RegexpObjCmd(
if (match == 0) {
/*
- * We want to set the value of the intepreter result only when
+ * We want to set the value of the interpreter result only when
* this is the first time through the loop.
*/
@@ -335,7 +335,7 @@ Tcl_RegexpObjCmd(
*/
if (!doinline) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
}
return TCL_OK;
}
@@ -388,8 +388,8 @@ Tcl_RegexpObjCmd(
end = -1;
}
- objs[0] = Tcl_NewLongObj(start);
- objs[1] = Tcl_NewLongObj(end);
+ objs[0] = Tcl_NewWideIntObj(start);
+ objs[1] = Tcl_NewWideIntObj(end);
newPtr = Tcl_NewListObj(2, objs);
} else {
@@ -457,7 +457,7 @@ Tcl_RegexpObjCmd(
if (doinline) {
Tcl_SetObjResult(interp, resultPtr);
} else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(all ? all-1 : 1));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(all ? all-1 : 1));
}
return TCL_OK;
}
@@ -487,26 +487,27 @@ Tcl_RegsubObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
- int start, end, subStart, subEnd, match;
+ int start, end, subStart, subEnd, match, command, numParts;
Tcl_RegExp regExpr;
Tcl_RegExpInfo info;
Tcl_Obj *resultPtr, *subPtr, *objPtr, *startIndex = NULL;
- Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec, *wend;
+ Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec = 0, *wend;
static const char *const options[] = {
- "-all", "-nocase", "-expanded",
- "-line", "-linestop", "-lineanchor", "-start",
+ "-all", "-command", "-expanded", "-line",
+ "-linestop", "-lineanchor", "-nocase", "-start",
"--", NULL
};
enum options {
- REGSUB_ALL, REGSUB_NOCASE, REGSUB_EXPANDED,
- REGSUB_LINE, REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_START,
+ REGSUB_ALL, REGSUB_COMMAND, REGSUB_EXPANDED, REGSUB_LINE,
+ REGSUB_LINESTOP, REGSUB_LINEANCHOR, REGSUB_NOCASE, REGSUB_START,
REGSUB_LAST
};
cflags = TCL_REG_ADVANCED;
all = 0;
offset = 0;
+ command = 0;
resultPtr = NULL;
for (idx = 1; idx < objc; idx++) {
@@ -528,6 +529,9 @@ Tcl_RegsubObjCmd(
case REGSUB_NOCASE:
cflags |= TCL_REG_NOCASE;
break;
+ case REGSUB_COMMAND:
+ command = 1;
+ break;
case REGSUB_EXPANDED:
cflags |= TCL_REG_EXPANDED;
break;
@@ -578,14 +582,14 @@ Tcl_RegsubObjCmd(
if (startIndex) {
int stringLength = Tcl_GetCharLength(objv[1]);
- TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
+ TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
Tcl_DecrRefCount(startIndex);
if (offset < 0) {
offset = 0;
}
}
- if (all && (offset == 0)
+ if (all && (offset == 0) && (command == 0)
&& (strpbrk(TclGetString(objv[2]), "&\\") == NULL)
&& (strpbrk(TclGetString(objv[0]), "*+?{}()[].\\|^$") == NULL)) {
/*
@@ -593,9 +597,9 @@ Tcl_RegsubObjCmd(
* slightly modified version of the one pair STR_MAP code.
*/
- int slen, nocase;
+ int slen, nocase, wsrclc;
int (*strCmpFn)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long);
- Tcl_UniChar *p, wsrclc;
+ Tcl_UniChar *p;
numMatches = 0;
nocase = (cflags & TCL_REG_NOCASE);
@@ -661,6 +665,28 @@ Tcl_RegsubObjCmd(
return TCL_ERROR;
}
+ if (command) {
+ /*
+ * In command-prefix mode, we require that the third non-option
+ * argument be a list, so we enforce that here. Afterwards, we fetch
+ * the RE compilation again in case objv[0] and objv[2] are the same
+ * object. (If they aren't, that's cheap to do.)
+ */
+
+ if (Tcl_ListObjLength(interp, objv[2], &numParts) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (numParts < 1) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "command prefix must be a list of at least one element",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "REGSUB",
+ "CMDEMPTY", NULL);
+ return TCL_ERROR;
+ }
+ regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
+ }
+
/*
* Make sure to avoid problems where the objects are shared. This can
* cause RegExpObj <> UnicodeObj shimmering that causes data corruption.
@@ -678,7 +704,9 @@ Tcl_RegsubObjCmd(
} else {
subPtr = objv[2];
}
- wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
+ if (!command) {
+ wsubspec = Tcl_GetUnicodeFromObj(subPtr, &wsublen);
+ }
result = TCL_OK;
@@ -737,6 +765,90 @@ Tcl_RegsubObjCmd(
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, start);
/*
+ * In command-prefix mode, the substitutions are added as quoted
+ * arguments to the subSpec to form a command, that is then executed
+ * and the result used as the string to substitute in. Actually,
+ * everything is passed through Tcl_EvalObjv, as that's much faster.
+ */
+
+ if (command) {
+ Tcl_Obj **args = NULL, **parts;
+ int numArgs;
+
+ Tcl_ListObjGetElements(interp, subPtr, &numParts, &parts);
+ numArgs = numParts + info.nsubs + 1;
+ args = ckalloc(sizeof(Tcl_Obj*) * numArgs);
+ memcpy(args, parts, sizeof(Tcl_Obj*) * numParts);
+
+ for (idx = 0 ; idx <= info.nsubs ; idx++) {
+ subStart = info.matches[idx].start;
+ subEnd = info.matches[idx].end;
+ if ((subStart >= 0) && (subEnd >= 0)) {
+ args[idx + numParts] = Tcl_NewUnicodeObj(
+ wstring + offset + subStart, subEnd - subStart);
+ } else {
+ args[idx + numParts] = Tcl_NewObj();
+ }
+ Tcl_IncrRefCount(args[idx + numParts]);
+ }
+
+ /*
+ * At this point, we're locally holding the references to the
+ * argument words we added for this time round the loop, and the
+ * subPtr is holding the references to the words that the user
+ * supplied directly. None are zero-refcount, which is important
+ * because Tcl_EvalObjv is "hairy monster" in terms of refcount
+ * handling, being able to optionally add references to any of its
+ * argument words. We'll drop the local refs immediately
+ * afterwards; subPtr is handled in the main exit stanza.
+ */
+
+ result = Tcl_EvalObjv(interp, numArgs, args, 0);
+ for (idx = 0 ; idx <= info.nsubs ; idx++) {
+ TclDecrRefCount(args[idx + numParts]);
+ }
+ ckfree(args);
+ if (result != TCL_OK) {
+ if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (%s substitution computation script)",
+ options[REGSUB_COMMAND]));
+ }
+ goto done;
+ }
+
+ Tcl_AppendObjToObj(resultPtr, Tcl_GetObjResult(interp));
+ Tcl_ResetResult(interp);
+
+ /*
+ * Refetch the unicode, in case the representation was smashed by
+ * the user code.
+ */
+
+ wstring = Tcl_GetUnicodeFromObj(objPtr, &wlen);
+
+ offset += end;
+ if (end == 0 || start == end) {
+ /*
+ * Always consume at least one character of the input string
+ * in order to prevent infinite loops, even when we
+ * technically matched the empty string; we must not match
+ * again at the same spot.
+ */
+
+ if (offset < wlen) {
+ Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
+ }
+ offset++;
+ }
+ if (all) {
+ continue;
+ } else {
+ break;
+ }
+ }
+
+ /*
* Append the subSpec argument to the variable, making appropriate
* substitutions. This code is a bit hairy because of the backslash
* conventions and because the code saves up ranges of characters in
@@ -847,7 +959,7 @@ Tcl_RegsubObjCmd(
* holding the number of matches.
*/
- Tcl_SetObjResult(interp, Tcl_NewIntObj(numMatches));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(numMatches));
}
} else {
/*
@@ -989,8 +1101,11 @@ TclNRSourceObjCmd(
{
const char *encodingName = NULL;
Tcl_Obj *fileName;
+ int result;
+ void **pkgFiles = NULL;
+ void *names = NULL;
- if (objc != 2 && objc !=4) {
+ if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv, "?-encoding name? fileName");
return TCL_ERROR;
}
@@ -1008,9 +1123,30 @@ TclNRSourceObjCmd(
return TCL_ERROR;
}
encodingName = TclGetString(objv[2]);
- }
+ } else if (objc == 3) {
+ /* Handle undocumented -nopkg option. This should only be
+ * used by the internal ::tcl::Pkg::source utility function. */
+ static const char *const nopkgoptions[] = {
+ "-nopkg", NULL
+ };
+ int index;
- return TclNREvalFile(interp, fileName, encodingName);
+ if (TCL_ERROR == Tcl_GetIndexFromObj(interp, objv[1], nopkgoptions,
+ "option", TCL_EXACT, &index)) {
+ return TCL_ERROR;
+ }
+ pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ /* Make sure that during the following TclNREvalFile no filenames
+ * are recorded for inclusion in the "package files" command */
+ names = *pkgFiles;
+ *pkgFiles = NULL;
+ }
+ result = TclNREvalFile(interp, fileName, encodingName);
+ if (pkgFiles) {
+ /* restore "tclPkgFiles" assocdata to how it was. */
+ *pkgFiles = names;
+ }
+ return result;
}
/*
@@ -1084,7 +1220,7 @@ Tcl_SplitObjCmd(
len = TclUtfToUniChar(stringPtr, &ch);
fullchar = ch;
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!len) {
len += TclUtfToUniChar(stringPtr, &ch);
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
@@ -1185,8 +1321,7 @@ StringFirstCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar *needleStr, *haystackStr;
- int match, start, needleLen, haystackLen;
+ int start = 0;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
@@ -1194,82 +1329,15 @@ StringFirstCmd(
return TCL_ERROR;
}
- /*
- * We are searching haystackStr for the sequence needleStr.
- */
-
- match = -1;
- start = 0;
- haystackLen = -1;
-
- needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
- haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
-
if (objc == 4) {
- /*
- * If a startIndex is specified, we will need to fast forward to that
- * point in the string before we think about a match.
- */
+ int size = Tcl_GetCharLength(objv[2]);
- if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
- &start) != TCL_OK){
+ if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &start)) {
return TCL_ERROR;
}
-
- /*
- * Reread to prevent shimmering problems.
- */
-
- needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
- haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
-
- if (start >= haystackLen) {
- goto str_first_done;
- } else if (start > 0) {
- haystackStr += start;
- haystackLen -= start;
- } else if (start < 0) {
- /*
- * Invalid start index mapped to string start; Bug #423581
- */
-
- start = 0;
- }
- }
-
- /*
- * If the length of the needle is more than the length of the haystack, it
- * cannot be contained in there so we can avoid searching. [Bug 2960021]
- */
-
- if (needleLen > 0 && needleLen <= haystackLen) {
- register Tcl_UniChar *p, *end;
-
- end = haystackStr + haystackLen - needleLen + 1;
- for (p = haystackStr; p < end; p++) {
- /*
- * Scan forward to find the first character.
- */
-
- if ((*p == *needleStr) && (TclUniCharNcmp(needleStr, p,
- (unsigned long) needleLen) == 0)) {
- match = p - haystackStr;
- break;
- }
- }
- }
-
- /*
- * Compute the character index of the matching string by counting the
- * number of characters before the match.
- */
-
- if ((match != -1) && (objc == 4)) {
- match += start;
}
-
- str_first_done:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringFirst(objv[1],
+ objv[2], start)));
return TCL_OK;
}
@@ -1298,76 +1366,23 @@ StringLastCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar *needleStr, *haystackStr, *p;
- int match, start, needleLen, haystackLen;
+ int last = INT_MAX - 1;
if (objc < 3 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "needleString haystackString ?startIndex?");
+ "needleString haystackString ?lastIndex?");
return TCL_ERROR;
}
- /*
- * We are searching haystackString for the sequence needleString.
- */
-
- match = -1;
- start = 0;
- haystackLen = -1;
-
- needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
- haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
-
if (objc == 4) {
- /*
- * If a startIndex is specified, we will need to restrict the string
- * range to that char index in the string
- */
+ int size = Tcl_GetCharLength(objv[2]);
- if (TclGetIntForIndexM(interp, objv[3], haystackLen-1,
- &start) != TCL_OK){
+ if (TCL_OK != TclGetIntForIndexM(interp, objv[3], size - 1, &last)) {
return TCL_ERROR;
}
-
- /*
- * Reread to prevent shimmering problems.
- */
-
- needleStr = Tcl_GetUnicodeFromObj(objv[1], &needleLen);
- haystackStr = Tcl_GetUnicodeFromObj(objv[2], &haystackLen);
-
- if (start < 0) {
- goto str_last_done;
- } else if (start < haystackLen) {
- p = haystackStr + start + 1 - needleLen;
- } else {
- p = haystackStr + haystackLen - needleLen;
- }
- } else {
- p = haystackStr + haystackLen - needleLen;
}
-
- /*
- * If the length of the needle is more than the length of the haystack, it
- * cannot be contained in there so we can avoid searching. [Bug 2960021]
- */
-
- if (needleLen > 0 && needleLen <= haystackLen) {
- for (; p >= haystackStr; p--) {
- /*
- * Scan backwards to find the first character.
- */
-
- if ((*p == *needleStr) && !memcmp(needleStr, p,
- sizeof(Tcl_UniChar) * (size_t)needleLen)) {
- match = p - haystackStr;
- break;
- }
- }
- }
-
- str_last_done:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(TclStringLast(objv[1],
+ objv[2], last)));
return TCL_OK;
}
@@ -1404,7 +1419,7 @@ StringIndexCmd(
}
/*
- * Get the char length to calulate what 'end' means.
+ * Get the char length to calculate what 'end' means.
*/
length = Tcl_GetCharLength(objv[1]);
@@ -1413,7 +1428,11 @@ StringIndexCmd(
}
if ((index >= 0) && (index < length)) {
- Tcl_UniChar ch = Tcl_GetUniChar(objv[1], index);
+ int ch = Tcl_GetUniChar(objv[1], index);
+
+ if (ch == -1) {
+ return TCL_OK;
+ }
/*
* If we have a ByteArray object, we're careful to generate a new
@@ -1425,9 +1444,12 @@ StringIndexCmd(
Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
} else {
- char buf[TCL_UTF_MAX];
+ char buf[4];
length = Tcl_UniCharToUtf(ch, buf);
+ if (!length) {
+ length = Tcl_UniCharToUtf(-1, buf);
+ }
Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
}
}
@@ -1468,19 +1490,19 @@ StringIsCmd(
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
- "boolean", "digit", "double", "entier",
- "false", "graph", "integer", "list",
- "lower", "print", "punct", "space",
- "true", "upper", "wideinteger", "wordchar",
- "xdigit", NULL
+ "boolean", "dict", "digit", "double",
+ "entier", "false", "graph", "integer",
+ "list", "lower", "print", "punct",
+ "space", "true", "upper", "wideinteger",
+ "wordchar", "xdigit", NULL
};
enum isClasses {
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
- STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
- STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
- STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
- STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
- STR_IS_XDIGIT
+ STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE,
+ STR_IS_ENTIER, STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT,
+ STR_IS_LIST, STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT,
+ STR_IS_SPACE, STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE,
+ STR_IS_WORD, STR_IS_XDIGIT
};
static const char *const isOptions[] = {
"-strict", "-failindex", NULL
@@ -1557,26 +1579,71 @@ StringIsCmd(
string1 = TclGetStringFromObj(objPtr, &length1);
result = length1 == 0;
}
- } else if (((index == STR_IS_TRUE) &&
- objPtr->internalRep.longValue == 0)
- || ((index == STR_IS_FALSE) &&
- objPtr->internalRep.longValue != 0)) {
- result = 0;
+ } else if (index != STR_IS_BOOL) {
+ TclGetBooleanFromObj(NULL, objPtr, &i);
+ if ((index == STR_IS_TRUE) ^ i) {
+ result = 0;
+ }
}
break;
case STR_IS_CONTROL:
chcomp = Tcl_UniCharIsControl;
break;
+ case STR_IS_DICT: {
+ int dresult, dsize;
+
+ dresult = Tcl_DictObjSize(interp, objPtr, &dsize);
+ Tcl_ResetResult(interp);
+ result = (dresult == TCL_OK) ? 1 : 0;
+ if (dresult != TCL_OK && failVarObj != NULL) {
+ /*
+ * Need to figure out where the list parsing failed, which is
+ * fairly expensive. This is adapted from the core of
+ * SetDictFromAny().
+ */
+
+ const char *elemStart, *nextElem;
+ int lenRemain, elemSize;
+ register const char *p;
+
+ string1 = TclGetStringFromObj(objPtr, &length1);
+ end = string1 + length1;
+ failat = -1;
+ for (p=string1, lenRemain=length1; lenRemain > 0;
+ p=nextElem, lenRemain=end-nextElem) {
+ if (TCL_ERROR == TclFindElement(NULL, p, lenRemain,
+ &elemStart, &nextElem, &elemSize, NULL)) {
+ Tcl_Obj *tmpStr;
+
+ /*
+ * This is the simplest way of getting the number of
+ * characters parsed. Note that this is not the same as
+ * the number of bytes when parsing strings with non-ASCII
+ * characters in them.
+ *
+ * Skip leading spaces first. This is only really an issue
+ * if it is the first "element" that has the failure.
+ */
+
+ while (TclIsSpaceProc(*p)) {
+ p++;
+ }
+ TclNewStringObj(tmpStr, string1, p-string1);
+ failat = Tcl_GetCharLength(tmpStr);
+ TclDecrRefCount(tmpStr);
+ break;
+ }
+ }
+ }
+ break;
+ }
case STR_IS_DIGIT:
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
- if ((objPtr->typePtr == &tclDoubleType) ||
- (objPtr->typePtr == &tclIntType) ||
-#ifndef TCL_WIDE_INT_IS_LONG
- (objPtr->typePtr == &tclWideIntType) ||
-#endif
- (objPtr->typePtr == &tclBignumType)) {
+ if (TclHasIntRep(objPtr, &tclDoubleType) ||
+ TclHasIntRep(objPtr, &tclIntType) ||
+ TclHasIntRep(objPtr, &tclBignumType)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1604,16 +1671,9 @@ StringIsCmd(
chcomp = Tcl_UniCharIsGraph;
break;
case STR_IS_INT:
- if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
- break;
- }
- goto failedIntParse;
case STR_IS_ENTIER:
- if ((objPtr->typePtr == &tclIntType) ||
-#ifndef TCL_WIDE_INT_IS_LONG
- (objPtr->typePtr == &tclWideIntType) ||
-#endif
- (objPtr->typePtr == &tclBignumType)) {
+ if (TclHasIntRep(objPtr, &tclIntType) ||
+ TclHasIntRep(objPtr, &tclBignumType)) {
break;
}
string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1658,7 +1718,6 @@ StringIsCmd(
break;
}
- failedIntParse:
string1 = TclGetStringFromObj(objPtr, &length1);
if (length1 == 0) {
if (strict) {
@@ -1794,7 +1853,7 @@ StringIsCmd(
int fullchar;
length2 = TclUtfToUniChar(string1, &ch);
fullchar = ch;
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!length2) {
length2 = TclUtfToUniChar(string1, &ch);
fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
@@ -1814,7 +1873,7 @@ StringIsCmd(
str_is_done:
if ((result == 0) && (failVarObj != NULL) &&
- Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewIntObj(failat),
+ Tcl_ObjSetVar2(interp, failVarObj, NULL, Tcl_NewWideIntObj(failat),
TCL_LEAVE_ERR_MSG) == NULL) {
return TCL_ERROR;
}
@@ -1833,7 +1892,7 @@ static int
UniCharIsHexDigit(
int character)
{
- return (character >= 0) && (character < 0x80) && isxdigit(character);
+ return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}
/*
@@ -1889,10 +1948,11 @@ StringMapCmd(
/*
* This test is tricky, but has to be that way or you get other strange
- * inconsistencies (see test string-10.20 for illustration why!)
+ * inconsistencies (see test string-10.20.1 for illustration why!)
*/
- if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
+ if (!TclHasStringRep(objv[objc-2])
+ && TclHasIntRep(objv[objc-2], &tclDictType)){
int i, done;
Tcl_DictSearch search;
@@ -1988,8 +2048,8 @@ StringMapCmd(
* larger strings.
*/
- int mapLen;
- Tcl_UniChar *mapString, u2lc;
+ int mapLen, u2lc;
+ Tcl_UniChar *mapString;
ustring2 = Tcl_GetUnicodeFromObj(mapElemv[0], &length2);
p = ustring1;
@@ -2020,8 +2080,8 @@ StringMapCmd(
}
}
} else {
- Tcl_UniChar **mapStrings, *u2lc = NULL;
- int *mapLens;
+ Tcl_UniChar **mapStrings;
+ int *mapLens, *u2lc = NULL;
/*
* Precompute pointers to the unicode string and length. This saves us
@@ -2033,7 +2093,7 @@ StringMapCmd(
mapStrings = TclStackAlloc(interp, mapElemc*2*sizeof(Tcl_UniChar *));
mapLens = TclStackAlloc(interp, mapElemc * 2 * sizeof(int));
if (nocase) {
- u2lc = TclStackAlloc(interp, mapElemc * sizeof(Tcl_UniChar));
+ u2lc = TclStackAlloc(interp, mapElemc * sizeof(int));
}
for (index = 0; index < mapElemc; index++) {
mapStrings[index] = Tcl_GetUnicodeFromObj(mapElemv[index],
@@ -2239,9 +2299,7 @@ StringReptCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- const char *string1;
- char *string2;
- int count, index, length1, length2;
+ int count;
Tcl_Obj *resultPtr;
if (objc != 3) {
@@ -2259,71 +2317,17 @@ StringReptCmd(
if (count == 1) {
Tcl_SetObjResult(interp, objv[1]);
- goto done;
+ return TCL_OK;
} else if (count < 1) {
- goto done;
- }
- string1 = TclGetStringFromObj(objv[1], &length1);
- if (length1 <= 0) {
- goto done;
- }
-
- /*
- * Only build up a string that has data. Instead of building it up with
- * repeated appends, we just allocate the necessary space once and copy
- * the string value in.
- *
- * We have to worry about overflow [Bugs 714106, 2561746].
- * At this point we know 1 <= length1 <= INT_MAX and 2 <= count <= INT_MAX.
- * We need to keep 2 <= length2 <= INT_MAX.
- */
-
- if (count > INT_MAX/length1) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "result exceeds max size for a Tcl value (%d bytes)",
- INT_MAX));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- return TCL_ERROR;
+ return TCL_OK;
}
- length2 = length1 * count;
- /*
- * Include space for the NUL.
- */
-
- string2 = attemptckalloc((unsigned) length2 + 1);
- if (string2 == NULL) {
- /*
- * Alloc failed. Note that in this case we try to do an error message
- * since this is a case that's most likely when the alloc is large and
- * that's easy to do with this API. Note that if we fail allocating a
- * short string, this will likely keel over too (and fatally).
- */
-
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "string size overflow, out of memory allocating %u bytes",
- length2 + 1));
- Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
- return TCL_ERROR;
- }
- for (index = 0; index < count; index++) {
- memcpy(string2 + (length1 * index), string1, (size_t) length1);
+ resultPtr = TclStringRepeat(interp, objv[1], count, TCL_STRING_IN_PLACE);
+ if (resultPtr) {
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
}
- string2[length2] = '\0';
-
- /*
- * We have to directly assign this instead of using Tcl_SetStringObj (and
- * indirectly TclInitStringRep) because that makes another copy of the
- * data.
- */
-
- TclNewObj(resultPtr);
- resultPtr->bytes = string2;
- resultPtr->length = length2;
- Tcl_SetObjResult(interp, resultPtr);
-
- done:
- return TCL_OK;
+ return TCL_ERROR;
}
/*
@@ -2351,7 +2355,6 @@ StringRplcCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_UniChar *ustring;
int first, last, length, end;
if (objc < 4 || objc > 5) {
@@ -2359,7 +2362,7 @@ StringRplcCmd(
return TCL_ERROR;
}
- ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
+ length = Tcl_GetCharLength(objv[1]);
end = length - 1;
if (TclGetIntForIndexM(interp, objv[2], end, &first) != TCL_OK ||
@@ -2385,26 +2388,17 @@ StringRplcCmd(
} else {
Tcl_Obj *resultPtr;
- /*
- * We are re-fetching in case the string argument is same value as
- * an index argument, and shimmering cost us our ustring.
- */
-
- ustring = Tcl_GetUnicodeFromObj(objv[1], &length);
- end = length-1;
-
if (first < 0) {
first = 0;
}
-
- resultPtr = Tcl_NewUnicodeObj(ustring, first);
- if (objc == 5) {
- Tcl_AppendObjToObj(resultPtr, objv[4]);
- }
- if (last < end) {
- Tcl_AppendUnicodeToObj(resultPtr, ustring + last + 1,
- end - last);
+ if (last > end) {
+ last = end;
}
+
+ resultPtr = TclStringReplace(interp, objv[1], first,
+ last + 1 - first, (objc == 5) ? objv[4] : NULL,
+ TCL_STRING_IN_PLACE);
+
Tcl_SetObjResult(interp, resultPtr);
}
return TCL_OK;
@@ -2440,7 +2434,7 @@ StringRevCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, TclStringObjReverse(objv[1]));
+ Tcl_SetObjResult(interp, TclStringReverse(objv[1], TCL_STRING_IN_PLACE));
return TCL_OK;
}
@@ -2502,7 +2496,7 @@ StringStartCmd(
cur += 1;
}
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cur));
return TCL_OK;
}
@@ -2564,7 +2558,7 @@ StringEndCmd(
} else {
cur = numChars;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(cur));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(cur));
return TCL_OK;
}
@@ -2600,7 +2594,7 @@ StringEqualCmd(
*/
const char *string2;
- int length2, i, match, nocase = 0, reqlength = -1;
+ int length, i, match, nocase = 0, reqlength = -1;
if (objc < 3 || objc > 6) {
str_cmp_args:
@@ -2610,11 +2604,11 @@ StringEqualCmd(
}
for (i = 1; i < objc-2; i++) {
- string2 = TclGetStringFromObj(objv[i], &length2);
- if ((length2 > 1) && !strncmp(string2, "-nocase", (size_t)length2)) {
+ string2 = TclGetStringFromObj(objv[i], &length);
+ if ((length > 1) && !strncmp(string2, "-nocase", (size_t)length)) {
nocase = 1;
- } else if ((length2 > 1)
- && !strncmp(string2, "-length", (size_t)length2)) {
+ } else if ((length > 1)
+ && !strncmp(string2, "-length", (size_t)length)) {
if (i+1 >= objc-2) {
goto str_cmp_args;
}
@@ -2683,191 +2677,12 @@ StringCmpCmd(
objv += objc-2;
match = TclStringCmp(objv[0], objv[1], 0, nocase, reqlength);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(match));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(match));
return TCL_OK;
}
-/*
- *----------------------------------------------------------------------
- *
- * TclStringCmp --
- *
- * This is the core of Tcl's string comparison. It only handles byte
- * arrays, UNICODE strings and UTF-8 strings correctly.
- *
- * Results:
- * -1 if value1Ptr is less than value2Ptr, 0 if they are equal, or 1 if
- * value1Ptr is greater.
- *
- * Side effects:
- * May cause string representations of objects to be allocated.
- *
- *----------------------------------------------------------------------
- */
-
int
-TclStringCmp(
- Tcl_Obj *value1Ptr,
- Tcl_Obj *value2Ptr,
- int checkEq, /* comparison is only for equality */
- int nocase, /* comparison is not case sensitive */
- int reqlength) /* requested length; -1 to compare whole
- * strings */
-{
- char *s1, *s2;
- int empty, length, match, s1len, s2len;
- memCmpFn_t memCmpFn;
-
- if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
- /*
- * Always match at 0 chars or if it is the same obj.
- */
- return 0;
- }
-
- if (!nocase && TclIsPureByteArray(value1Ptr)
- && TclIsPureByteArray(value2Ptr)) {
- /*
- * 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... :^)
- */
-
- s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
- s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
- memCmpFn = memcmp;
- } else if ((value1Ptr->typePtr == &tclStringType)
- && (value2Ptr->typePtr == &tclStringType)) {
- /*
- * Do a unicode-specific comparison if both of the args are of String
- * type. If the char length == byte length, we can do a memcmp. In
- * benchmark testing this proved the most efficient check between the
- * unicode and string comparison operations.
- */
-
- if (nocase) {
- s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
- s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
- memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
- } else {
- s1len = Tcl_GetCharLength(value1Ptr);
- s2len = Tcl_GetCharLength(value2Ptr);
- if ((s1len == value1Ptr->length)
- && (value1Ptr->bytes != NULL)
- && (s2len == value2Ptr->length)
- && (value2Ptr->bytes != NULL)) {
- s1 = value1Ptr->bytes;
- s2 = value2Ptr->bytes;
- memCmpFn = memcmp;
- } else {
- s1 = (char *) Tcl_GetUnicode(value1Ptr);
- s2 = (char *) Tcl_GetUnicode(value2Ptr);
- if (
-#ifdef WORDS_BIGENDIAN
- 1
-#else
- checkEq
-#endif /* WORDS_BIGENDIAN */
- ) {
- memCmpFn = memcmp;
- s1len *= sizeof(Tcl_UniChar);
- s2len *= sizeof(Tcl_UniChar);
- } else {
- memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
- }
- }
- }
- } else {
- /*
- * Get the string representations, being careful in case we have
- * special empty string objects about.
- */
-
- empty = TclCheckEmptyString(value1Ptr);
- if (empty > 0) {
- switch (TclCheckEmptyString(value2Ptr)) {
- case -1:
- s1 = "";
- s1len = 0;
- s2 = TclGetStringFromObj(value2Ptr, &s2len);
- break;
- case 0:
- return -1;
- default: /* avoid warn: `s2` may be used uninitialized */
- return 0;
- }
- } else if (TclCheckEmptyString(value2Ptr) > 0) {
- switch (empty) {
- case -1:
- s2 = "";
- s2len = 0;
- s1 = TclGetStringFromObj(value1Ptr, &s1len);
- break;
- case 0:
- return 1;
- default: /* avoid warn: `s1` may be used uninitialized */
- return 0;
- }
- } else {
- s1 = TclGetStringFromObj(value1Ptr, &s1len);
- s2 = TclGetStringFromObj(value2Ptr, &s2len);
- }
-
- if (!nocase && checkEq) {
- /*
- * When we have equal-length we can check only for (in)equality.
- * We can use memcmp() in all (n)eq cases because we don't need to
- * worry about lexical LE/BE variance.
- */
- memCmpFn = memcmp;
- } else {
- /*
- * As a catch-all we will work with UTF-8. We cannot use memcmp()
- * as that is unsafe with any string containing NUL (\xC0\x80 in
- * Tcl's utf rep). We can use the more efficient TclpUtfNcmp2 if
- * we are case-sensitive and no specific length was requested.
- */
-
- if ((reqlength < 0) && !nocase) {
- memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
- } else {
- s1len = Tcl_NumUtfChars(s1, s1len);
- s2len = Tcl_NumUtfChars(s2, s2len);
- memCmpFn = (memCmpFn_t)
- (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
- }
- }
- }
-
- length = (s1len < s2len) ? s1len : s2len;
- if (reqlength > 0 && reqlength < length) {
- length = reqlength;
- } else if (reqlength < 0) {
- /*
- * The requested length is negative, so we ignore it by setting it to
- * length + 1 so we correct the match var.
- */
-
- reqlength = length + 1;
- }
-
- if (checkEq && (s1len != s2len)) {
- match = 1; /* This will be reversed below. */
- } else {
- /*
- * The comparison function should compare up to the minimum byte
- * length only.
- */
- match = memCmpFn(s1, s2, (size_t) length);
- }
- if ((match == 0) && (reqlength > length)) {
- match = s1len - s2len;
- }
- return (match > 0) ? 1 : (match < 0) ? -1 : 0;
-}
-
-int TclStringCmpOpts(
+TclStringCmpOpts(
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[], /* Argument objects. */
@@ -2935,7 +2750,6 @@ StringCatCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- int i;
Tcl_Obj *objResultPtr;
if (objc < 2) {
@@ -2945,23 +2759,15 @@ StringCatCmd(
*/
return TCL_OK;
}
- if (objc == 2) {
- /*
- * Other trivial case, single arg, just return it.
- */
- Tcl_SetObjResult(interp, objv[1]);
+
+ objResultPtr = TclStringCat(interp, objc-1, objv+1, TCL_STRING_IN_PLACE);
+
+ if (objResultPtr) {
+ Tcl_SetObjResult(interp, objResultPtr);
return TCL_OK;
}
- objResultPtr = objv[1];
- if (Tcl_IsShared(objResultPtr)) {
- objResultPtr = Tcl_DuplicateObj(objResultPtr);
- }
- for(i = 2;i < objc;i++) {
- Tcl_AppendObjToObj(objResultPtr, objv[i]);
- }
- Tcl_SetObjResult(interp, objResultPtr);
- return TCL_OK;
+ return TCL_ERROR;
}
/*
@@ -2982,7 +2788,6 @@ StringCatCmd(
*
*----------------------------------------------------------------------
*/
-
static int
StringBytesCmd(
ClientData dummy, /* Not used. */
@@ -2998,7 +2803,7 @@ StringBytesCmd(
}
(void) TclGetStringFromObj(objv[1], &length);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(length));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(length));
return TCL_OK;
}
@@ -3032,7 +2837,7 @@ StringLenCmd(
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_GetCharLength(objv[1])));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_GetCharLength(objv[1])));
return TCL_OK;
}
@@ -3635,7 +3440,7 @@ TclNRSwitchObjCmd(
OPT_LAST
};
typedef int (*strCmpFn_t)(const char *, const char *);
- strCmpFn_t strCmpFn = strcmp;
+ strCmpFn_t strCmpFn = TclUtfCmp;
mode = OPT_EXACT;
foundmode = 0;
@@ -3921,10 +3726,10 @@ TclNRSwitchObjCmd(
Tcl_Obj *rangeObjAry[2];
if (info.matches[j].end > 0) {
- rangeObjAry[0] = Tcl_NewLongObj(info.matches[j].start);
- rangeObjAry[1] = Tcl_NewLongObj(info.matches[j].end-1);
+ rangeObjAry[0] = Tcl_NewWideIntObj(info.matches[j].start);
+ rangeObjAry[1] = Tcl_NewWideIntObj(info.matches[j].end-1);
} else {
- rangeObjAry[0] = rangeObjAry[1] = Tcl_NewIntObj(-1);
+ rangeObjAry[0] = rangeObjAry[1] = Tcl_NewWideIntObj(-1);
}
/*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index d8f0aeb..c472b8c 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -912,7 +912,7 @@ TclCompileConcatCmd(
Tcl_ListObjGetElements(NULL, listObj, &len, &objs);
objPtr = Tcl_ConcatObj(len, objs);
Tcl_DecrRefCount(listObj);
- bytes = Tcl_GetStringFromObj(objPtr, &len);
+ bytes = TclGetStringFromObj(objPtr, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(objPtr);
return TCL_OK;
@@ -1320,7 +1320,7 @@ TclCompileDictCreateCmd(
* We did! Excellent. The "verifyDict" is to do type forcing.
*/
- bytes = Tcl_GetStringFromObj(dictObj, &len);
+ bytes = TclGetStringFromObj(dictObj, &len);
PushLiteral(envPtr, bytes, len);
TclEmitOpcode( INST_DUP, envPtr);
TclEmitOpcode( INST_DICT_VERIFY, envPtr);
@@ -2761,7 +2761,7 @@ CompileEachloopCmd(
int numBytes, varIndex;
Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj);
- bytes = Tcl_GetStringFromObj(varNameObj, &numBytes);
+ bytes = TclGetStringFromObj(varNameObj, &numBytes);
varIndex = LocalScalar(bytes, numBytes, envPtr);
if (varIndex < 0) {
code = TCL_ERROR;
@@ -3198,7 +3198,7 @@ TclCompileFormatCmd(
* literal. Job done.
*/
- bytes = Tcl_GetStringFromObj(tmpObj, &len);
+ bytes = TclGetStringFromObj(tmpObj, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(tmpObj);
return TCL_OK;
@@ -3269,7 +3269,7 @@ TclCompileFormatCmd(
if (*++bytes == '%') {
Tcl_AppendToObj(tmpObj, "%", 1);
} else {
- char *b = Tcl_GetStringFromObj(tmpObj, &len);
+ char *b = TclGetStringFromObj(tmpObj, &len);
/*
* If there is a non-empty literal from the format string,
@@ -3303,7 +3303,7 @@ TclCompileFormatCmd(
*/
Tcl_AppendToObj(tmpObj, start, bytes - start);
- bytes = Tcl_GetStringFromObj(tmpObj, &len);
+ bytes = TclGetStringFromObj(tmpObj, &len);
if (len > 0) {
PushLiteral(envPtr, bytes, len);
i++;
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 1094352..26e9c87 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -27,7 +27,6 @@ static void CompileReturnInternal(CompileEnv *envPtr,
Tcl_Obj *returnOpts);
static int IndexTailVarIfKnown(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr);
-
/*
*----------------------------------------------------------------------
@@ -35,7 +34,7 @@ static int IndexTailVarIfKnown(Tcl_Interp *interp,
* TclGetIndexFromToken --
*
* Parse a token to determine if an index value is known at
- * compile time.
+ * compile time.
*
* Returns:
* TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
@@ -127,9 +126,12 @@ TclCompileGlobalCmd(
return TCL_ERROR;
}
- /* TODO: Consider what value can pass through the
- * IndexTailVarIfKnown() screen. Full CompileWord()
- * likely does not apply here. Push known value instead. */
+ /*
+ * TODO: Consider what value can pass through the
+ * IndexTailVarIfKnown() screen. Full CompileWord() likely does not
+ * apply here. Push known value instead.
+ */
+
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_NSUPVAR, localIndex, envPtr);
}
@@ -270,7 +272,7 @@ TclCompileIfCmd(
jumpIndex = jumpFalseFixupArray.next;
jumpFalseFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_FALSE_JUMP,
- jumpFalseFixupArray.fixup+jumpIndex);
+ jumpFalseFixupArray.fixup + jumpIndex);
}
code = TCL_OK;
}
@@ -317,7 +319,7 @@ TclCompileIfCmd(
}
jumpEndFixupArray.next++;
TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP,
- jumpEndFixupArray.fixup+jumpIndex);
+ jumpEndFixupArray.fixup + jumpIndex);
/*
* Fix the target of the jumpFalse after the test. Generate a 4
@@ -329,7 +331,7 @@ TclCompileIfCmd(
TclAdjustStackDepth(-1, envPtr);
if (TclFixupForwardJumpToHere(envPtr,
- jumpFalseFixupArray.fixup+jumpIndex, 120)) {
+ jumpFalseFixupArray.fixup + jumpIndex, 120)) {
/*
* Adjust the code offset for the proceeding jump to the end
* of the "if" command.
@@ -412,7 +414,7 @@ TclCompileIfCmd(
for (j = jumpEndFixupArray.next; j > 0; j--) {
jumpIndex = (j - 1); /* i.e. process the closest jump first. */
if (TclFixupForwardJumpToHere(envPtr,
- jumpEndFixupArray.fixup+jumpIndex, 127)) {
+ jumpEndFixupArray.fixup + jumpIndex, 127)) {
/*
* Adjust the immediately preceeding "ifFalse" jump. We moved it's
* target (just after this jump) down three bytes.
@@ -920,7 +922,7 @@ TclCompileLappendCmd(
CompileWord(envPtr, valueTokenPtr, interp, i);
valueTokenPtr = TokenAfter(valueTokenPtr);
}
- TclEmitInstInt4( INST_LIST, numWords-2, envPtr);
+ TclEmitInstInt4( INST_LIST, numWords - 2, envPtr);
if (isScalar) {
if (localIndex < 0) {
TclEmitOpcode( INST_LAPPEND_LIST_STK, envPtr);
@@ -997,7 +999,7 @@ TclCompileLassignCmd(
*/
PushVarNameWord(interp, tokenPtr, envPtr, 0, &localIndex,
- &isScalar, idx+2);
+ &isScalar, idx + 2);
/*
* Emit instructions to get the idx'th item out of the list value on
@@ -1087,8 +1089,8 @@ TclCompileLindexCmd(
}
idxTokenPtr = TokenAfter(valTokenPtr);
- if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_BEFORE,
- &idx) == TCL_OK) {
+ if (TclGetIndexFromToken(idxTokenPtr, TCL_INDEX_NONE,
+ TCL_INDEX_NONE, &idx) == TCL_OK) {
/*
* The idxTokenPtr parsed as a valid index value and was
* encoded as expected by INST_LIST_INDEX_IMM.
@@ -1316,8 +1318,8 @@ TclCompileLrangeCmd(
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
tokenPtr = TokenAfter(listTokenPtr);
- if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
- &idx1) != TCL_OK) {
+ if ((TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
+ &idx1) != TCL_OK) || (idx1 == TCL_INDEX_NONE)) {
return TCL_ERROR;
}
/*
@@ -1326,7 +1328,7 @@ TclCompileLrangeCmd(
*/
tokenPtr = TokenAfter(tokenPtr);
- if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
+ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
&idx2) != TCL_OK) {
return TCL_ERROR;
}
@@ -1414,7 +1416,7 @@ TclCompileLinsertCmd(
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, i);
}
- TclEmitInstInt4( INST_LIST, i-3, envPtr);
+ TclEmitInstInt4( INST_LIST, i - 3, envPtr);
if (idx == TCL_INDEX_START) {
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
@@ -1439,7 +1441,7 @@ TclCompileLinsertCmd(
}
TclEmitInstInt4( INST_OVER, 1, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, 0, envPtr);
- TclEmitInt4( idx-1, envPtr);
+ TclEmitInt4( idx - 1, envPtr);
TclEmitInstInt4( INST_REVERSE, 3, envPtr);
TclEmitInstInt4( INST_LIST_RANGE_IMM, idx, envPtr);
TclEmitInt4( TCL_INDEX_END, envPtr);
@@ -1481,13 +1483,13 @@ TclCompileLreplaceCmd(
listTokenPtr = TokenAfter(parsePtr->tokenPtr);
tokenPtr = TokenAfter(listTokenPtr);
- if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
+ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
&idx1) != TCL_OK) {
return TCL_ERROR;
}
tokenPtr = TokenAfter(tokenPtr);
- if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
+ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
&idx2) != TCL_OK) {
return TCL_ERROR;
}
@@ -1503,12 +1505,12 @@ TclCompileLreplaceCmd(
* we must defer to direct evaluation.
*/
- if (idx1 == TCL_INDEX_AFTER) {
- suffixStart = idx1;
- } else if (idx2 == TCL_INDEX_BEFORE) {
+ if (idx1 == TCL_INDEX_NONE) {
+ suffixStart = TCL_INDEX_NONE;
+ } else if (idx2 == TCL_INDEX_NONE) {
suffixStart = idx1;
} else if (idx2 == TCL_INDEX_END) {
- suffixStart = TCL_INDEX_AFTER;
+ suffixStart = TCL_INDEX_NONE;
} else if (((idx2 < TCL_INDEX_END) && (idx1 <= TCL_INDEX_END))
|| ((idx2 >= TCL_INDEX_START) && (idx1 >= TCL_INDEX_START))) {
suffixStart = (idx1 > idx2 + 1) ? idx1 : idx2 + 1;
@@ -1536,7 +1538,7 @@ TclCompileLreplaceCmd(
emptyPrefix = 0;
}
-
+
if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
/*
* This is a "no-op". Example: [lreplace {a b c} 2 0]
@@ -1568,7 +1570,7 @@ TclCompileLreplaceCmd(
TclEmitInstInt4( INST_REVERSE, 2, envPtr);
}
- if (suffixStart == TCL_INDEX_AFTER) {
+ if (suffixStart == TCL_INDEX_NONE) {
TclEmitOpcode( INST_POP, envPtr);
if (emptyPrefix) {
PushStringLiteral(envPtr, "");
@@ -2183,7 +2185,7 @@ TclCompileRegexpCmd(
}
if (!simple) {
- CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-2);
+ CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 2);
}
/*
@@ -2191,7 +2193,7 @@ TclCompileRegexpCmd(
*/
varTokenPtr = TokenAfter(varTokenPtr);
- CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords-1);
+ CompileWord(envPtr, varTokenPtr, interp, parsePtr->numWords - 1);
if (simple) {
if (exact && !nocase) {
@@ -2325,7 +2327,7 @@ TclCompileRegsubCmd(
* replacement "simple"?
*/
- bytes = Tcl_GetStringFromObj(patternObj, &len);
+ bytes = TclGetStringFromObj(patternObj, &len);
if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
!= TCL_OK || exact || quantified) {
goto done;
@@ -2373,9 +2375,9 @@ TclCompileRegsubCmd(
result = TCL_OK;
bytes = Tcl_DStringValue(&pattern) + 1;
PushLiteral(envPtr, bytes, len);
- bytes = Tcl_GetStringFromObj(replacementObj, &len);
+ bytes = TclGetStringFromObj(replacementObj, &len);
PushLiteral(envPtr, bytes, len);
- CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords-2);
+ CompileWord(envPtr, stringTokenPtr, interp, parsePtr->numWords - 2);
TclEmitOpcode( INST_STR_MAP, envPtr);
done:
@@ -2504,7 +2506,7 @@ TclCompileReturnCmd(
*/
if (explicitResult) {
- CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+ CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
} else {
/*
* No explict result argument, so default result is empty string.
@@ -2582,7 +2584,7 @@ TclCompileReturnCmd(
*/
if (explicitResult) {
- CompileWord(envPtr, wordTokenPtr, interp, numWords-1);
+ CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
} else {
PushStringLiteral(envPtr, "");
}
@@ -2635,7 +2637,7 @@ TclCompileSyntaxError(
const char *bytes = TclGetStringFromObj(msg, &numBytes);
TclErrorStackResetIf(interp, bytes, numBytes);
- TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
+ TclEmitPush(TclRegisterLiteral(envPtr, bytes, numBytes, 0), envPtr);
CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
TclNoErrorStack(interp, Tcl_GetReturnOptions(interp, TCL_ERROR)));
Tcl_ResetResult(interp);
@@ -2813,12 +2815,12 @@ TclCompileVariableCmd(
CompileWord(envPtr, varTokenPtr, interp, i);
TclEmitInstInt4( INST_VARIABLE, localIndex, envPtr);
- if (i+1 < numWords) {
+ if (i + 1 < numWords) {
/*
* A value has been given: set the variable, pop the value
*/
- CompileWord(envPtr, valueTokenPtr, interp, i+1);
+ CompileWord(envPtr, valueTokenPtr, interp, i + 1);
Emit14Inst( INST_STORE_SCALAR, localIndex, envPtr);
TclEmitOpcode( INST_POP, envPtr);
}
@@ -2894,7 +2896,7 @@ IndexTailVarIfKnown(
tailName = TclGetStringFromObj(tailPtr, &len);
if (len) {
- if (*(tailName+len-1) == ')') {
+ if (*(tailName + len - 1) == ')') {
/*
* Possible array: bail out
*/
@@ -2908,7 +2910,7 @@ IndexTailVarIfKnown(
*/
for (p = tailName + len -1; p > tailName; p--) {
- if ((*p == ':') && (*(p-1) == ':')) {
+ if ((*p == ':') && (*(p - 1) == ':')) {
p++;
break;
}
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index c13376b..daab0d5 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -260,7 +260,7 @@ TclCompileStringCatCmd(
Tcl_DecrRefCount(obj);
if (folded) {
int len;
- const char *bytes = Tcl_GetStringFromObj(folded, &len);
+ const char *bytes = TclGetStringFromObj(folded, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(folded);
@@ -278,7 +278,7 @@ TclCompileStringCatCmd(
}
if (folded) {
int len;
- const char *bytes = Tcl_GetStringFromObj(folded, &len);
+ const char *bytes = TclGetStringFromObj(folded, &len);
PushLiteral(envPtr, bytes, len);
Tcl_DecrRefCount(folded);
@@ -461,7 +461,7 @@ TclCompileStringIsCmd(
Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
static const char *const isClasses[] = {
"alnum", "alpha", "ascii", "control",
- "boolean", "digit", "double", "entier",
+ "boolean", "dict", "digit", "double", "entier",
"false", "graph", "integer", "list",
"lower", "print", "punct", "space",
"true", "upper", "wideinteger", "wordchar",
@@ -469,7 +469,7 @@ TclCompileStringIsCmd(
};
enum isClasses {
STR_IS_ALNUM, STR_IS_ALPHA, STR_IS_ASCII, STR_IS_CONTROL,
- STR_IS_BOOL, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
+ STR_IS_BOOL, STR_IS_DICT, STR_IS_DIGIT, STR_IS_DOUBLE, STR_IS_ENTIER,
STR_IS_FALSE, STR_IS_GRAPH, STR_IS_INT, STR_IS_LIST,
STR_IS_LOWER, STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,
STR_IS_TRUE, STR_IS_UPPER, STR_IS_WIDE, STR_IS_WORD,
@@ -691,14 +691,11 @@ TclCompileStringIsCmd(
}
switch (t) {
- case STR_IS_INT:
- PUSH( "1");
- OP( EQ);
- break;
case STR_IS_WIDE:
PUSH( "2");
OP( LE);
break;
+ case STR_IS_INT:
case STR_IS_ENTIER:
PUSH( "3");
OP( LE);
@@ -706,7 +703,19 @@ TclCompileStringIsCmd(
}
FIXJUMP1( end);
return TCL_OK;
-
+ case STR_IS_DICT:
+ range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+ OP4( BEGIN_CATCH4, range);
+ ExceptionRangeStarts(envPtr, range);
+ OP( DUP);
+ OP( DICT_VERIFY);
+ ExceptionRangeEnds(envPtr, range);
+ ExceptionRangeTarget(envPtr, range, catchOffset);
+ OP( POP);
+ OP( PUSH_RETURN_CODE);
+ OP( END_CATCH);
+ OP( LNOT);
+ return TCL_OK;
case STR_IS_LIST:
range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
OP4( BEGIN_CATCH4, range);
@@ -896,12 +905,12 @@ TclCompileStringMapCmd(
* correct semantics for mapping.
*/
- bytes = Tcl_GetStringFromObj(objv[0], &len);
+ bytes = TclGetStringFromObj(objv[0], &len);
if (len == 0) {
CompileWord(envPtr, stringTokenPtr, interp, 2);
} else {
PushLiteral(envPtr, bytes, len);
- bytes = Tcl_GetStringFromObj(objv[1], &len);
+ bytes = TclGetStringFromObj(objv[1], &len);
PushLiteral(envPtr, bytes, len);
CompileWord(envPtr, stringTokenPtr, interp, 2);
OP(STR_MAP);
@@ -937,7 +946,7 @@ TclCompileStringRangeCmd(
* Parse the two indices.
*/
- if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_AFTER,
+ if (TclGetIndexFromToken(fromTokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
&idx1) != TCL_OK) {
goto nonConstantIndices;
}
@@ -946,14 +955,14 @@ TclCompileStringRangeCmd(
* the string the same as the start of the string.
*/
- if (idx1 == TCL_INDEX_AFTER) {
+ if (idx1 == TCL_INDEX_NONE) {
/* [string range $s end+1 $last] must be empty string */
OP( POP);
PUSH( "");
return TCL_OK;
}
- if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_END,
+ if (TclGetIndexFromToken(toTokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
&idx2) != TCL_OK) {
goto nonConstantIndices;
}
@@ -961,7 +970,7 @@ TclCompileStringRangeCmd(
* Token parsed as an index expression. We treat all indices after
* the string the same as the end of the string.
*/
- if (idx2 == TCL_INDEX_BEFORE) {
+ if (idx2 == TCL_INDEX_NONE) {
/* [string range $s $first -1] must be empty string */
OP( POP);
PUSH( "");
@@ -1002,30 +1011,30 @@ TclCompileStringReplaceCmd(
if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
return TCL_ERROR;
}
-
+
/* Bytecode to compute/push string argument being replaced */
valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
CompileWord(envPtr, valueTokenPtr, interp, 1);
/*
- * Check for first index known and useful at compile time.
+ * Check for first index known and useful at compile time.
*/
tokenPtr = TokenAfter(valueTokenPtr);
- if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
+ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
&first) != TCL_OK) {
goto genericReplace;
}
/*
- * Check for last index known and useful at compile time.
+ * Check for last index known and useful at compile time.
*/
tokenPtr = TokenAfter(tokenPtr);
- if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
+ if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
&last) != TCL_OK) {
goto genericReplace;
}
- /*
+ /*
* [string replace] is an odd bird. For many arguments it is
* a conventional substring replacer. However it also goes out
* of its way to become a no-op for many cases where it would be
@@ -1039,8 +1048,8 @@ TclCompileStringReplaceCmd(
* compile direct to bytecode implementing the no-op.
*/
- if ((last == TCL_INDEX_BEFORE) /* Know (last < 0) */
- || (first == TCL_INDEX_AFTER) /* Know (first > end) */
+ if ((last == TCL_INDEX_NONE) /* Know (last < 0) */
+ || (first == TCL_INDEX_NONE) /* Know (first > end) */
/*
* Tricky to determine when runtime (last < first) can be
@@ -1048,20 +1057,17 @@ TclCompileStringReplaceCmd(
* cases...
*
* (first <= TCL_INDEX_END) &&
- * (last == TCL_INDEX_AFTER) => cannot tell REJECT
* (last <= TCL_INDEX END) && (last < first) => ACCEPT
* else => cannot tell REJECT
*/
|| ((first <= TCL_INDEX_END) && (last <= TCL_INDEX_END)
&& (last < first)) /* Know (last < first) */
/*
- * (first == TCL_INDEX_BEFORE) &&
- * (last == TCL_INDEX_AFTER) => (first < last) REJECT
+ * (first == TCL_INDEX_NONE) &&
* (last <= TCL_INDEX_END) => cannot tell REJECT
* else => (first < last) REJECT
*
* else [[first >= TCL_INDEX_START]] &&
- * (last == TCL_INDEX_AFTER) => cannot tell REJECT
* (last <= TCL_INDEX_END) => cannot tell REJECT
* else [[last >= TCL_INDEX START]] && (last < first) => ACCEPT
*/
@@ -1094,34 +1100,34 @@ TclCompileStringReplaceCmd(
* (first <= end)
*
* The encoded indices (first <= TCL_INDEX END) and
- * (first == TCL_INDEX_BEFORE) always meets this condition, but
+ * (first == TCL_INDEX_NONE) always meets this condition, but
* any other encoded first index has some list for which it fails.
*
* We also need, second:
*
* (last >= 0)
*
- * The encoded indices (last >= TCL_INDEX_START) and
- * (last == TCL_INDEX_AFTER) always meet this condition but any
- * other encoded last index has some list for which it fails.
+ * The encoded index (last >= TCL_INDEX_START) always meet this
+ * condition but any other encoded last index has some list for
+ * which it fails.
*
* Finally we need, third:
*
* (first <= last)
- *
+ *
* Considered in combination with the constraints we already have,
- * we see that we can proceed when (first == TCL_INDEX_BEFORE)
- * or (last == TCL_INDEX_AFTER). These also permit simplification
- * of the prefix|replace|suffix construction. The other constraints,
- * though, interfere with getting a guarantee that first <= last.
+ * we see that we can proceed when (first == TCL_INDEX_NONE).
+ * These also permit simplification of the prefix|replace|suffix
+ * construction. The other constraints, though, interfere with
+ * getting a guarantee that first <= last.
*/
- if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) {
+ if ((first == TCL_INDEX_START) && (last >= TCL_INDEX_START)) {
/* empty prefix */
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 4);
OP4( REVERSE, 2);
- if (last == TCL_INDEX_AFTER) {
+ if (last == INT_MAX) {
OP( POP); /* Pop original */
} else {
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
@@ -1130,7 +1136,7 @@ TclCompileStringReplaceCmd(
return TCL_OK;
}
- if ((last == TCL_INDEX_AFTER) && (first <= TCL_INDEX_END)) {
+ if ((last == TCL_INDEX_NONE) && (first <= TCL_INDEX_END)) {
OP44( STR_RANGE_IMM, 0, first-1);
tokenPtr = TokenAfter(tokenPtr);
CompileWord(envPtr, tokenPtr, interp, 4);
@@ -1141,16 +1147,16 @@ TclCompileStringReplaceCmd(
/* FLOW THROUGH TO genericReplace */
} else {
- /*
+ /*
* When we have no replacement string to worry about, we may
* have more luck, because the forbidden empty string replacements
* are harmless when they are replaced by another empty string.
*/
- if ((first == TCL_INDEX_BEFORE) || (first == TCL_INDEX_START)) {
+ if (first == TCL_INDEX_START) {
/* empty prefix - build suffix only */
- if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
+ if (last == TCL_INDEX_END) {
/* empty suffix too => empty result */
OP( POP); /* Pop original */
PUSH ( "");
@@ -1159,7 +1165,7 @@ TclCompileStringReplaceCmd(
OP44( STR_RANGE_IMM, last + 1, TCL_INDEX_END);
return TCL_OK;
} else {
- if ((last == TCL_INDEX_END) || (last == TCL_INDEX_AFTER)) {
+ if (last == TCL_INDEX_END) {
/* empty suffix - build prefix only */
OP44( STR_RANGE_IMM, 0, first-1);
return TCL_OK;
@@ -1353,7 +1359,7 @@ static int
UniCharIsHexDigit(
int character)
{
- return (character >= 0) && (character < 0x80) && isxdigit(character);
+ return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
}
StringClassDesc const tclStringClassTable[] = {
@@ -1502,8 +1508,8 @@ TclSubstCompile(
switch (tokenPtr->type) {
case TCL_TOKEN_TEXT:
- literal = TclRegisterNewLiteral(envPtr,
- tokenPtr->start, tokenPtr->size);
+ literal = TclRegisterLiteral(envPtr,
+ tokenPtr->start, tokenPtr->size, 0);
TclEmitPush(literal, envPtr);
TclAdvanceLines(&bline, tokenPtr->start,
tokenPtr->start + tokenPtr->size);
@@ -1512,7 +1518,7 @@ TclSubstCompile(
case TCL_TOKEN_BS:
length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
NULL, buf);
- literal = TclRegisterNewLiteral(envPtr, buf, length);
+ literal = TclRegisterLiteral(envPtr, buf, length, 0);
TclEmitPush(literal, envPtr);
count++;
continue;
@@ -1948,10 +1954,10 @@ TclCompileSwitchCmd(
}
if (numWords % 2) {
abort:
- ckfree((char *) bodyToken);
- ckfree((char *) bodyTokenArray);
- ckfree((char *) bodyLines);
- ckfree((char *) bodyContLines);
+ ckfree(bodyToken);
+ ckfree(bodyTokenArray);
+ ckfree(bodyLines);
+ ckfree(bodyContLines);
return TCL_ERROR;
}
} else if (numWords % 2 || numWords == 0) {
@@ -2871,7 +2877,7 @@ TclCompileTryCmd(
}
if (objc > 0) {
int len;
- const char *varname = Tcl_GetStringFromObj(objv[0], &len);
+ const char *varname = TclGetStringFromObj(objv[0], &len);
resultVarIndices[i] = LocalScalar(varname, len, envPtr);
if (resultVarIndices[i] < 0) {
@@ -2883,7 +2889,7 @@ TclCompileTryCmd(
}
if (objc == 2) {
int len;
- const char *varname = Tcl_GetStringFromObj(objv[1], &len);
+ const char *varname = TclGetStringFromObj(objv[1], &len);
optionVarIndices[i] = LocalScalar(varname, len, envPtr);
if (optionVarIndices[i] < 0) {
@@ -3086,7 +3092,7 @@ IssueTryClausesInstructions(
OP4( DICT_GET, 1);
TclAdjustStackDepth(-1, envPtr);
OP44( LIST_RANGE_IMM, 0, len-1);
- p = Tcl_GetStringFromObj(matchClauses[i], &len);
+ p = TclGetStringFromObj(matchClauses[i], &len);
PushLiteral(envPtr, p, len);
OP( STR_EQ);
JUMP4( JUMP_FALSE, notECJumpSource);
@@ -3297,7 +3303,7 @@ IssueTryClausesFinallyInstructions(
OP4( DICT_GET, 1);
TclAdjustStackDepth(-1, envPtr);
OP44( LIST_RANGE_IMM, 0, len-1);
- p = Tcl_GetStringFromObj(matchClauses[i], &len);
+ p = TclGetStringFromObj(matchClauses[i], &len);
PushLiteral(envPtr, p, len);
OP( STR_EQ);
JUMP4( JUMP_FALSE, notECJumpSource);
@@ -3625,7 +3631,7 @@ TclCompileUnsetCmd(
const char *bytes;
int len;
- bytes = Tcl_GetStringFromObj(leadingWord, &len);
+ bytes = TclGetStringFromObj(leadingWord, &len);
if (i == 1 && len == 11 && !strncmp("-nocomplain", bytes, 11)) {
flags = 0;
haveFlags++;
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 9c7ab8d..e96e264 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -1759,7 +1759,7 @@ ConvertTreeToTokens(
/*
* All the Tcl_Tokens allocated and filled belong to
- * this subexpresion. The first token is the leading
+ * this subexpression. The first token is the leading
* TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
* are its components.
*/
@@ -2181,7 +2181,6 @@ ExecConstantExprTree(
CompileEnv *envPtr;
ByteCode *byteCodePtr;
int code;
- Tcl_Obj *byteCodeObj = Tcl_NewObj();
NRE_callback *rootPtr = TOP_CB(interp);
/*
@@ -2195,14 +2194,12 @@ ExecConstantExprTree(
CompileExprTree(interp, nodes, index, litObjvPtr, NULL, NULL, envPtr,
0 /* optimize */);
TclEmitOpcode(INST_DONE, envPtr);
- Tcl_IncrRefCount(byteCodeObj);
- TclInitByteCodeObj(byteCodeObj, envPtr);
+ byteCodePtr = TclInitByteCode(envPtr);
TclFreeCompileEnv(envPtr);
TclStackFree(interp, envPtr);
- byteCodePtr = byteCodeObj->internalRep.twoPtrValue.ptr1;
TclNRExecuteByteCode(interp, byteCodePtr);
code = TclNRRunCallbacks(interp, TCL_OK, rootPtr);
- Tcl_DecrRefCount(byteCodeObj);
+ TclReleaseByteCode(byteCodePtr);
return code;
}
@@ -2270,9 +2267,9 @@ CompileExprTree(
p = TclGetStringFromObj(*funcObjv, &length);
funcObjv++;
Tcl_DStringAppend(&cmdName, p, length);
- TclEmitPush(TclRegisterNewCmdLiteral(envPtr,
+ TclEmitPush(TclRegisterLiteral(envPtr,
Tcl_DStringValue(&cmdName),
- Tcl_DStringLength(&cmdName)), envPtr);
+ Tcl_DStringLength(&cmdName), LITERAL_CMD_NAME), envPtr);
Tcl_DStringFree(&cmdName);
/*
@@ -2379,8 +2376,8 @@ CompileExprTree(
pc1 = CurrentOffset(envPtr);
TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1
: INST_JUMP_TRUE1, 0, envPtr);
- TclEmitPush(TclRegisterNewLiteral(envPtr,
- (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr);
+ TclEmitPush(TclRegisterLiteral(envPtr,
+ (nodePtr->lexeme == AND) ? "1" : "0", 1, 0), envPtr);
pc2 = CurrentOffset(envPtr);
TclEmitInstInt1(INST_JUMP1, 0, envPtr);
TclAdjustStackDepth(-1, envPtr);
@@ -2389,8 +2386,8 @@ CompileExprTree(
if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) {
pc2 += 3;
}
- TclEmitPush(TclRegisterNewLiteral(envPtr,
- (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr);
+ TclEmitPush(TclRegisterLiteral(envPtr,
+ (nodePtr->lexeme == AND) ? "0" : "1", 1, 0), envPtr);
TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2,
envPtr->codeStart + pc2 + 1);
convert = 0;
@@ -2424,7 +2421,7 @@ CompileExprTree(
if (optimize) {
int length;
const char *bytes = TclGetStringFromObj(literal, &length);
- int index = TclRegisterNewLiteral(envPtr, bytes, length);
+ int index = TclRegisterLiteral(envPtr, bytes, length, 0);
Tcl_Obj *objPtr = TclFetchLiteral(envPtr, index);
if ((objPtr->typePtr == NULL) && (literal->typePtr != NULL)) {
@@ -2479,11 +2476,13 @@ CompileExprTree(
* already, then use it to share via the literal table.
*/
- if (objPtr->bytes) {
+ if (TclHasStringRep(objPtr)) {
Tcl_Obj *tableValue;
+ int numBytes;
+ const char *bytes
+ = Tcl_GetStringFromObj(objPtr, &numBytes);
- index = TclRegisterNewLiteral(envPtr, objPtr->bytes,
- objPtr->length);
+ index = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
tableValue = TclFetchLiteral(envPtr, index);
if ((tableValue->typePtr == NULL) &&
(objPtr->typePtr != NULL)) {
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f716195..f6e6b81 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -666,6 +666,7 @@ InstructionDesc const tclInstructionTable[] = {
* Prototypes for procedures defined later in this file:
*/
+static void CleanupByteCode(ByteCode *codePtr);
static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
static void DupByteCodeInternalRep(Tcl_Obj *srcPtr,
@@ -681,6 +682,7 @@ static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr);
static int GetCmdLocEncodingSize(CompileEnv *envPtr);
static int IsCompactibleCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr);
+static void PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr);
#ifdef TCL_COMPILE_STATS
static void RecordByteCodeStats(ByteCode *codePtr);
#endif /* TCL_COMPILE_STATS */
@@ -723,13 +725,14 @@ static const Tcl_ObjType substCodeType = {
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
};
+#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2
/*
* Helper macros.
*/
#define TclIncrUInt4AtPtr(ptr, delta) \
- TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr));
+ TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr))
/*
*----------------------------------------------------------------------
@@ -768,7 +771,8 @@ TclSetByteCodeFromAny(
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
- int length, result = TCL_OK;
+ size_t length;
+ int result = TCL_OK;
const char *stringPtr;
Proc *procPtr = iPtr->compiledProcPtr;
ContLineLoc *clLocPtr;
@@ -783,7 +787,8 @@ TclSetByteCodeFromAny(
}
#endif
- stringPtr = TclGetStringFromObj(objPtr, &length);
+ stringPtr = TclGetString(objPtr);
+ length = objPtr->length;
/*
* TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and
@@ -871,7 +876,7 @@ TclSetByteCodeFromAny(
#endif /*TCL_COMPILE_DEBUG*/
if (result == TCL_OK) {
- TclInitByteCodeObj(objPtr, &compEnv);
+ (void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv);
#ifdef TCL_COMPILE_DEBUG
if (tclTraceCompile >= 2) {
TclPrintByteCodeObj(interp, objPtr);
@@ -970,18 +975,18 @@ static void
FreeByteCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+ assert(codePtr != NULL);
+
+ TclReleaseByteCode(codePtr);
}
/*
*----------------------------------------------------------------------
*
- * TclCleanupByteCode --
+ * TclReleaseByteCode --
*
* This procedure does all the real work of freeing up a bytecode
* object's ByteCode structure. It's called only when the structure's
@@ -998,7 +1003,26 @@ FreeByteCodeInternalRep(
*/
void
-TclCleanupByteCode(
+TclPreserveByteCode(
+ register ByteCode *codePtr)
+{
+ codePtr->refCount++;
+}
+
+void
+TclReleaseByteCode(
+ register ByteCode *codePtr)
+{
+ if (codePtr->refCount-- > 1) {
+ return;
+ }
+
+ /* Just dropped to refcount==0. Clean up. */
+ CleanupByteCode(codePtr);
+}
+
+static void
+CleanupByteCode(
register ByteCode *codePtr) /* Points to the ByteCode to free. */
{
Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle;
@@ -1265,8 +1289,6 @@ Tcl_NRSubstObj(
*
* Results:
* A (ByteCode *) is returned pointing to the resulting ByteCode.
- * The caller must manage its refCount and arrange for a call to
- * TclCleanupByteCode() when the last reference disappears.
*
* Side effects:
* The Tcl_ObjType of objPtr is changed to the "substcode" type, and the
@@ -1286,24 +1308,26 @@ CompileSubstObj(
Interp *iPtr = (Interp *) interp;
ByteCode *codePtr = NULL;
- if (objPtr->typePtr == &substCodeType) {
+ ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
+
+ if (codePtr != NULL) {
Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
+ if (flags != PTR2INT(SubstFlags(objPtr))
|| ((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
|| (codePtr->localCachePtr !=
iPtr->varFramePtr->localCachePtr)) {
- FreeSubstCodeInternalRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
+ codePtr = NULL;
}
}
- if (objPtr->typePtr != &substCodeType) {
+ if (codePtr == NULL) {
CompileEnv compEnv;
int numBytes;
- const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
+ const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
/* TODO: Check for more TIP 280 */
TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0);
@@ -1311,13 +1335,10 @@ CompileSubstObj(
TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv);
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &substCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
- objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
- objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
+ SubstFlags(objPtr) = INT2PTR(flags);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1356,12 +1377,12 @@ static void
FreeSubstCodeInternalRep(
register Tcl_Obj *objPtr) /* Object whose internal rep to free. */
{
- register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ register ByteCode *codePtr;
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
+ assert(codePtr != NULL);
+
+ TclReleaseByteCode(codePtr);
}
static void
@@ -1374,14 +1395,14 @@ ReleaseCmdWordData(
Tcl_DecrRefCount(eclPtr->path);
}
for (i=0 ; i<eclPtr->nuloc ; i++) {
- ckfree((char *) eclPtr->loc[i].line);
+ ckfree(eclPtr->loc[i].line);
}
if (eclPtr->loc != NULL) {
- ckfree((char *) eclPtr->loc);
+ ckfree(eclPtr->loc);
}
- ckfree((char *) eclPtr);
+ ckfree(eclPtr);
}
/*
@@ -1795,8 +1816,8 @@ CompileCmdLiteral(
extraLiteralFlags |= LITERAL_UNSHARED;
}
- bytes = Tcl_GetStringFromObj(cmdObj, &numBytes);
- cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags);
+ bytes = TclGetStringFromObj(cmdObj, &numBytes);
+ cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags);
if (cmdPtr) {
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr);
@@ -1831,8 +1852,8 @@ TclCompileInvocation(
continue;
}
- objIdx = TclRegisterNewLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
+ objIdx = TclRegisterLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size, 0);
if (envPtr->clNext) {
TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
tokenPtr[1].start - envPtr->source, envPtr->clNext);
@@ -1881,8 +1902,8 @@ CompileExpanded(
continue;
}
- objIdx = TclRegisterNewLiteral(envPtr,
- tokenPtr[1].start, tokenPtr[1].size);
+ objIdx = TclRegisterLiteral(envPtr,
+ tokenPtr[1].start, tokenPtr[1].size, 0);
if (envPtr->clNext) {
TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx),
tokenPtr[1].start - envPtr->source, envPtr->clNext);
@@ -2710,11 +2731,40 @@ TclCompileNoOp(
*----------------------------------------------------------------------
*/
-void
-TclInitByteCodeObj(
- Tcl_Obj *objPtr, /* Points object that should be initialized,
- * and whose string rep contains the source
- * code. */
+static void
+PreventCycle(
+ Tcl_Obj *objPtr,
+ CompileEnv *envPtr)
+{
+ int i;
+
+ for (i = 0; i < envPtr->literalArrayNext; i++) {
+ if (objPtr == TclFetchLiteral(envPtr, i)) {
+ /*
+ * Prevent circular reference where the bytecode intrep of
+ * a value contains a literal which is that same value.
+ * If this is allowed to happen, refcount decrements may not
+ * reach zero, and memory may leak. Bugs 467523, 3357771
+ *
+ * NOTE: [Bugs 3392070, 3389764] We make a copy based completely
+ * on the string value, and do not call Tcl_DuplicateObj() so we
+ * can be sure we do not have any lingering cycles hiding in
+ * the intrep.
+ */
+ int numBytes;
+ const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
+ Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes);
+
+ Tcl_IncrRefCount(copyPtr);
+ TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr);
+
+ envPtr->literalArrayPtr[i].objPtr = copyPtr;
+ }
+ }
+}
+
+ByteCode *
+TclInitByteCode(
register CompileEnv *envPtr)/* Points to the CompileEnv structure from
* which to create a ByteCode structure. */
{
@@ -2765,7 +2815,8 @@ TclInitByteCodeObj(
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = namespacePtr;
codePtr->nsEpoch = namespacePtr->resolverEpoch;
- codePtr->refCount = 1;
+ codePtr->refCount = 0;
+ TclPreserveByteCode(codePtr);
if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
} else {
@@ -2791,29 +2842,7 @@ TclInitByteCodeObj(
p += TCL_ALIGN(codeBytes); /* align object array */
codePtr->objArrayPtr = (Tcl_Obj **) p;
for (i = 0; i < numLitObjects; i++) {
- Tcl_Obj *fetched = TclFetchLiteral(envPtr, i);
-
- if (objPtr == fetched) {
- /*
- * Prevent circular reference where the bytecode intrep of
- * a value contains a literal which is that same value.
- * If this is allowed to happen, refcount decrements may not
- * reach zero, and memory may leak. Bugs 467523, 3357771
- *
- * NOTE: [Bugs 3392070, 3389764] We make a copy based completely
- * on the string value, and do not call Tcl_DuplicateObj() so we
- * can be sure we do not have any lingering cycles hiding in
- * the intrep.
- */
- int numBytes;
- const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes);
-
- codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes);
- Tcl_IncrRefCount(codePtr->objArrayPtr[i]);
- TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr);
- } else {
- codePtr->objArrayPtr[i] = fetched;
- }
+ codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i);
}
p += TCL_ALIGN(objArrayBytes); /* align exception range array */
@@ -2856,15 +2885,6 @@ TclInitByteCodeObj(
#endif /* TCL_COMPILE_STATS */
/*
- * Free the old internal rep then convert the object to a bytecode object
- * by making its internal rep point to the just compiled ByteCode.
- */
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
- objPtr->typePtr = &tclByteCodeType;
-
- /*
* TIP #280. Associate the extended per-word line information with the
* byte code object (internal rep), for use with the bc compiler.
*/
@@ -2877,6 +2897,31 @@ TclInitByteCodeObj(
envPtr->iPtr = NULL;
codePtr->localCachePtr = NULL;
+ return codePtr;
+}
+
+ByteCode *
+TclInitByteCodeObj(
+ Tcl_Obj *objPtr, /* Points object that should be initialized,
+ * and whose string rep contains the source
+ * code. */
+ const Tcl_ObjType *typePtr,
+ register CompileEnv *envPtr)/* Points to the CompileEnv structure from
+ * which to create a ByteCode structure. */
+{
+ ByteCode *codePtr;
+
+ PreventCycle(objPtr, envPtr);
+
+ codePtr = TclInitByteCode(envPtr);
+
+ /*
+ * Free the old internal rep then convert the object to a bytecode object
+ * by making its internal rep point to the just compiled ByteCode.
+ */
+
+ ByteCodeSetIntRep(objPtr, typePtr, codePtr);
+ return codePtr;
}
/*
@@ -2944,7 +2989,8 @@ TclFindCompiledLocal(
varNamePtr = &cachePtr->varName0;
for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
if (*varNamePtr) {
- localName = Tcl_GetStringFromObj(*varNamePtr, &len);
+ localName = TclGetString(*varNamePtr);
+ len = (*varNamePtr)->length;
if ((len == nameBytes) && !strncmp(name, localName, len)) {
return i;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 0466429..cf11e0e 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -266,7 +266,7 @@ typedef struct AuxDataType {
typedef struct AuxData {
const AuxDataType *type; /* Pointer to the AuxData type associated with
* this ClientData. */
- ClientData clientData; /* The compilation data itself. */
+ void *clientData; /* The compilation data itself. */
} AuxData;
/*
@@ -417,7 +417,7 @@ typedef struct ByteCode {
* procs are specific to an interpreter so the
* code emitted will depend on the
* interpreter. */
- int compileEpoch; /* Value of iPtr->compileEpoch when this
+ unsigned int compileEpoch; /* Value of iPtr->compileEpoch when this
* ByteCode was compiled. Used to invalidate
* code when, e.g., commands with compile
* procs are redefined. */
@@ -425,11 +425,11 @@ typedef struct ByteCode {
* compiled. If the code is executed if a
* different namespace, it must be
* recompiled. */
- int nsEpoch; /* Value of nsPtr->resolverEpoch when this
+ unsigned int nsEpoch; /* Value of nsPtr->resolverEpoch when this
* ByteCode was compiled. Used to invalidate
* code when new namespace resolution rules
* are put into effect. */
- int refCount; /* Reference count: set 1 when created plus 1
+ unsigned int refCount; /* Reference count: set 1 when created plus 1
* for each execution of the code currently
* active. This structure can be freed when
* refCount becomes zero. */
@@ -514,6 +514,23 @@ typedef struct ByteCode {
* created. */
#endif /* TCL_COMPILE_STATS */
} ByteCode;
+
+#define ByteCodeSetIntRep(objPtr, typePtr, codePtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (codePtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), (typePtr), &ir); \
+ } while (0)
+
+
+
+#define ByteCodeGetIntRep(objPtr, typePtr, codePtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), (typePtr)); \
+ (codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
/*
* Opcodes for the Tcl bytecode instructions. These must correspond to the
@@ -1069,7 +1086,6 @@ MODULE_SCOPE ByteCode * TclCompileObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
MODULE_SCOPE int TclAttemptCompileProc(Tcl_Interp *interp,
Tcl_Parse *parsePtr, int depth, Command *cmdPtr,
CompileEnv *envPtr);
-MODULE_SCOPE void TclCleanupByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclCleanupStackForBreakContinue(CompileEnv *envPtr,
ExceptionAux *auxPtr);
MODULE_SCOPE void TclCompileCmdWord(Tcl_Interp *interp,
@@ -1098,7 +1114,7 @@ MODULE_SCOPE int TclCreateAuxData(ClientData clientData,
MODULE_SCOPE int TclCreateExceptRange(ExceptionRangeType type,
CompileEnv *envPtr);
MODULE_SCOPE ExecEnv * TclCreateExecEnv(Tcl_Interp *interp, int size);
-MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, char *bytes,
+MODULE_SCOPE Tcl_Obj * TclCreateLiteral(Interp *iPtr, const char *bytes,
int length, unsigned int hash, int *newPtr,
Namespace *nsPtr, int flags,
LiteralEntry **globalPtrPtr);
@@ -1123,8 +1139,9 @@ MODULE_SCOPE void TclFreeCompileEnv(CompileEnv *envPtr);
MODULE_SCOPE void TclFreeJumpFixupArray(JumpFixupArray *fixupArrayPtr);
MODULE_SCOPE int TclGetIndexFromToken(Tcl_Token *tokenPtr,
int before, int after, int *indexPtr);
-MODULE_SCOPE void TclInitByteCodeObj(Tcl_Obj *objPtr,
- CompileEnv *envPtr);
+MODULE_SCOPE ByteCode * TclInitByteCode(CompileEnv *envPtr);
+MODULE_SCOPE ByteCode * TclInitByteCodeObj(Tcl_Obj *objPtr,
+ const Tcl_ObjType *typePtr, CompileEnv *envPtr);
MODULE_SCOPE void TclInitCompileEnv(Tcl_Interp *interp,
CompileEnv *envPtr, const char *string,
int numBytes, const CmdFrame *invoker, int word);
@@ -1161,6 +1178,8 @@ MODULE_SCOPE void TclPushVarName(Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr,
int flags, int *localIndexPtr,
int *isScalarPtr);
+MODULE_SCOPE void TclPreserveByteCode(ByteCode *codePtr);
+MODULE_SCOPE void TclReleaseByteCode(ByteCode *codePtr);
MODULE_SCOPE void TclReleaseLiteral(Tcl_Interp *interp, Tcl_Obj *objPtr);
MODULE_SCOPE void TclInvalidateCmdLiteral(Tcl_Interp *interp,
const char *name, Namespace *nsPtr);
@@ -1215,29 +1234,6 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
#define LITERAL_UNSHARED 0x04
/*
- * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to
- * cast away constness, and it is cleanest to do that here, all in one place.
- *
- * int TclRegisterNewLiteral(CompileEnv *envPtr, const char *bytes,
- * int length);
- */
-
-#define TclRegisterNewLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, /*flags*/ 0)
-
-/*
- * Form of TclRegisterLiteral with flags == LITERAL_CMD_NAME. In that case, it
- * is safe to cast away constness, and it is cleanest to do that here, all in
- * one place.
- *
- * int TclRegisterNewNSLiteral(CompileEnv *envPtr, const char *bytes,
- * int length);
- */
-
-#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \
- TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME)
-
-/*
* Macro used to manually adjust the stack requirements; used in cases where
* the stack effect cannot be computed from the opcode and its operands, but
* is still known at compile time.
@@ -1552,9 +1548,9 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData,
*/
#define PushLiteral(envPtr, string, length) \
- TclEmitPush(TclRegisterNewLiteral((envPtr), (string), (length)), (envPtr))
+ TclEmitPush(TclRegisterLiteral(envPtr, string, length, 0), (envPtr))
#define PushStringLiteral(envPtr, string) \
- PushLiteral((envPtr), (string), (int) (sizeof(string "") - 1))
+ PushLiteral(envPtr, string, (int) (sizeof(string "") - 1))
/*
* Macro to advance to the next token; it is more mnemonic than the address
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index 2fb3e92..eb6807c 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -232,7 +232,7 @@ QueryConfigObjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("package not known", -1));
Tcl_SetErrorCode(interp, "TCL", "FATAL", "PKGCFG_BASE",
- Tcl_GetString(pkgName), NULL);
+ TclGetString(pkgName), NULL);
return TCL_ERROR;
}
@@ -247,7 +247,7 @@ QueryConfigObjCmd(
|| val == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj("key not known", -1));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CONFIG",
- Tcl_GetString(objv[2]), NULL);
+ TclGetString(objv[2]), NULL);
return TCL_ERROR;
}
@@ -333,9 +333,9 @@ QueryConfigDelete(
Tcl_DictObjRemove(NULL, pDB, pkgName);
Tcl_DecrRefCount(pkgName);
if (cdPtr->encoding) {
- ckfree((char *)cdPtr->encoding);
+ ckfree(cdPtr->encoding);
}
- ckfree((char *)cdPtr);
+ ckfree(cdPtr);
}
/*
diff --git a/generic/tclDate.c b/generic/tclDate.c
index 717a1b3..32c71de 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1,14 +1,13 @@
-/* A Bison parser, made by GNU Bison 2.3. */
+/* A Bison parser, made by GNU Bison 3.1. */
-/* Skeleton implementation for Bison's Yacc-like parsers in C
+/* Bison implementation for Yacc-like parsers in C
- Copyright (C) 1984, 1989, 1990, 2000, 2001, 2002, 2003, 2004, 2005, 2006
- Free Software Foundation, Inc.
+ Copyright (C) 1984, 1989-1990, 2000-2015, 2018 Free Software Foundation, Inc.
- This program is free software; you can redistribute it and/or modify
+ This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2, or (at your option)
- any later version.
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -16,9 +15,7 @@
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA. */
+ along with this program. If not, see <http://www.gnu.org/licenses/>. */
/* As a special exception, you may create a larger work that contains
part or all of the Bison parser skeleton and distribute that work
@@ -47,7 +44,7 @@
#define YYBISON 1
/* Bison version. */
-#define YYBISON_VERSION "2.3"
+#define YYBISON_VERSION "3.1"
/* Skeleton name. */
#define YYSKELETON_NAME "yacc.c"
@@ -55,64 +52,19 @@
/* Pure parsers. */
#define YYPURE 1
-/* Using locations. */
-#define YYLSP_NEEDED 1
+/* Push parsers. */
+#define YYPUSH 0
-/* Substitute the variable and function names. */
-#define yyparse TclDateparse
-#define yylex TclDatelex
-#define yyerror TclDateerror
-#define yylval TclDatelval
-#define yychar TclDatechar
-#define yydebug TclDatedebug
-#define yynerrs TclDatenerrs
-#define yylloc TclDatelloc
-
-/* Tokens. */
-#ifndef YYTOKENTYPE
-# define YYTOKENTYPE
- /* Put the tokens into the symbol table, so that GDB and other debuggers
- know about them. */
- enum yytokentype {
- tAGO = 258,
- tDAY = 259,
- tDAYZONE = 260,
- tID = 261,
- tMERIDIAN = 262,
- tMONTH = 263,
- tMONTH_UNIT = 264,
- tSTARDATE = 265,
- tSEC_UNIT = 266,
- tSNUMBER = 267,
- tUNUMBER = 268,
- tZONE = 269,
- tEPOCH = 270,
- tDST = 271,
- tISOBASE = 272,
- tDAY_UNIT = 273,
- tNEXT = 274
- };
-#endif
-/* Tokens. */
-#define tAGO 258
-#define tDAY 259
-#define tDAYZONE 260
-#define tID 261
-#define tMERIDIAN 262
-#define tMONTH 263
-#define tMONTH_UNIT 264
-#define tSTARDATE 265
-#define tSEC_UNIT 266
-#define tSNUMBER 267
-#define tUNUMBER 268
-#define tZONE 269
-#define tEPOCH 270
-#define tDST 271
-#define tISOBASE 272
-#define tDAY_UNIT 273
-#define tNEXT 274
+/* Pull parsers. */
+#define YYPULL 1
+/* Substitute the variable and function names. */
+#define yyparse TclDateparse
+#define yylex TclDatelex
+#define yyerror TclDateerror
+#define yydebug TclDatedebug
+#define yynerrs TclDatenerrs
/* Copy the first part of user declarations. */
@@ -129,6 +81,7 @@
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
*/
#include "tclInt.h"
@@ -256,10 +209,14 @@ typedef enum _MERIDIAN {
-/* Enabling traces. */
-#ifndef YYDEBUG
-# define YYDEBUG 0
-#endif
+
+# ifndef YY_NULLPTR
+# if defined __cplusplus && 201103L <= __cplusplus
+# define YY_NULLPTR nullptr
+# else
+# define YY_NULLPTR 0
+# endif
+# endif
/* Enabling verbose error messages. */
#ifdef YYERROR_VERBOSE
@@ -269,40 +226,78 @@ typedef enum _MERIDIAN {
# define YYERROR_VERBOSE 0
#endif
-/* Enabling the token table. */
-#ifndef YYTOKEN_TABLE
-# define YYTOKEN_TABLE 0
+
+/* Debug traces. */
+#ifndef YYDEBUG
+# define YYDEBUG 0
+#endif
+#if YYDEBUG
+extern int TclDatedebug;
#endif
+/* Token type. */
+#ifndef YYTOKENTYPE
+# define YYTOKENTYPE
+ enum yytokentype
+ {
+ tAGO = 258,
+ tDAY = 259,
+ tDAYZONE = 260,
+ tID = 261,
+ tMERIDIAN = 262,
+ tMONTH = 263,
+ tMONTH_UNIT = 264,
+ tSTARDATE = 265,
+ tSEC_UNIT = 266,
+ tSNUMBER = 267,
+ tUNUMBER = 268,
+ tZONE = 269,
+ tEPOCH = 270,
+ tDST = 271,
+ tISOBASE = 272,
+ tDAY_UNIT = 273,
+ tNEXT = 274
+ };
+#endif
+
+/* Value type. */
#if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED
-typedef union YYSTYPE
+union YYSTYPE
{
+
+
time_t Number;
enum _MERIDIAN Meridian;
-}
-/* Line 187 of yacc.c. */
- YYSTYPE;
-# define yystype YYSTYPE /* obsolescent; will be withdrawn */
-# define YYSTYPE_IS_DECLARED 1
+
+};
+
+typedef union YYSTYPE YYSTYPE;
# define YYSTYPE_IS_TRIVIAL 1
+# define YYSTYPE_IS_DECLARED 1
#endif
+/* Location type. */
#if ! defined YYLTYPE && ! defined YYLTYPE_IS_DECLARED
-typedef struct YYLTYPE
+typedef struct YYLTYPE YYLTYPE;
+struct YYLTYPE
{
int first_line;
int first_column;
int last_line;
int last_column;
-} YYLTYPE;
-# define yyltype YYLTYPE /* obsolescent; will be withdrawn */
+};
# define YYLTYPE_IS_DECLARED 1
# define YYLTYPE_IS_TRIVIAL 1
#endif
+
+int TclDateparse (DateInfo* info);
+
+
+
/* Copy the second part of user declarations. */
@@ -322,8 +317,6 @@ MODULE_SCOPE int yyparse(DateInfo*);
-/* Line 216 of yacc.c. */
-
#ifdef short
# undef short
@@ -337,72 +330,103 @@ typedef unsigned char yytype_uint8;
#ifdef YYTYPE_INT8
typedef YYTYPE_INT8 yytype_int8;
-#elif (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-typedef signed char yytype_int8;
#else
-typedef short int yytype_int8;
+typedef signed char yytype_int8;
#endif
#ifdef YYTYPE_UINT16
typedef YYTYPE_UINT16 yytype_uint16;
#else
-typedef unsigned short int yytype_uint16;
+typedef unsigned short yytype_uint16;
#endif
#ifdef YYTYPE_INT16
typedef YYTYPE_INT16 yytype_int16;
#else
-typedef short int yytype_int16;
+typedef short yytype_int16;
#endif
#ifndef YYSIZE_T
# ifdef __SIZE_TYPE__
# define YYSIZE_T __SIZE_TYPE__
-# else
+# elif defined size_t
# define YYSIZE_T size_t
+# elif ! defined YYSIZE_T
+# include <stddef.h> /* INFRINGES ON USER NAME SPACE */
+# define YYSIZE_T size_t
+# else
+# define YYSIZE_T unsigned
# endif
#endif
#define YYSIZE_MAXIMUM ((YYSIZE_T) -1)
#ifndef YY_
-# if YYENABLE_NLS
+# if defined YYENABLE_NLS && YYENABLE_NLS
# if ENABLE_NLS
# include <libintl.h> /* INFRINGES ON USER NAME SPACE */
-# define YY_(msgid) dgettext ("bison-runtime", msgid)
+# define YY_(Msgid) dgettext ("bison-runtime", Msgid)
# endif
# endif
# ifndef YY_
-# define YY_(msgid) msgid
+# define YY_(Msgid) Msgid
+# endif
+#endif
+
+#ifndef YY_ATTRIBUTE
+# if (defined __GNUC__ \
+ && (2 < __GNUC__ || (__GNUC__ == 2 && 96 <= __GNUC_MINOR__))) \
+ || defined __SUNPRO_C && 0x5110 <= __SUNPRO_C
+# define YY_ATTRIBUTE(Spec) __attribute__(Spec)
+# else
+# define YY_ATTRIBUTE(Spec) /* empty */
+# endif
+#endif
+
+#ifndef YY_ATTRIBUTE_PURE
+# define YY_ATTRIBUTE_PURE YY_ATTRIBUTE ((__pure__))
+#endif
+
+#ifndef YY_ATTRIBUTE_UNUSED
+# define YY_ATTRIBUTE_UNUSED YY_ATTRIBUTE ((__unused__))
+#endif
+
+#if !defined _Noreturn \
+ && (!defined __STDC_VERSION__ || __STDC_VERSION__ < 201112)
+# if defined _MSC_VER && 1200 <= _MSC_VER
+# define _Noreturn __declspec (noreturn)
+# else
+# define _Noreturn YY_ATTRIBUTE ((__noreturn__))
# endif
#endif
/* Suppress unused-variable warnings by "using" E. */
#if ! defined lint || defined __GNUC__
-# define YYUSE(e) ((void) (e))
+# define YYUSE(E) ((void) (E))
#else
-# define YYUSE(e) /* empty */
+# define YYUSE(E) /* empty */
#endif
-/* Identity function, used to suppress warnings about constant conditions. */
-#ifndef lint
-# define YYID(n) (n)
-#else
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-static int
-YYID (int i)
+#if defined __GNUC__ && ! defined __ICC && 407 <= __GNUC__ * 100 + __GNUC_MINOR__
+/* Suppress an incorrect diagnostic about yylval being uninitialized. */
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN \
+ _Pragma ("GCC diagnostic push") \
+ _Pragma ("GCC diagnostic ignored \"-Wuninitialized\"")\
+ _Pragma ("GCC diagnostic ignored \"-Wmaybe-uninitialized\"")
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END \
+ _Pragma ("GCC diagnostic pop")
#else
-static int
-YYID (i)
- int i;
+# define YY_INITIAL_VALUE(Value) Value
#endif
-{
- return i;
-}
+#ifndef YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+# define YY_IGNORE_MAYBE_UNINITIALIZED_END
+#endif
+#ifndef YY_INITIAL_VALUE
+# define YY_INITIAL_VALUE(Value) /* Nothing. */
#endif
+
#if ! defined yyoverflow || YYERROR_VERBOSE
/* The parser invokes alloca or malloc; define the necessary symbols. */
@@ -420,11 +444,11 @@ YYID (i)
# define alloca _alloca
# else
# define YYSTACK_ALLOC alloca
-# if ! defined _ALLOCA_H && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
+# if ! defined _ALLOCA_H && ! defined EXIT_SUCCESS
# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-# ifndef _STDLIB_H
-# define _STDLIB_H 1
+ /* Use EXIT_SUCCESS as a witness for stdlib.h. */
+# ifndef EXIT_SUCCESS
+# define EXIT_SUCCESS 0
# endif
# endif
# endif
@@ -432,8 +456,8 @@ YYID (i)
# endif
# ifdef YYSTACK_ALLOC
- /* Pacify GCC's `empty if-body' warning. */
-# define YYSTACK_FREE(Ptr) do { /* empty */; } while (YYID (0))
+ /* Pacify GCC's 'empty if-body' warning. */
+# define YYSTACK_FREE(Ptr) do { /* empty */; } while (0)
# ifndef YYSTACK_ALLOC_MAXIMUM
/* The OS might guarantee only one guard page at the bottom of the stack,
and a page size can be as small as 4096 bytes. So we cannot safely
@@ -447,25 +471,23 @@ YYID (i)
# ifndef YYSTACK_ALLOC_MAXIMUM
# define YYSTACK_ALLOC_MAXIMUM YYSIZE_MAXIMUM
# endif
-# if (defined __cplusplus && ! defined _STDLIB_H \
+# if (defined __cplusplus && ! defined EXIT_SUCCESS \
&& ! ((defined YYMALLOC || defined malloc) \
- && (defined YYFREE || defined free)))
+ && (defined YYFREE || defined free)))
# include <stdlib.h> /* INFRINGES ON USER NAME SPACE */
-# ifndef _STDLIB_H
-# define _STDLIB_H 1
+# ifndef EXIT_SUCCESS
+# define EXIT_SUCCESS 0
# endif
# endif
# ifndef YYMALLOC
# define YYMALLOC malloc
-# if ! defined malloc && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
+# if ! defined malloc && ! defined EXIT_SUCCESS
void *malloc (YYSIZE_T); /* INFRINGES ON USER NAME SPACE */
# endif
# endif
# ifndef YYFREE
# define YYFREE free
-# if ! defined free && ! defined _STDLIB_H && (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
+# if ! defined free && ! defined EXIT_SUCCESS
void free (void *); /* INFRINGES ON USER NAME SPACE */
# endif
# endif
@@ -475,15 +497,15 @@ void free (void *); /* INFRINGES ON USER NAME SPACE */
#if (! defined yyoverflow \
&& (! defined __cplusplus \
- || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
- && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
+ || (defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL \
+ && defined YYSTYPE_IS_TRIVIAL && YYSTYPE_IS_TRIVIAL)))
/* A type that is properly aligned for any stack member. */
union yyalloc
{
- yytype_int16 yyss;
- YYSTYPE yyvs;
- YYLTYPE yyls;
+ yytype_int16 yyss_alloc;
+ YYSTYPE yyvs_alloc;
+ YYLTYPE yyls_alloc;
};
/* The size of the maximum gap between one aligned stack and the next. */
@@ -495,42 +517,46 @@ union yyalloc
((N) * (sizeof (yytype_int16) + sizeof (YYSTYPE) + sizeof (YYLTYPE)) \
+ 2 * YYSTACK_GAP_MAXIMUM)
-/* Copy COUNT objects from FROM to TO. The source and destination do
- not overlap. */
-# ifndef YYCOPY
-# if defined __GNUC__ && 1 < __GNUC__
-# define YYCOPY(To, From, Count) \
- __builtin_memcpy (To, From, (Count) * sizeof (*(From)))
-# else
-# define YYCOPY(To, From, Count) \
- do \
- { \
- YYSIZE_T yyi; \
- for (yyi = 0; yyi < (Count); yyi++) \
- (To)[yyi] = (From)[yyi]; \
- } \
- while (YYID (0))
-# endif
-# endif
+# define YYCOPY_NEEDED 1
/* Relocate STACK from its old location to the new one. The
local variables YYSIZE and YYSTACKSIZE give the old and new number of
elements in the stack, and YYPTR gives the new location of the
stack. Advance YYPTR to a properly aligned location for the next
stack. */
-# define YYSTACK_RELOCATE(Stack) \
- do \
- { \
- YYSIZE_T yynewbytes; \
- YYCOPY (&yyptr->Stack, Stack, yysize); \
- Stack = &yyptr->Stack; \
- yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
- yyptr += yynewbytes / sizeof (*yyptr); \
- } \
- while (YYID (0))
+# define YYSTACK_RELOCATE(Stack_alloc, Stack) \
+ do \
+ { \
+ YYSIZE_T yynewbytes; \
+ YYCOPY (&yyptr->Stack_alloc, Stack, yysize); \
+ Stack = &yyptr->Stack_alloc; \
+ yynewbytes = yystacksize * sizeof (*Stack) + YYSTACK_GAP_MAXIMUM; \
+ yyptr += yynewbytes / sizeof (*yyptr); \
+ } \
+ while (0)
#endif
+#if defined YYCOPY_NEEDED && YYCOPY_NEEDED
+/* Copy COUNT objects from SRC to DST. The source and destination do
+ not overlap. */
+# ifndef YYCOPY
+# if defined __GNUC__ && 1 < __GNUC__
+# define YYCOPY(Dst, Src, Count) \
+ __builtin_memcpy (Dst, Src, (Count) * sizeof (*(Src)))
+# else
+# define YYCOPY(Dst, Src, Count) \
+ do \
+ { \
+ YYSIZE_T yyi; \
+ for (yyi = 0; yyi < (Count); yyi++) \
+ (Dst)[yyi] = (Src)[yyi]; \
+ } \
+ while (0)
+# endif
+# endif
+#endif /* !YYCOPY_NEEDED */
+
/* YYFINAL -- State number of the termination state. */
#define YYFINAL 2
/* YYLAST -- Last index in YYTABLE. */
@@ -542,17 +568,19 @@ union yyalloc
#define YYNNTS 16
/* YYNRULES -- Number of rules. */
#define YYNRULES 56
-/* YYNRULES -- Number of states. */
+/* YYNSTATES -- Number of states. */
#define YYNSTATES 83
-/* YYTRANSLATE(YYLEX) -- Bison symbol number corresponding to YYLEX. */
+/* YYTRANSLATE[YYX] -- Symbol number corresponding to YYX as returned
+ by yylex, with out-of-bounds checking. */
#define YYUNDEFTOK 2
#define YYMAXUTOK 274
-#define YYTRANSLATE(YYX) \
- ((unsigned int) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
+#define YYTRANSLATE(YYX) \
+ ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK)
-/* YYTRANSLATE[YYLEX] -- Bison symbol number corresponding to YYLEX. */
+/* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM
+ as returned by yylex, without out-of-bounds checking. */
static const yytype_uint8 yytranslate[] =
{
0, 2, 2, 2, 2, 2, 2, 2, 2, 2,
@@ -586,54 +614,19 @@ static const yytype_uint8 yytranslate[] =
};
#if YYDEBUG
-/* YYPRHS[YYN] -- Index of the first RHS symbol of rule number YYN in
- YYRHS. */
-static const yytype_uint8 yyprhs[] =
-{
- 0, 0, 3, 4, 7, 9, 11, 13, 15, 17,
- 19, 21, 23, 25, 28, 33, 39, 46, 54, 57,
- 59, 61, 63, 66, 69, 73, 76, 80, 86, 88,
- 94, 100, 103, 108, 111, 113, 117, 120, 124, 128,
- 136, 139, 144, 147, 149, 153, 156, 159, 163, 165,
- 167, 169, 171, 173, 175, 177, 178
-};
-
-/* YYRHS -- A `-1'-separated list of the rules' RHS. */
-static const yytype_int8 yyrhs[] =
-{
- 27, 0, -1, -1, 27, 28, -1, 29, -1, 30,
- -1, 32, -1, 33, -1, 31, -1, 36, -1, 34,
- -1, 35, -1, 40, -1, 13, 7, -1, 13, 20,
- 13, 41, -1, 13, 20, 13, 21, 13, -1, 13,
- 20, 13, 20, 13, 41, -1, 13, 20, 13, 20,
- 13, 21, 13, -1, 14, 16, -1, 14, -1, 5,
- -1, 4, -1, 4, 22, -1, 13, 4, -1, 38,
- 13, 4, -1, 19, 4, -1, 13, 23, 13, -1,
- 13, 23, 13, 23, 13, -1, 17, -1, 13, 21,
- 8, 21, 13, -1, 13, 21, 13, 21, 13, -1,
- 8, 13, -1, 8, 13, 22, 13, -1, 13, 8,
- -1, 15, -1, 13, 8, 13, -1, 19, 8, -1,
- 19, 13, 8, -1, 17, 14, 17, -1, 17, 14,
- 13, 20, 13, 20, 13, -1, 17, 17, -1, 10,
- 13, 24, 13, -1, 37, 3, -1, 37, -1, 38,
- 13, 39, -1, 13, 39, -1, 19, 39, -1, 19,
- 13, 39, -1, 39, -1, 21, -1, 25, -1, 11,
- -1, 18, -1, 9, -1, 13, -1, -1, 7, -1
-};
-
-/* YYRLINE[YYN] -- source line where rule number YYN was defined. */
+ /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */
static const yytype_uint16 yyrline[] =
{
- 0, 225, 225, 226, 229, 232, 235, 238, 241, 244,
- 247, 251, 256, 259, 265, 271, 279, 285, 296, 300,
- 304, 310, 314, 318, 322, 326, 332, 336, 341, 346,
- 351, 356, 360, 365, 369, 374, 381, 385, 391, 400,
- 409, 419, 433, 438, 441, 444, 447, 450, 453, 458,
- 461, 466, 470, 474, 480, 498, 501
+ 0, 223, 223, 224, 227, 230, 233, 236, 239, 242,
+ 245, 249, 254, 257, 263, 269, 277, 283, 294, 298,
+ 302, 308, 312, 316, 320, 324, 330, 334, 339, 344,
+ 349, 354, 358, 363, 367, 372, 379, 383, 389, 398,
+ 407, 417, 431, 436, 439, 442, 445, 448, 451, 456,
+ 459, 464, 468, 472, 478, 496, 499
};
#endif
-#if YYDEBUG || YYERROR_VERBOSE || YYTOKEN_TABLE
+#if YYDEBUG || YYERROR_VERBOSE || 0
/* YYTNAME[SYMBOL-NUM] -- String name of the symbol SYMBOL-NUM.
First, the terminals, then, starting at YYNTOKENS, nonterminals. */
static const char *const yytname[] =
@@ -644,13 +637,13 @@ static const char *const yytname[] =
"tDAY_UNIT", "tNEXT", "':'", "'-'", "','", "'/'", "'.'", "'+'",
"$accept", "spec", "item", "time", "zone", "day", "date", "ordMonth",
"iso", "trek", "relspec", "relunits", "sign", "unit", "number",
- "o_merid", 0
+ "o_merid", YY_NULLPTR
};
#endif
# ifdef YYPRINT
-/* YYTOKNUM[YYLEX-NUM] -- Internal token number corresponding to
- token YYLEX-NUM. */
+/* YYTOKNUM[NUM] -- (External) token number corresponding to the
+ (internal) symbol number NUM (which must be that of a token). */
static const yytype_uint16 yytoknum[] =
{
0, 256, 257, 258, 259, 260, 261, 262, 263, 264,
@@ -659,54 +652,18 @@ static const yytype_uint16 yytoknum[] =
};
# endif
-/* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
-static const yytype_uint8 yyr1[] =
-{
- 0, 26, 27, 27, 28, 28, 28, 28, 28, 28,
- 28, 28, 28, 29, 29, 29, 29, 29, 30, 30,
- 30, 31, 31, 31, 31, 31, 32, 32, 32, 32,
- 32, 32, 32, 32, 32, 32, 33, 33, 34, 34,
- 34, 35, 36, 36, 37, 37, 37, 37, 37, 38,
- 38, 39, 39, 39, 40, 41, 41
-};
+#define YYPACT_NINF -22
-/* YYR2[YYN] -- Number of symbols composing right hand side of rule YYN. */
-static const yytype_uint8 yyr2[] =
-{
- 0, 2, 0, 2, 1, 1, 1, 1, 1, 1,
- 1, 1, 1, 2, 4, 5, 6, 7, 2, 1,
- 1, 1, 2, 2, 3, 2, 3, 5, 1, 5,
- 5, 2, 4, 2, 1, 3, 2, 3, 3, 7,
- 2, 4, 2, 1, 3, 2, 2, 3, 1, 1,
- 1, 1, 1, 1, 1, 0, 1
-};
+#define yypact_value_is_default(Yystate) \
+ (!!((Yystate) == (-22)))
-/* YYDEFACT[STATE-NAME] -- Default rule to reduce with in state
- STATE-NUM when YYTABLE doesn't specify something else to do. Zero
- means the default is an error. */
-static const yytype_uint8 yydefact[] =
-{
- 2, 0, 1, 21, 20, 0, 53, 0, 51, 54,
- 19, 34, 28, 52, 0, 49, 50, 3, 4, 5,
- 8, 6, 7, 10, 11, 9, 43, 0, 48, 12,
- 22, 31, 0, 23, 13, 33, 0, 0, 0, 45,
- 18, 0, 40, 25, 36, 0, 46, 42, 0, 0,
- 0, 35, 55, 0, 0, 26, 0, 38, 37, 47,
- 24, 44, 32, 41, 56, 0, 0, 14, 0, 0,
- 0, 0, 55, 15, 29, 30, 27, 0, 0, 16,
- 0, 17, 39
-};
+#define YYTABLE_NINF -1
-/* YYDEFGOTO[NTERM-NUM]. */
-static const yytype_int8 yydefgoto[] =
-{
- -1, 1, 17, 18, 19, 20, 21, 22, 23, 24,
- 25, 26, 27, 28, 29, 67
-};
+#define yytable_value_is_error(Yytable_value) \
+ 0
-/* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
- STATE-NUM. */
-#define YYPACT_NINF -22
+ /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing
+ STATE-NUM. */
static const yytype_int8 yypact[] =
{
-22, 2, -22, -21, -22, -4, -22, 1, -22, 22,
@@ -720,18 +677,39 @@ static const yytype_int8 yypact[] =
64, -22, -22
};
-/* YYPGOTO[NTERM-NUM]. */
+ /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM.
+ Performed when YYTABLE does not specify something else to do. Zero
+ means the default is an error. */
+static const yytype_uint8 yydefact[] =
+{
+ 2, 0, 1, 21, 20, 0, 53, 0, 51, 54,
+ 19, 34, 28, 52, 0, 49, 50, 3, 4, 5,
+ 8, 6, 7, 10, 11, 9, 43, 0, 48, 12,
+ 22, 31, 0, 23, 13, 33, 0, 0, 0, 45,
+ 18, 0, 40, 25, 36, 0, 46, 42, 0, 0,
+ 0, 35, 55, 0, 0, 26, 0, 38, 37, 47,
+ 24, 44, 32, 41, 56, 0, 0, 14, 0, 0,
+ 0, 0, 55, 15, 29, 30, 27, 0, 0, 16,
+ 0, 17, 39
+};
+
+ /* YYPGOTO[NTERM-NUM]. */
static const yytype_int8 yypgoto[] =
{
-22, -22, -22, -22, -22, -22, -22, -22, -22, -22,
-22, -22, -22, -9, -22, 6
};
-/* YYTABLE[YYPACT[STATE-NUM]]. What to do in state STATE-NUM. If
- positive, shift that token. If negative, reduce the rule which
- number is the opposite. If zero, do what YYDEFACT says.
- If YYTABLE_NINF, syntax error. */
-#define YYTABLE_NINF -1
+ /* YYDEFGOTO[NTERM-NUM]. */
+static const yytype_int8 yydefgoto[] =
+{
+ -1, 1, 17, 18, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 67
+};
+
+ /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If
+ positive, shift that token. If negative, reduce the rule whose
+ number is the opposite. If YYTABLE_NINF, syntax error. */
static const yytype_uint8 yytable[] =
{
39, 30, 2, 53, 64, 46, 3, 4, 54, 31,
@@ -756,8 +734,8 @@ static const yytype_uint8 yycheck[] =
13, 13, 20, 13, 13, 13, 13, 13, 72, 20
};
-/* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
- symbol of state STATE-NUM. */
+ /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing
+ symbol of state STATE-NUM. */
static const yytype_uint8 yystos[] =
{
0, 27, 0, 4, 5, 8, 9, 10, 11, 13,
@@ -771,156 +749,179 @@ static const yytype_uint8 yystos[] =
20, 13, 13
};
-#define yyerrok (yyerrstatus = 0)
-#define yyclearin (yychar = YYEMPTY)
-#define YYEMPTY (-2)
-#define YYEOF 0
+ /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */
+static const yytype_uint8 yyr1[] =
+{
+ 0, 26, 27, 27, 28, 28, 28, 28, 28, 28,
+ 28, 28, 28, 29, 29, 29, 29, 29, 30, 30,
+ 30, 31, 31, 31, 31, 31, 32, 32, 32, 32,
+ 32, 32, 32, 32, 32, 32, 33, 33, 34, 34,
+ 34, 35, 36, 36, 37, 37, 37, 37, 37, 38,
+ 38, 39, 39, 39, 40, 41, 41
+};
+
+ /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */
+static const yytype_uint8 yyr2[] =
+{
+ 0, 2, 0, 2, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 2, 4, 5, 6, 7, 2, 1,
+ 1, 1, 2, 2, 3, 2, 3, 5, 1, 5,
+ 5, 2, 4, 2, 1, 3, 2, 3, 3, 7,
+ 2, 4, 2, 1, 3, 2, 2, 3, 1, 1,
+ 1, 1, 1, 1, 1, 0, 1
+};
-#define YYACCEPT goto yyacceptlab
-#define YYABORT goto yyabortlab
-#define YYERROR goto yyerrorlab
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
-/* Like YYERROR except do call yyerror. This remains here temporarily
- to ease the transition to the new meaning of YYERROR, for GCC.
- Once GCC version 2 has supplanted version 1, this can go. */
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrorlab
-#define YYFAIL goto yyerrlab
#define YYRECOVERING() (!!yyerrstatus)
-#define YYBACKUP(Token, Value) \
-do \
- if (yychar == YYEMPTY && yylen == 1) \
- { \
- yychar = (Token); \
- yylval = (Value); \
- yytoken = YYTRANSLATE (yychar); \
- YYPOPSTACK (1); \
- goto yybackup; \
- } \
- else \
- { \
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY) \
+ { \
+ yychar = (Token); \
+ yylval = (Value); \
+ YYPOPSTACK (yylen); \
+ yystate = *yyssp; \
+ goto yybackup; \
+ } \
+ else \
+ { \
yyerror (&yylloc, info, YY_("syntax error: cannot back up")); \
- YYERROR; \
- } \
-while (YYID (0))
+ YYERROR; \
+ } \
+while (0)
-
-#define YYTERROR 1
-#define YYERRCODE 256
+/* Error token number */
+#define YYTERROR 1
+#define YYERRCODE 256
/* YYLLOC_DEFAULT -- Set CURRENT to span from RHS[1] to RHS[N].
If N is 0, then set CURRENT to the empty location which ends
the previous symbol: RHS[0] (always defined). */
-#define YYRHSLOC(Rhs, K) ((Rhs)[K])
#ifndef YYLLOC_DEFAULT
-# define YYLLOC_DEFAULT(Current, Rhs, N) \
- do \
- if (YYID (N)) \
- { \
- (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \
- (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \
- (Current).last_line = YYRHSLOC (Rhs, N).last_line; \
- (Current).last_column = YYRHSLOC (Rhs, N).last_column; \
- } \
- else \
- { \
- (Current).first_line = (Current).last_line = \
- YYRHSLOC (Rhs, 0).last_line; \
- (Current).first_column = (Current).last_column = \
- YYRHSLOC (Rhs, 0).last_column; \
- } \
- while (YYID (0))
+# define YYLLOC_DEFAULT(Current, Rhs, N) \
+ do \
+ if (N) \
+ { \
+ (Current).first_line = YYRHSLOC (Rhs, 1).first_line; \
+ (Current).first_column = YYRHSLOC (Rhs, 1).first_column; \
+ (Current).last_line = YYRHSLOC (Rhs, N).last_line; \
+ (Current).last_column = YYRHSLOC (Rhs, N).last_column; \
+ } \
+ else \
+ { \
+ (Current).first_line = (Current).last_line = \
+ YYRHSLOC (Rhs, 0).last_line; \
+ (Current).first_column = (Current).last_column = \
+ YYRHSLOC (Rhs, 0).last_column; \
+ } \
+ while (0)
#endif
+#define YYRHSLOC(Rhs, K) ((Rhs)[K])
+
+
+/* Enable debugging if requested. */
+#if YYDEBUG
+
+# ifndef YYFPRINTF
+# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
+# define YYFPRINTF fprintf
+# endif
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
/* YY_LOCATION_PRINT -- Print the location on the stream.
This macro was not mandated originally: define only if we know
we won't break user code: when these are the locations we know. */
#ifndef YY_LOCATION_PRINT
-# if YYLTYPE_IS_TRIVIAL
-# define YY_LOCATION_PRINT(File, Loc) \
- fprintf (File, "%d.%d-%d.%d", \
- (Loc).first_line, (Loc).first_column, \
- (Loc).last_line, (Loc).last_column)
-# else
-# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
-# endif
-#endif
-
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
-/* YYLEX -- calling `yylex' with the right arguments. */
+/* Print *YYLOCP on YYO. Private, do not rely on its existence. */
-#ifdef YYLEX_PARAM
-# define YYLEX yylex (&yylval, &yylloc, YYLEX_PARAM)
-#else
-# define YYLEX yylex (&yylval, &yylloc, info)
-#endif
+YY_ATTRIBUTE_UNUSED
+static unsigned
+yy_location_print_ (FILE *yyo, YYLTYPE const * const yylocp)
+{
+ unsigned res = 0;
+ int end_col = 0 != yylocp->last_column ? yylocp->last_column - 1 : 0;
+ if (0 <= yylocp->first_line)
+ {
+ res += YYFPRINTF (yyo, "%d", yylocp->first_line);
+ if (0 <= yylocp->first_column)
+ res += YYFPRINTF (yyo, ".%d", yylocp->first_column);
+ }
+ if (0 <= yylocp->last_line)
+ {
+ if (yylocp->first_line < yylocp->last_line)
+ {
+ res += YYFPRINTF (yyo, "-%d", yylocp->last_line);
+ if (0 <= end_col)
+ res += YYFPRINTF (yyo, ".%d", end_col);
+ }
+ else if (0 <= end_col && yylocp->first_column < end_col)
+ res += YYFPRINTF (yyo, "-%d", end_col);
+ }
+ return res;
+ }
-/* Enable debugging if requested. */
-#if YYDEBUG
+# define YY_LOCATION_PRINT(File, Loc) \
+ yy_location_print_ (File, &(Loc))
-# ifndef YYFPRINTF
-# include <stdio.h> /* INFRINGES ON USER NAME SPACE */
-# define YYFPRINTF fprintf
+# else
+# define YY_LOCATION_PRINT(File, Loc) ((void) 0)
# endif
+#endif
-# define YYDPRINTF(Args) \
-do { \
- if (yydebug) \
- YYFPRINTF Args; \
-} while (YYID (0))
-# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \
-do { \
- if (yydebug) \
- { \
- YYFPRINTF (stderr, "%s ", Title); \
- yy_symbol_print (stderr, \
- Type, Value, Location, info); \
- YYFPRINTF (stderr, "\n"); \
- } \
-} while (YYID (0))
+# define YY_SYMBOL_PRINT(Title, Type, Value, Location) \
+do { \
+ if (yydebug) \
+ { \
+ YYFPRINTF (stderr, "%s ", Title); \
+ yy_symbol_print (stderr, \
+ Type, Value, Location, info); \
+ YYFPRINTF (stderr, "\n"); \
+ } \
+} while (0)
-/*--------------------------------.
-| Print this symbol on YYOUTPUT. |
-`--------------------------------*/
+/*----------------------------------------.
+| Print this symbol's value on YYOUTPUT. |
+`----------------------------------------*/
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_value_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
-#else
-static void
-yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
- FILE *yyoutput;
- int yytype;
- YYSTYPE const * const yyvaluep;
- YYLTYPE const * const yylocationp;
- DateInfo* info;
-#endif
{
- if (!yyvaluep)
- return;
+ FILE *yyo = yyoutput;
+ YYUSE (yyo);
YYUSE (yylocationp);
YYUSE (info);
+ if (!yyvaluep)
+ return;
# ifdef YYPRINT
if (yytype < YYNTOKENS)
YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
-# else
- YYUSE (yyoutput);
# endif
- switch (yytype)
- {
- default:
- break;
- }
+ YYUSE (yytype);
}
@@ -928,24 +929,11 @@ yy_symbol_value_print (yyoutput, yytype, yyvaluep, yylocationp, info)
| Print this symbol on YYOUTPUT. |
`--------------------------------*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
yy_symbol_print (FILE *yyoutput, int yytype, YYSTYPE const * const yyvaluep, YYLTYPE const * const yylocationp, DateInfo* info)
-#else
-static void
-yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
- FILE *yyoutput;
- int yytype;
- YYSTYPE const * const yyvaluep;
- YYLTYPE const * const yylocationp;
- DateInfo* info;
-#endif
{
- if (yytype < YYNTOKENS)
- YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
- else
- YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+ YYFPRINTF (yyoutput, "%s %s (",
+ yytype < YYNTOKENS ? "token" : "nterm", yytname[yytype]);
YY_LOCATION_PRINT (yyoutput, *yylocationp);
YYFPRINTF (yyoutput, ": ");
@@ -958,68 +946,54 @@ yy_symbol_print (yyoutput, yytype, yyvaluep, yylocationp, info)
| TOP (included). |
`------------------------------------------------------------------*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-static void
-yy_stack_print (yytype_int16 *bottom, yytype_int16 *top)
-#else
static void
-yy_stack_print (bottom, top)
- yytype_int16 *bottom;
- yytype_int16 *top;
-#endif
+yy_stack_print (yytype_int16 *yybottom, yytype_int16 *yytop)
{
YYFPRINTF (stderr, "Stack now");
- for (; bottom <= top; ++bottom)
- YYFPRINTF (stderr, " %d", *bottom);
+ for (; yybottom <= yytop; yybottom++)
+ {
+ int yybot = *yybottom;
+ YYFPRINTF (stderr, " %d", yybot);
+ }
YYFPRINTF (stderr, "\n");
}
-# define YY_STACK_PRINT(Bottom, Top) \
-do { \
- if (yydebug) \
- yy_stack_print ((Bottom), (Top)); \
-} while (YYID (0))
+# define YY_STACK_PRINT(Bottom, Top) \
+do { \
+ if (yydebug) \
+ yy_stack_print ((Bottom), (Top)); \
+} while (0)
/*------------------------------------------------.
| Report that the YYRULE is going to be reduced. |
`------------------------------------------------*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
-yy_reduce_print (YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
-#else
-static void
-yy_reduce_print (yyvsp, yylsp, yyrule, info)
- YYSTYPE *yyvsp;
- YYLTYPE *yylsp;
- int yyrule;
- DateInfo* info;
-#endif
+yy_reduce_print (yytype_int16 *yyssp, YYSTYPE *yyvsp, YYLTYPE *yylsp, int yyrule, DateInfo* info)
{
+ unsigned long yylno = yyrline[yyrule];
int yynrhs = yyr2[yyrule];
int yyi;
- unsigned long int yylno = yyrline[yyrule];
YYFPRINTF (stderr, "Reducing stack by rule %d (line %lu):\n",
- yyrule - 1, yylno);
+ yyrule - 1, yylno);
/* The symbols being reduced. */
for (yyi = 0; yyi < yynrhs; yyi++)
{
- fprintf (stderr, " $%d = ", yyi + 1);
- yy_symbol_print (stderr, yyrhs[yyprhs[yyrule] + yyi],
- &(yyvsp[(yyi + 1) - (yynrhs)])
- , &(yylsp[(yyi + 1) - (yynrhs)]) , info);
- fprintf (stderr, "\n");
+ YYFPRINTF (stderr, " $%d = ", yyi + 1);
+ yy_symbol_print (stderr,
+ yystos[yyssp[yyi + 1 - yynrhs]],
+ &(yyvsp[(yyi + 1) - (yynrhs)])
+ , &(yylsp[(yyi + 1) - (yynrhs)]) , info);
+ YYFPRINTF (stderr, "\n");
}
}
-# define YY_REDUCE_PRINT(Rule) \
-do { \
- if (yydebug) \
- yy_reduce_print (yyvsp, yylsp, Rule, info); \
-} while (YYID (0))
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (yyssp, yyvsp, yylsp, Rule, info); \
+} while (0)
/* Nonzero means print parse trace. It is left uninitialized so that
multiple parsers can coexist. */
@@ -1033,7 +1007,7 @@ int yydebug;
/* YYINITDEPTH -- initial size of the parser's stacks. */
-#ifndef YYINITDEPTH
+#ifndef YYINITDEPTH
# define YYINITDEPTH 200
#endif
@@ -1048,7 +1022,6 @@ int yydebug;
# define YYMAXDEPTH 10000
#endif
-
#if YYERROR_VERBOSE
@@ -1057,15 +1030,8 @@ int yydebug;
# define yystrlen strlen
# else
/* Return the length of YYSTR. */
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static YYSIZE_T
yystrlen (const char *yystr)
-#else
-static YYSIZE_T
-yystrlen (yystr)
- const char *yystr;
-#endif
{
YYSIZE_T yylen;
for (yylen = 0; yystr[yylen]; yylen++)
@@ -1081,16 +1047,8 @@ yystrlen (yystr)
# else
/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
YYDEST. */
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static char *
yystpcpy (char *yydest, const char *yysrc)
-#else
-static char *
-yystpcpy (yydest, yysrc)
- char *yydest;
- const char *yysrc;
-#endif
{
char *yyd = yydest;
const char *yys = yysrc;
@@ -1120,27 +1078,27 @@ yytnamerr (char *yyres, const char *yystr)
char const *yyp = yystr;
for (;;)
- switch (*++yyp)
- {
- case '\'':
- case ',':
- goto do_not_strip_quotes;
-
- case '\\':
- if (*++yyp != '\\')
- goto do_not_strip_quotes;
- /* Fall through. */
- default:
- if (yyres)
- yyres[yyn] = *yyp;
- yyn++;
- break;
-
- case '"':
- if (yyres)
- yyres[yyn] = '\0';
- return yyn;
- }
+ switch (*++yyp)
+ {
+ case '\'':
+ case ',':
+ goto do_not_strip_quotes;
+
+ case '\\':
+ if (*++yyp != '\\')
+ goto do_not_strip_quotes;
+ /* Fall through. */
+ default:
+ if (yyres)
+ yyres[yyn] = *yyp;
+ yyn++;
+ break;
+
+ case '"':
+ if (yyres)
+ yyres[yyn] = '\0';
+ return yyn;
+ }
do_not_strip_quotes: ;
}
@@ -1151,169 +1109,161 @@ yytnamerr (char *yyres, const char *yystr)
}
# endif
-/* Copy into YYRESULT an error message about the unexpected token
- YYCHAR while in state YYSTATE. Return the number of bytes copied,
- including the terminating null byte. If YYRESULT is null, do not
- copy anything; just return the number of bytes that would be
- copied. As a special case, return 0 if an ordinary "syntax error"
- message will do. Return YYSIZE_MAXIMUM if overflow occurs during
- size calculation. */
-static YYSIZE_T
-yysyntax_error (char *yyresult, int yystate, int yychar)
+/* Copy into *YYMSG, which is of size *YYMSG_ALLOC, an error message
+ about the unexpected token YYTOKEN for the state stack whose top is
+ YYSSP.
+
+ Return 0 if *YYMSG was successfully written. Return 1 if *YYMSG is
+ not large enough to hold the message. In that case, also set
+ *YYMSG_ALLOC to the required number of bytes. Return 2 if the
+ required number of bytes is too large to store. */
+static int
+yysyntax_error (YYSIZE_T *yymsg_alloc, char **yymsg,
+ yytype_int16 *yyssp, int yytoken)
{
- int yyn = yypact[yystate];
+ YYSIZE_T yysize0 = yytnamerr (YY_NULLPTR, yytname[yytoken]);
+ YYSIZE_T yysize = yysize0;
+ enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
+ /* Internationalized format string. */
+ const char *yyformat = YY_NULLPTR;
+ /* Arguments of yyformat. */
+ char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
+ /* Number of reported tokens (one for the "unexpected", one per
+ "expected"). */
+ int yycount = 0;
+
+ /* There are many possibilities here to consider:
+ - If this state is a consistent state with a default action, then
+ the only way this function was invoked is if the default action
+ is an error action. In that case, don't check for expected
+ tokens because there are none.
+ - The only way there can be no lookahead present (in yychar) is if
+ this state is a consistent state with a default action. Thus,
+ detecting the absence of a lookahead is sufficient to determine
+ that there is no unexpected or expected token to report. In that
+ case, just report a simple "syntax error".
+ - Don't assume there isn't a lookahead just because this state is a
+ consistent state with a default action. There might have been a
+ previous inconsistent state, consistent state with a non-default
+ action, or user semantic action that manipulated yychar.
+ - Of course, the expected token list depends on states to have
+ correct lookahead information, and it depends on the parser not
+ to perform extra reductions after fetching a lookahead from the
+ scanner and before detecting a syntax error. Thus, state merging
+ (from LALR or IELR) and default reductions corrupt the expected
+ token list. However, the list is correct for canonical LR with
+ one exception: it will still contain any token that will not be
+ accepted due to an error action in a later state.
+ */
+ if (yytoken != YYEMPTY)
+ {
+ int yyn = yypact[*yyssp];
+ yyarg[yycount++] = yytname[yytoken];
+ if (!yypact_value_is_default (yyn))
+ {
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. In other words, skip the first -YYN actions for
+ this state because they are default actions. */
+ int yyxbegin = yyn < 0 ? -yyn : 0;
+ /* Stay within bounds of both yycheck and yytname. */
+ int yychecklim = YYLAST - yyn + 1;
+ int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
+ int yyx;
+
+ for (yyx = yyxbegin; yyx < yyxend; ++yyx)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR
+ && !yytable_value_is_error (yytable[yyx + yyn]))
+ {
+ if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
+ {
+ yycount = 1;
+ yysize = yysize0;
+ break;
+ }
+ yyarg[yycount++] = yytname[yyx];
+ {
+ YYSIZE_T yysize1 = yysize + yytnamerr (YY_NULLPTR, yytname[yyx]);
+ if (! (yysize <= yysize1
+ && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+ return 2;
+ yysize = yysize1;
+ }
+ }
+ }
+ }
- if (! (YYPACT_NINF < yyn && yyn <= YYLAST))
- return 0;
- else
+ switch (yycount)
+ {
+# define YYCASE_(N, S) \
+ case N: \
+ yyformat = S; \
+ break
+ default: /* Avoid compiler warnings. */
+ YYCASE_(0, YY_("syntax error"));
+ YYCASE_(1, YY_("syntax error, unexpected %s"));
+ YYCASE_(2, YY_("syntax error, unexpected %s, expecting %s"));
+ YYCASE_(3, YY_("syntax error, unexpected %s, expecting %s or %s"));
+ YYCASE_(4, YY_("syntax error, unexpected %s, expecting %s or %s or %s"));
+ YYCASE_(5, YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s"));
+# undef YYCASE_
+ }
+
+ {
+ YYSIZE_T yysize1 = yysize + yystrlen (yyformat);
+ if (! (yysize <= yysize1 && yysize1 <= YYSTACK_ALLOC_MAXIMUM))
+ return 2;
+ yysize = yysize1;
+ }
+
+ if (*yymsg_alloc < yysize)
{
- int yytype = YYTRANSLATE (yychar);
- YYSIZE_T yysize0 = yytnamerr (0, yytname[yytype]);
- YYSIZE_T yysize = yysize0;
- YYSIZE_T yysize1;
- int yysize_overflow = 0;
- enum { YYERROR_VERBOSE_ARGS_MAXIMUM = 5 };
- char const *yyarg[YYERROR_VERBOSE_ARGS_MAXIMUM];
- int yyx;
-
-# if 0
- /* This is so xgettext sees the translatable formats that are
- constructed on the fly. */
- YY_("syntax error, unexpected %s");
- YY_("syntax error, unexpected %s, expecting %s");
- YY_("syntax error, unexpected %s, expecting %s or %s");
- YY_("syntax error, unexpected %s, expecting %s or %s or %s");
- YY_("syntax error, unexpected %s, expecting %s or %s or %s or %s");
-# endif
- char *yyfmt;
- char const *yyf;
- static char const yyunexpected[] = "syntax error, unexpected %s";
- static char const yyexpecting[] = ", expecting %s";
- static char const yyor[] = " or %s";
- char yyformat[sizeof yyunexpected
- + sizeof yyexpecting - 1
- + ((YYERROR_VERBOSE_ARGS_MAXIMUM - 2)
- * (sizeof yyor - 1))];
- char const *yyprefix = yyexpecting;
-
- /* Start YYX at -YYN if negative to avoid negative indexes in
- YYCHECK. */
- int yyxbegin = yyn < 0 ? -yyn : 0;
-
- /* Stay within bounds of both yycheck and yytname. */
- int yychecklim = YYLAST - yyn + 1;
- int yyxend = yychecklim < YYNTOKENS ? yychecklim : YYNTOKENS;
- int yycount = 1;
-
- yyarg[0] = yytname[yytype];
- yyfmt = yystpcpy (yyformat, yyunexpected);
-
- for (yyx = yyxbegin; yyx < yyxend; ++yyx)
- if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
- {
- if (yycount == YYERROR_VERBOSE_ARGS_MAXIMUM)
- {
- yycount = 1;
- yysize = yysize0;
- yyformat[sizeof yyunexpected - 1] = '\0';
- break;
- }
- yyarg[yycount++] = yytname[yyx];
- yysize1 = yysize + yytnamerr (0, yytname[yyx]);
- yysize_overflow |= (yysize1 < yysize);
- yysize = yysize1;
- yyfmt = yystpcpy (yyfmt, yyprefix);
- yyprefix = yyor;
- }
-
- yyf = YY_(yyformat);
- yysize1 = yysize + yystrlen (yyf);
- yysize_overflow |= (yysize1 < yysize);
- yysize = yysize1;
-
- if (yysize_overflow)
- return YYSIZE_MAXIMUM;
-
- if (yyresult)
- {
- /* Avoid sprintf, as that infringes on the user's name space.
- Don't have undefined behavior even if the translation
- produced a string with the wrong number of "%s"s. */
- char *yyp = yyresult;
- int yyi = 0;
- while ((*yyp = *yyf) != '\0')
- {
- if (*yyp == '%' && yyf[1] == 's' && yyi < yycount)
- {
- yyp += yytnamerr (yyp, yyarg[yyi++]);
- yyf += 2;
- }
- else
- {
- yyp++;
- yyf++;
- }
- }
- }
- return yysize;
+ *yymsg_alloc = 2 * yysize;
+ if (! (yysize <= *yymsg_alloc
+ && *yymsg_alloc <= YYSTACK_ALLOC_MAXIMUM))
+ *yymsg_alloc = YYSTACK_ALLOC_MAXIMUM;
+ return 1;
}
+
+ /* Avoid sprintf, as that infringes on the user's name space.
+ Don't have undefined behavior even if the translation
+ produced a string with the wrong number of "%s"s. */
+ {
+ char *yyp = *yymsg;
+ int yyi = 0;
+ while ((*yyp = *yyformat) != '\0')
+ if (*yyp == '%' && yyformat[1] == 's' && yyi < yycount)
+ {
+ yyp += yytnamerr (yyp, yyarg[yyi++]);
+ yyformat += 2;
+ }
+ else
+ {
+ yyp++;
+ yyformat++;
+ }
+ }
+ return 0;
}
#endif /* YYERROR_VERBOSE */
-
/*-----------------------------------------------.
| Release the memory associated to this symbol. |
`-----------------------------------------------*/
-/*ARGSUSED*/
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
static void
yydestruct (const char *yymsg, int yytype, YYSTYPE *yyvaluep, YYLTYPE *yylocationp, DateInfo* info)
-#else
-static void
-yydestruct (yymsg, yytype, yyvaluep, yylocationp, info)
- const char *yymsg;
- int yytype;
- YYSTYPE *yyvaluep;
- YYLTYPE *yylocationp;
- DateInfo* info;
-#endif
{
YYUSE (yyvaluep);
YYUSE (yylocationp);
YYUSE (info);
-
if (!yymsg)
yymsg = "Deleting";
YY_SYMBOL_PRINT (yymsg, yytype, yyvaluep, yylocationp);
- switch (yytype)
- {
-
- default:
- break;
- }
+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
+ YYUSE (yytype);
+ YY_IGNORE_MAYBE_UNINITIALIZED_END
}
-
-
-/* Prevent warnings from -Wmissing-prototypes. */
-
-#ifdef YYPARSE_PARAM
-#if defined __STDC__ || defined __cplusplus
-int yyparse (void *YYPARSE_PARAM);
-#else
-int yyparse ();
-#endif
-#else /* ! YYPARSE_PARAM */
-#if defined __STDC__ || defined __cplusplus
-int yyparse (DateInfo* info);
-#else
-int yyparse ();
-#endif
-#endif /* ! YYPARSE_PARAM */
-
-
@@ -1322,112 +1272,96 @@ int yyparse ();
| yyparse. |
`----------*/
-#ifdef YYPARSE_PARAM
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
-int
-yyparse (void *YYPARSE_PARAM)
-#else
-int
-yyparse (YYPARSE_PARAM)
- void *YYPARSE_PARAM;
-#endif
-#else /* ! YYPARSE_PARAM */
-#if (defined __STDC__ || defined __C99__FUNC__ \
- || defined __cplusplus || defined _MSC_VER)
int
yyparse (DateInfo* info)
-#else
-int
-yyparse (info)
- DateInfo* info;
-#endif
-#endif
{
- /* The look-ahead symbol. */
+/* The lookahead symbol. */
int yychar;
-/* The semantic value of the look-ahead symbol. */
-YYSTYPE yylval = {0};
-/* Number of syntax errors so far. */
-int yynerrs;
-/* Location data for the look-ahead symbol. */
-YYLTYPE yylloc;
+/* The semantic value of the lookahead symbol. */
+/* Default value used for initialization, for pacifying older GCCs
+ or non-GCC compilers. */
+YY_INITIAL_VALUE (static YYSTYPE yyval_default;)
+YYSTYPE yylval YY_INITIAL_VALUE (= yyval_default);
- int yystate;
- int yyn;
- int yyresult;
- /* Number of tokens to shift before error messages enabled. */
- int yyerrstatus;
- /* Look-ahead token as an internal (translated) token number. */
- int yytoken = 0;
-#if YYERROR_VERBOSE
- /* Buffer for error messages, and its allocated size. */
- char yymsgbuf[128];
- char *yymsg = yymsgbuf;
- YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
-#endif
+/* Location data for the lookahead symbol. */
+static YYLTYPE yyloc_default
+# if defined YYLTYPE_IS_TRIVIAL && YYLTYPE_IS_TRIVIAL
+ = { 1, 1, 1, 1 }
+# endif
+;
+YYLTYPE yylloc = yyloc_default;
- /* Three stacks and their tools:
- `yyss': related to states,
- `yyvs': related to semantic values,
- `yyls': related to locations.
+ /* Number of syntax errors so far. */
+ int yynerrs;
- Refer to the stacks thru separate pointers, to allow yyoverflow
- to reallocate them elsewhere. */
+ int yystate;
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
- /* The state stack. */
- yytype_int16 yyssa[YYINITDEPTH];
- yytype_int16 *yyss = yyssa;
- yytype_int16 *yyssp;
+ /* The stacks and their tools:
+ 'yyss': related to states.
+ 'yyvs': related to semantic values.
+ 'yyls': related to locations.
- /* The semantic value stack. */
- YYSTYPE yyvsa[YYINITDEPTH];
- YYSTYPE *yyvs = yyvsa;
- YYSTYPE *yyvsp;
+ Refer to the stacks through separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
- /* The location stack. */
- YYLTYPE yylsa[YYINITDEPTH];
- YYLTYPE *yyls = yylsa;
- YYLTYPE *yylsp;
- /* The locations where the error started and ended. */
- YYLTYPE yyerror_range[2];
+ /* The state stack. */
+ yytype_int16 yyssa[YYINITDEPTH];
+ yytype_int16 *yyss;
+ yytype_int16 *yyssp;
-#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
+ /* The semantic value stack. */
+ YYSTYPE yyvsa[YYINITDEPTH];
+ YYSTYPE *yyvs;
+ YYSTYPE *yyvsp;
- YYSIZE_T yystacksize = YYINITDEPTH;
+ /* The location stack. */
+ YYLTYPE yylsa[YYINITDEPTH];
+ YYLTYPE *yyls;
+ YYLTYPE *yylsp;
+ /* The locations where the error started and ended. */
+ YYLTYPE yyerror_range[3];
+
+ YYSIZE_T yystacksize;
+
+ int yyn;
+ int yyresult;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken = 0;
/* The variables used to return semantic value and location from the
action routines. */
YYSTYPE yyval;
YYLTYPE yyloc;
+#if YYERROR_VERBOSE
+ /* Buffer for error messages, and its allocated size. */
+ char yymsgbuf[128];
+ char *yymsg = yymsgbuf;
+ YYSIZE_T yymsg_alloc = sizeof yymsgbuf;
+#endif
+
+#define YYPOPSTACK(N) (yyvsp -= (N), yyssp -= (N), yylsp -= (N))
+
/* The number of symbols on the RHS of the reduced rule.
Keep to zero when no symbol should be popped. */
int yylen = 0;
+ yyssp = yyss = yyssa;
+ yyvsp = yyvs = yyvsa;
+ yylsp = yyls = yylsa;
+ yystacksize = YYINITDEPTH;
+
YYDPRINTF ((stderr, "Starting parse\n"));
yystate = 0;
yyerrstatus = 0;
yynerrs = 0;
- yychar = YYEMPTY; /* Cause a token to be read. */
-
- /* Initialize stack pointers.
- Waste one element of value and location stack
- so that they stay on the same level as the state stack.
- The wasted elements are never initialized. */
-
- yyssp = yyss;
- yyvsp = yyvs;
- yylsp = yyls;
-#if YYLTYPE_IS_TRIVIAL
- /* Initialize the default location before parsing starts. */
- yylloc.first_line = yylloc.last_line = 1;
- yylloc.first_column = yylloc.last_column = 0;
-#endif
-
+ yychar = YYEMPTY; /* Cause a token to be read. */
+ yylsp[0] = yylloc;
goto yysetstate;
/*------------------------------------------------------------.
@@ -1448,25 +1382,26 @@ YYLTYPE yylloc;
#ifdef yyoverflow
{
- /* Give user a chance to reallocate the stack. Use copies of
- these so that the &'s don't force the real ones into
- memory. */
- YYSTYPE *yyvs1 = yyvs;
- yytype_int16 *yyss1 = yyss;
- YYLTYPE *yyls1 = yyls;
-
- /* Each stack pointer address is followed by the size of the
- data in use in that stack, in bytes. This used to be a
- conditional around just the two extra args, but that might
- be undefined if yyoverflow is a macro. */
- yyoverflow (YY_("memory exhausted"),
- &yyss1, yysize * sizeof (*yyssp),
- &yyvs1, yysize * sizeof (*yyvsp),
- &yyls1, yysize * sizeof (*yylsp),
- &yystacksize);
- yyls = yyls1;
- yyss = yyss1;
- yyvs = yyvs1;
+ /* Give user a chance to reallocate the stack. Use copies of
+ these so that the &'s don't force the real ones into
+ memory. */
+ YYSTYPE *yyvs1 = yyvs;
+ yytype_int16 *yyss1 = yyss;
+ YYLTYPE *yyls1 = yyls;
+
+ /* Each stack pointer address is followed by the size of the
+ data in use in that stack, in bytes. This used to be a
+ conditional around just the two extra args, but that might
+ be undefined if yyoverflow is a macro. */
+ yyoverflow (YY_("memory exhausted"),
+ &yyss1, yysize * sizeof (*yyssp),
+ &yyvs1, yysize * sizeof (*yyvsp),
+ &yyls1, yysize * sizeof (*yylsp),
+ &yystacksize);
+
+ yyls = yyls1;
+ yyss = yyss1;
+ yyvs = yyvs1;
}
#else /* no yyoverflow */
# ifndef YYSTACK_RELOCATE
@@ -1474,23 +1409,23 @@ YYLTYPE yylloc;
# else
/* Extend the stack our own way. */
if (YYMAXDEPTH <= yystacksize)
- goto yyexhaustedlab;
+ goto yyexhaustedlab;
yystacksize *= 2;
if (YYMAXDEPTH < yystacksize)
- yystacksize = YYMAXDEPTH;
+ yystacksize = YYMAXDEPTH;
{
- yytype_int16 *yyss1 = yyss;
- union yyalloc *yyptr =
- (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
- if (! yyptr)
- goto yyexhaustedlab;
- YYSTACK_RELOCATE (yyss);
- YYSTACK_RELOCATE (yyvs);
- YYSTACK_RELOCATE (yyls);
+ yytype_int16 *yyss1 = yyss;
+ union yyalloc *yyptr =
+ (union yyalloc *) YYSTACK_ALLOC (YYSTACK_BYTES (yystacksize));
+ if (! yyptr)
+ goto yyexhaustedlab;
+ YYSTACK_RELOCATE (yyss_alloc, yyss);
+ YYSTACK_RELOCATE (yyvs_alloc, yyvs);
+ YYSTACK_RELOCATE (yyls_alloc, yyls);
# undef YYSTACK_RELOCATE
- if (yyss1 != yyssa)
- YYSTACK_FREE (yyss1);
+ if (yyss1 != yyssa)
+ YYSTACK_FREE (yyss1);
}
# endif
#endif /* no yyoverflow */
@@ -1500,14 +1435,17 @@ YYLTYPE yylloc;
yylsp = yyls + yysize - 1;
YYDPRINTF ((stderr, "Stack size increased to %lu\n",
- (unsigned long int) yystacksize));
+ (unsigned long) yystacksize));
if (yyss + yystacksize - 1 <= yyssp)
- YYABORT;
+ YYABORT;
}
YYDPRINTF ((stderr, "Entering state %d\n", yystate));
+ if (yystate == YYFINAL)
+ YYACCEPT;
+
goto yybackup;
/*-----------.
@@ -1516,20 +1454,20 @@ YYLTYPE yylloc;
yybackup:
/* Do appropriate processing given the current state. Read a
- look-ahead token if we need one and don't already have one. */
+ lookahead token if we need one and don't already have one. */
- /* First try to decide what to do without reference to look-ahead token. */
+ /* First try to decide what to do without reference to lookahead token. */
yyn = yypact[yystate];
- if (yyn == YYPACT_NINF)
+ if (yypact_value_is_default (yyn))
goto yydefault;
- /* Not known => get a look-ahead token if don't already have one. */
+ /* Not known => get a lookahead token if don't already have one. */
- /* YYCHAR is either YYEMPTY or YYEOF or a valid look-ahead symbol. */
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
if (yychar == YYEMPTY)
{
YYDPRINTF ((stderr, "Reading a token: "));
- yychar = YYLEX;
+ yychar = yylex (&yylval, &yylloc, info);
}
if (yychar <= YYEOF)
@@ -1551,29 +1489,27 @@ yybackup:
yyn = yytable[yyn];
if (yyn <= 0)
{
- if (yyn == 0 || yyn == YYTABLE_NINF)
- goto yyerrlab;
+ if (yytable_value_is_error (yyn))
+ goto yyerrlab;
yyn = -yyn;
goto yyreduce;
}
- if (yyn == YYFINAL)
- YYACCEPT;
-
/* Count tokens shifted since error; after three, turn off error
status. */
if (yyerrstatus)
yyerrstatus--;
- /* Shift the look-ahead token. */
+ /* Shift the lookahead token. */
YY_SYMBOL_PRINT ("Shifting", yytoken, &yylval, &yylloc);
- /* Discard the shifted token unless it is eof. */
- if (yychar != YYEOF)
- yychar = YYEMPTY;
+ /* Discard the shifted token. */
+ yychar = YYEMPTY;
yystate = yyn;
+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
*++yyvsp = yylval;
+ YY_IGNORE_MAYBE_UNINITIALIZED_END
*++yylsp = yylloc;
goto yynewstate;
@@ -1596,7 +1532,7 @@ yyreduce:
yylen = yyr2[yyn];
/* If YYLEN is nonzero, implement the default value of the action:
- `$$ = $1'.
+ '$$ = $1'.
Otherwise, the following line sets YYVAL to garbage.
This behavior is undocumented and Bison
@@ -1605,8 +1541,9 @@ yyreduce:
GCC warning that YYVAL may be used uninitialized. */
yyval = yyvsp[1-yylen];
- /* Default location. */
+ /* Default location. */
YYLLOC_DEFAULT (yyloc, (yylsp - yylen), yylen);
+ yyerror_range[1] = yyloc;
YY_REDUCE_PRINT (yyn);
switch (yyn)
{
@@ -1614,42 +1551,48 @@ yyreduce:
{
yyHaveTime++;
- ;}
+ }
+
break;
case 5:
{
yyHaveZone++;
- ;}
+ }
+
break;
case 6:
{
yyHaveDate++;
- ;}
+ }
+
break;
case 7:
{
yyHaveOrdinalMonth++;
- ;}
+ }
+
break;
case 8:
{
yyHaveDay++;
- ;}
+ }
+
break;
case 9:
{
yyHaveRel++;
- ;}
+ }
+
break;
case 10:
@@ -1657,7 +1600,8 @@ yyreduce:
{
yyHaveTime++;
yyHaveDate++;
- ;}
+ }
+
break;
case 11:
@@ -1666,195 +1610,217 @@ yyreduce:
yyHaveTime++;
yyHaveDate++;
yyHaveRel++;
- ;}
+ }
+
break;
case 13:
{
- yyHour = (yyvsp[(1) - (2)].Number);
+ yyHour = (yyvsp[-1].Number);
yyMinutes = 0;
yySeconds = 0;
- yyMeridian = (yyvsp[(2) - (2)].Meridian);
- ;}
+ yyMeridian = (yyvsp[0].Meridian);
+ }
+
break;
case 14:
{
- yyHour = (yyvsp[(1) - (4)].Number);
- yyMinutes = (yyvsp[(3) - (4)].Number);
+ yyHour = (yyvsp[-3].Number);
+ yyMinutes = (yyvsp[-1].Number);
yySeconds = 0;
- yyMeridian = (yyvsp[(4) - (4)].Meridian);
- ;}
+ yyMeridian = (yyvsp[0].Meridian);
+ }
+
break;
case 15:
{
- yyHour = (yyvsp[(1) - (5)].Number);
- yyMinutes = (yyvsp[(3) - (5)].Number);
+ yyHour = (yyvsp[-4].Number);
+ yyMinutes = (yyvsp[-2].Number);
yyMeridian = MER24;
yyDSTmode = DSToff;
- yyTimezone = ((yyvsp[(5) - (5)].Number) % 100 + ((yyvsp[(5) - (5)].Number) / 100) * 60);
+ yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
++yyHaveZone;
- ;}
+ }
+
break;
case 16:
{
- yyHour = (yyvsp[(1) - (6)].Number);
- yyMinutes = (yyvsp[(3) - (6)].Number);
- yySeconds = (yyvsp[(5) - (6)].Number);
- yyMeridian = (yyvsp[(6) - (6)].Meridian);
- ;}
+ yyHour = (yyvsp[-5].Number);
+ yyMinutes = (yyvsp[-3].Number);
+ yySeconds = (yyvsp[-1].Number);
+ yyMeridian = (yyvsp[0].Meridian);
+ }
+
break;
case 17:
{
- yyHour = (yyvsp[(1) - (7)].Number);
- yyMinutes = (yyvsp[(3) - (7)].Number);
- yySeconds = (yyvsp[(5) - (7)].Number);
+ yyHour = (yyvsp[-6].Number);
+ yyMinutes = (yyvsp[-4].Number);
+ yySeconds = (yyvsp[-2].Number);
yyMeridian = MER24;
yyDSTmode = DSToff;
- yyTimezone = ((yyvsp[(7) - (7)].Number) % 100 + ((yyvsp[(7) - (7)].Number) / 100) * 60);
+ yyTimezone = ((yyvsp[0].Number) % 100 + ((yyvsp[0].Number) / 100) * 60);
++yyHaveZone;
- ;}
+ }
+
break;
case 18:
{
- yyTimezone = (yyvsp[(1) - (2)].Number);
+ yyTimezone = (yyvsp[-1].Number);
yyDSTmode = DSTon;
- ;}
+ }
+
break;
case 19:
{
- yyTimezone = (yyvsp[(1) - (1)].Number);
+ yyTimezone = (yyvsp[0].Number);
yyDSTmode = DSToff;
- ;}
+ }
+
break;
case 20:
{
- yyTimezone = (yyvsp[(1) - (1)].Number);
+ yyTimezone = (yyvsp[0].Number);
yyDSTmode = DSTon;
- ;}
+ }
+
break;
case 21:
{
yyDayOrdinal = 1;
- yyDayNumber = (yyvsp[(1) - (1)].Number);
- ;}
+ yyDayNumber = (yyvsp[0].Number);
+ }
+
break;
case 22:
{
yyDayOrdinal = 1;
- yyDayNumber = (yyvsp[(1) - (2)].Number);
- ;}
+ yyDayNumber = (yyvsp[-1].Number);
+ }
+
break;
case 23:
{
- yyDayOrdinal = (yyvsp[(1) - (2)].Number);
- yyDayNumber = (yyvsp[(2) - (2)].Number);
- ;}
+ yyDayOrdinal = (yyvsp[-1].Number);
+ yyDayNumber = (yyvsp[0].Number);
+ }
+
break;
case 24:
{
- yyDayOrdinal = (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number);
- yyDayNumber = (yyvsp[(3) - (3)].Number);
- ;}
+ yyDayOrdinal = (yyvsp[-2].Number) * (yyvsp[-1].Number);
+ yyDayNumber = (yyvsp[0].Number);
+ }
+
break;
case 25:
{
yyDayOrdinal = 2;
- yyDayNumber = (yyvsp[(2) - (2)].Number);
- ;}
+ yyDayNumber = (yyvsp[0].Number);
+ }
+
break;
case 26:
{
- yyMonth = (yyvsp[(1) - (3)].Number);
- yyDay = (yyvsp[(3) - (3)].Number);
- ;}
+ yyMonth = (yyvsp[-2].Number);
+ yyDay = (yyvsp[0].Number);
+ }
+
break;
case 27:
{
- yyMonth = (yyvsp[(1) - (5)].Number);
- yyDay = (yyvsp[(3) - (5)].Number);
- yyYear = (yyvsp[(5) - (5)].Number);
- ;}
+ yyMonth = (yyvsp[-4].Number);
+ yyDay = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 28:
{
- yyYear = (yyvsp[(1) - (1)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (1)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (1)].Number) % 100;
- ;}
+ yyYear = (yyvsp[0].Number) / 10000;
+ yyMonth = ((yyvsp[0].Number) % 10000)/100;
+ yyDay = (yyvsp[0].Number) % 100;
+ }
+
break;
case 29:
{
- yyDay = (yyvsp[(1) - (5)].Number);
- yyMonth = (yyvsp[(3) - (5)].Number);
- yyYear = (yyvsp[(5) - (5)].Number);
- ;}
+ yyDay = (yyvsp[-4].Number);
+ yyMonth = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 30:
{
- yyMonth = (yyvsp[(3) - (5)].Number);
- yyDay = (yyvsp[(5) - (5)].Number);
- yyYear = (yyvsp[(1) - (5)].Number);
- ;}
+ yyMonth = (yyvsp[-2].Number);
+ yyDay = (yyvsp[0].Number);
+ yyYear = (yyvsp[-4].Number);
+ }
+
break;
case 31:
{
- yyMonth = (yyvsp[(1) - (2)].Number);
- yyDay = (yyvsp[(2) - (2)].Number);
- ;}
+ yyMonth = (yyvsp[-1].Number);
+ yyDay = (yyvsp[0].Number);
+ }
+
break;
case 32:
{
- yyMonth = (yyvsp[(1) - (4)].Number);
- yyDay = (yyvsp[(2) - (4)].Number);
- yyYear = (yyvsp[(4) - (4)].Number);
- ;}
+ yyMonth = (yyvsp[-3].Number);
+ yyDay = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 33:
{
- yyMonth = (yyvsp[(2) - (2)].Number);
- yyDay = (yyvsp[(1) - (2)].Number);
- ;}
+ yyMonth = (yyvsp[0].Number);
+ yyDay = (yyvsp[-1].Number);
+ }
+
break;
case 34:
@@ -1863,70 +1829,77 @@ yyreduce:
yyMonth = 1;
yyDay = 1;
yyYear = EPOCH;
- ;}
+ }
+
break;
case 35:
{
- yyMonth = (yyvsp[(2) - (3)].Number);
- yyDay = (yyvsp[(1) - (3)].Number);
- yyYear = (yyvsp[(3) - (3)].Number);
- ;}
+ yyMonth = (yyvsp[-1].Number);
+ yyDay = (yyvsp[-2].Number);
+ yyYear = (yyvsp[0].Number);
+ }
+
break;
case 36:
{
yyMonthOrdinal = 1;
- yyMonth = (yyvsp[(2) - (2)].Number);
- ;}
+ yyMonth = (yyvsp[0].Number);
+ }
+
break;
case 37:
{
- yyMonthOrdinal = (yyvsp[(2) - (3)].Number);
- yyMonth = (yyvsp[(3) - (3)].Number);
- ;}
+ yyMonthOrdinal = (yyvsp[-1].Number);
+ yyMonth = (yyvsp[0].Number);
+ }
+
break;
case 38:
{
- if ((yyvsp[(2) - (3)].Number) != HOUR( 7)) YYABORT;
- yyYear = (yyvsp[(1) - (3)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (3)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (3)].Number) % 100;
- yyHour = (yyvsp[(3) - (3)].Number) / 10000;
- yyMinutes = ((yyvsp[(3) - (3)].Number) % 10000)/100;
- yySeconds = (yyvsp[(3) - (3)].Number) % 100;
- ;}
+ if ((yyvsp[-1].Number) != HOUR( 7)) YYABORT;
+ yyYear = (yyvsp[-2].Number) / 10000;
+ yyMonth = ((yyvsp[-2].Number) % 10000)/100;
+ yyDay = (yyvsp[-2].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 10000;
+ yyMinutes = ((yyvsp[0].Number) % 10000)/100;
+ yySeconds = (yyvsp[0].Number) % 100;
+ }
+
break;
case 39:
{
- if ((yyvsp[(2) - (7)].Number) != HOUR( 7)) YYABORT;
- yyYear = (yyvsp[(1) - (7)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (7)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (7)].Number) % 100;
- yyHour = (yyvsp[(3) - (7)].Number);
- yyMinutes = (yyvsp[(5) - (7)].Number);
- yySeconds = (yyvsp[(7) - (7)].Number);
- ;}
+ if ((yyvsp[-5].Number) != HOUR( 7)) YYABORT;
+ yyYear = (yyvsp[-6].Number) / 10000;
+ yyMonth = ((yyvsp[-6].Number) % 10000)/100;
+ yyDay = (yyvsp[-6].Number) % 100;
+ yyHour = (yyvsp[-4].Number);
+ yyMinutes = (yyvsp[-2].Number);
+ yySeconds = (yyvsp[0].Number);
+ }
+
break;
case 40:
{
- yyYear = (yyvsp[(1) - (2)].Number) / 10000;
- yyMonth = ((yyvsp[(1) - (2)].Number) % 10000)/100;
- yyDay = (yyvsp[(1) - (2)].Number) % 100;
- yyHour = (yyvsp[(2) - (2)].Number) / 10000;
- yyMinutes = ((yyvsp[(2) - (2)].Number) % 10000)/100;
- yySeconds = (yyvsp[(2) - (2)].Number) % 100;
- ;}
+ yyYear = (yyvsp[-1].Number) / 10000;
+ yyMonth = ((yyvsp[-1].Number) % 10000)/100;
+ yyDay = (yyvsp[-1].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 10000;
+ yyMinutes = ((yyvsp[0].Number) % 10000)/100;
+ yySeconds = (yyvsp[0].Number) % 100;
+ }
+
break;
case 41:
@@ -1937,12 +1910,13 @@ yyreduce:
* in a range accessible with a 32 bit clock seconds value.
*/
- yyYear = (yyvsp[(2) - (4)].Number)/1000 + 2323 - 377;
+ yyYear = (yyvsp[-2].Number)/1000 + 2323 - 377;
yyDay = 1;
yyMonth = 1;
- yyRelDay += (((yyvsp[(2) - (4)].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
- yyRelSeconds += (yyvsp[(4) - (4)].Number) * 144 * 60;
- ;}
+ yyRelDay += (((yyvsp[-2].Number)%1000)*(365 + IsLeapYear(yyYear)))/1000;
+ yyRelSeconds += (yyvsp[0].Number) * 144 * 60;
+ }
+
break;
case 42:
@@ -1951,121 +1925,145 @@ yyreduce:
yyRelSeconds *= -1;
yyRelMonth *= -1;
yyRelDay *= -1;
- ;}
+ }
+
break;
case 44:
{
- *yyRelPointer += (yyvsp[(1) - (3)].Number) * (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-2].Number) * (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
case 45:
{
- *yyRelPointer += (yyvsp[(1) - (2)].Number) * (yyvsp[(2) - (2)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
case 46:
{
- *yyRelPointer += (yyvsp[(2) - (2)].Number);
- ;}
+ *yyRelPointer += (yyvsp[0].Number);
+ }
+
break;
case 47:
{
- *yyRelPointer += (yyvsp[(2) - (3)].Number) * (yyvsp[(3) - (3)].Number);
- ;}
+ *yyRelPointer += (yyvsp[-1].Number) * (yyvsp[0].Number);
+ }
+
break;
case 48:
{
- *yyRelPointer += (yyvsp[(1) - (1)].Number);
- ;}
+ *yyRelPointer += (yyvsp[0].Number);
+ }
+
break;
case 49:
{
(yyval.Number) = -1;
- ;}
+ }
+
break;
case 50:
{
(yyval.Number) = 1;
- ;}
+ }
+
break;
case 51:
{
- (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ (yyval.Number) = (yyvsp[0].Number);
yyRelPointer = &yyRelSeconds;
- ;}
+ }
+
break;
case 52:
{
- (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ (yyval.Number) = (yyvsp[0].Number);
yyRelPointer = &yyRelDay;
- ;}
+ }
+
break;
case 53:
{
- (yyval.Number) = (yyvsp[(1) - (1)].Number);
+ (yyval.Number) = (yyvsp[0].Number);
yyRelPointer = &yyRelMonth;
- ;}
+ }
+
break;
case 54:
{
if (yyHaveTime && yyHaveDate && !yyHaveRel) {
- yyYear = (yyvsp[(1) - (1)].Number);
+ yyYear = (yyvsp[0].Number);
} else {
yyHaveTime++;
if (yyDigitCount <= 2) {
- yyHour = (yyvsp[(1) - (1)].Number);
+ yyHour = (yyvsp[0].Number);
yyMinutes = 0;
} else {
- yyHour = (yyvsp[(1) - (1)].Number) / 100;
- yyMinutes = (yyvsp[(1) - (1)].Number) % 100;
+ yyHour = (yyvsp[0].Number) / 100;
+ yyMinutes = (yyvsp[0].Number) % 100;
}
yySeconds = 0;
yyMeridian = MER24;
}
- ;}
+ }
+
break;
case 55:
{
(yyval.Meridian) = MER24;
- ;}
+ }
+
break;
case 56:
{
- (yyval.Meridian) = (yyvsp[(1) - (1)].Meridian);
- ;}
+ (yyval.Meridian) = (yyvsp[0].Meridian);
+ }
+
break;
-/* Line 1267 of yacc.c. */
default: break;
}
+ /* User semantic actions sometimes alter yychar, and that requires
+ that yytoken be updated with the new translation. We take the
+ approach of translating immediately before every use of yytoken.
+ One alternative is translating here after every semantic action,
+ but that translation would be missed if the semantic action invokes
+ YYABORT, YYACCEPT, or YYERROR immediately after altering yychar or
+ if it invokes YYBACKUP. In the case of YYABORT or YYACCEPT, an
+ incorrect destructor might then be invoked immediately. In the
+ case of YYERROR or YYBACKUP, subsequent parser actions might lead
+ to an incorrect destructor call or verbose syntax error message
+ before the lookahead is translated. */
YY_SYMBOL_PRINT ("-> $$ =", yyr1[yyn], &yyval, &yyloc);
YYPOPSTACK (yylen);
@@ -2075,7 +2073,7 @@ yyreduce:
*++yyvsp = yyval;
*++yylsp = yyloc;
- /* Now `shift' the result of the reduction. Determine what state
+ /* Now 'shift' the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
number reduced by. */
@@ -2090,10 +2088,14 @@ yyreduce:
goto yynewstate;
-/*------------------------------------.
-| yyerrlab -- here on detecting error |
-`------------------------------------*/
+/*--------------------------------------.
+| yyerrlab -- here on detecting error. |
+`--------------------------------------*/
yyerrlab:
+ /* Make sure we have latest lookahead translation. See comments at
+ user semantic actions for why this is necessary. */
+ yytoken = yychar == YYEMPTY ? YYEMPTY : YYTRANSLATE (yychar);
+
/* If not already recovering from an error, report this error. */
if (!yyerrstatus)
{
@@ -2101,62 +2103,61 @@ yyerrlab:
#if ! YYERROR_VERBOSE
yyerror (&yylloc, info, YY_("syntax error"));
#else
+# define YYSYNTAX_ERROR yysyntax_error (&yymsg_alloc, &yymsg, \
+ yyssp, yytoken)
{
- YYSIZE_T yysize = yysyntax_error (0, yystate, yychar);
- if (yymsg_alloc < yysize && yymsg_alloc < YYSTACK_ALLOC_MAXIMUM)
- {
- YYSIZE_T yyalloc = 2 * yysize;
- if (! (yysize <= yyalloc && yyalloc <= YYSTACK_ALLOC_MAXIMUM))
- yyalloc = YYSTACK_ALLOC_MAXIMUM;
- if (yymsg != yymsgbuf)
- YYSTACK_FREE (yymsg);
- yymsg = (char *) YYSTACK_ALLOC (yyalloc);
- if (yymsg)
- yymsg_alloc = yyalloc;
- else
- {
- yymsg = yymsgbuf;
- yymsg_alloc = sizeof yymsgbuf;
- }
- }
-
- if (0 < yysize && yysize <= yymsg_alloc)
- {
- (void) yysyntax_error (yymsg, yystate, yychar);
- yyerror (&yylloc, info, yymsg);
- }
- else
- {
- yyerror (&yylloc, info, YY_("syntax error"));
- if (yysize != 0)
- goto yyexhaustedlab;
- }
+ char const *yymsgp = YY_("syntax error");
+ int yysyntax_error_status;
+ yysyntax_error_status = YYSYNTAX_ERROR;
+ if (yysyntax_error_status == 0)
+ yymsgp = yymsg;
+ else if (yysyntax_error_status == 1)
+ {
+ if (yymsg != yymsgbuf)
+ YYSTACK_FREE (yymsg);
+ yymsg = (char *) YYSTACK_ALLOC (yymsg_alloc);
+ if (!yymsg)
+ {
+ yymsg = yymsgbuf;
+ yymsg_alloc = sizeof yymsgbuf;
+ yysyntax_error_status = 2;
+ }
+ else
+ {
+ yysyntax_error_status = YYSYNTAX_ERROR;
+ yymsgp = yymsg;
+ }
+ }
+ yyerror (&yylloc, info, yymsgp);
+ if (yysyntax_error_status == 2)
+ goto yyexhaustedlab;
}
+# undef YYSYNTAX_ERROR
#endif
}
- yyerror_range[0] = yylloc;
+ yyerror_range[1] = yylloc;
if (yyerrstatus == 3)
{
- /* If just tried and failed to reuse look-ahead token after an
- error, discard it. */
+ /* If just tried and failed to reuse lookahead token after an
+ error, discard it. */
if (yychar <= YYEOF)
- {
- /* Return failure if at end of input. */
- if (yychar == YYEOF)
- YYABORT;
- }
+ {
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF)
+ YYABORT;
+ }
else
- {
- yydestruct ("Error: discarding",
- yytoken, &yylval, &yylloc, info);
- yychar = YYEMPTY;
- }
+ {
+ yydestruct ("Error: discarding",
+ yytoken, &yylval, &yylloc, info);
+ yychar = YYEMPTY;
+ }
}
- /* Else will try to reuse look-ahead token after shifting the error
+ /* Else will try to reuse lookahead token after shifting the error
token. */
goto yyerrlab1;
@@ -2172,8 +2173,7 @@ yyerrorlab:
if (/*CONSTCOND*/ 0)
goto yyerrorlab;
- yyerror_range[0] = yylsp[1-yylen];
- /* Do not reclaim the symbols of the rule which action triggered
+ /* Do not reclaim the symbols of the rule whose action triggered
this YYERROR. */
YYPOPSTACK (yylen);
yylen = 0;
@@ -2186,43 +2186,42 @@ yyerrorlab:
| yyerrlab1 -- common code for both syntax error and YYERROR. |
`-------------------------------------------------------------*/
yyerrlab1:
- yyerrstatus = 3; /* Each real token shifted decrements this. */
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
for (;;)
{
yyn = yypact[yystate];
- if (yyn != YYPACT_NINF)
- {
- yyn += YYTERROR;
- if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
- {
- yyn = yytable[yyn];
- if (0 < yyn)
- break;
- }
- }
+ if (!yypact_value_is_default (yyn))
+ {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR)
+ {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
+ }
/* Pop the current state because it cannot handle the error token. */
if (yyssp == yyss)
- YYABORT;
+ YYABORT;
- yyerror_range[0] = *yylsp;
+ yyerror_range[1] = *yylsp;
yydestruct ("Error: popping",
- yystos[yystate], yyvsp, yylsp, info);
+ yystos[yystate], yyvsp, yylsp, info);
YYPOPSTACK (1);
yystate = *yyssp;
YY_STACK_PRINT (yyss, yyssp);
}
- if (yyn == YYFINAL)
- YYACCEPT;
-
+ YY_IGNORE_MAYBE_UNINITIALIZED_BEGIN
*++yyvsp = yylval;
+ YY_IGNORE_MAYBE_UNINITIALIZED_END
- yyerror_range[1] = yylloc;
+ yyerror_range[2] = yylloc;
/* Using YYLLOC is tempting, but would change the location of
- the look-ahead. YYLOC is available though. */
- YYLLOC_DEFAULT (yyloc, (yyerror_range - 1), 2);
+ the lookahead. YYLOC is available though. */
+ YYLLOC_DEFAULT (yyloc, yyerror_range, 2);
*++yylsp = yyloc;
/* Shift the error token. */
@@ -2246,7 +2245,7 @@ yyabortlab:
yyresult = 1;
goto yyreturn;
-#ifndef yyoverflow
+#if !defined yyoverflow || YYERROR_VERBOSE
/*-------------------------------------------------.
| yyexhaustedlab -- memory exhaustion comes here. |
`-------------------------------------------------*/
@@ -2257,17 +2256,22 @@ yyexhaustedlab:
#endif
yyreturn:
- if (yychar != YYEOF && yychar != YYEMPTY)
- yydestruct ("Cleanup: discarding lookahead",
- yytoken, &yylval, &yylloc, info);
- /* Do not reclaim the symbols of the rule which action triggered
+ if (yychar != YYEMPTY)
+ {
+ /* Make sure we have latest lookahead translation. See comments at
+ user semantic actions for why this is necessary. */
+ yytoken = YYTRANSLATE (yychar);
+ yydestruct ("Cleanup: discarding lookahead",
+ yytoken, &yylval, &yylloc, info);
+ }
+ /* Do not reclaim the symbols of the rule whose action triggered
this YYABORT or YYACCEPT. */
YYPOPSTACK (yylen);
YY_STACK_PRINT (yyss, yyssp);
while (yyssp != yyss)
{
yydestruct ("Cleanup: popping",
- yystos[*yyssp], yyvsp, yylsp, info);
+ yystos[*yyssp], yyvsp, yylsp, info);
YYPOPSTACK (1);
}
#ifndef yyoverflow
@@ -2278,13 +2282,10 @@ yyreturn:
if (yymsg != yymsgbuf)
YYSTACK_FREE (yymsg);
#endif
- /* Make sure YYID is used. */
- return YYID (yyresult);
+ return yyresult;
}
-
-
/*
* Month and day table.
*/
@@ -2680,7 +2681,7 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (TclIsSpaceProc(*yyInput)) {
+ while (TclIsSpaceProc(UCHAR(*yyInput))) {
yyInput++;
}
@@ -2743,7 +2744,7 @@ TclDatelex(
int
TclClockOldscanObjCmd(
- ClientData clientData, /* Unused */
+ void *clientData, /* Unused */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Count of paraneters */
Tcl_Obj *const *objv) /* Parameters */
@@ -2911,4 +2912,3 @@ TclClockOldscanObjCmd(
* fill-column: 78
* End:
*/
-
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 3de71af..865c960 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -23,6 +23,15 @@
# endif
#endif
+#if !defined(BUILD_tcl)
+# define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
+#elif defined(TCL_NO_DEPRECATED)
+# define TCL_DEPRECATED(msg) MODULE_SCOPE
+#else
+# define TCL_DEPRECATED(msg) EXTERN
+#endif
+
+
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
* script. Any modifications to the function declarations below should be made
@@ -44,7 +53,7 @@ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp,
const char *name, const char *version,
const void *clientData);
/* 1 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp,
+EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 2 */
@@ -110,7 +119,8 @@ EXTERN void Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
EXTERN int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
int line);
/* 22 */
-EXTERN Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj * Tcl_DbNewBooleanObj(int boolValue, const char *file,
int line);
/* 23 */
EXTERN Tcl_Obj * Tcl_DbNewByteArrayObj(const unsigned char *bytes,
@@ -122,7 +132,8 @@ EXTERN Tcl_Obj * Tcl_DbNewDoubleObj(double doubleValue,
EXTERN Tcl_Obj * Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
const char *file, int line);
/* 26 */
-EXTERN Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj * Tcl_DbNewLongObj(long longValue, const char *file,
int line);
/* 27 */
EXTERN Tcl_Obj * Tcl_DbNewObj(const char *file, int line);
@@ -132,7 +143,7 @@ EXTERN Tcl_Obj * Tcl_DbNewStringObj(const char *bytes, int length,
/* 29 */
EXTERN Tcl_Obj * Tcl_DuplicateObj(Tcl_Obj *objPtr);
/* 30 */
-EXTERN void TclFreeObj(Tcl_Obj *objPtr);
+EXTERN void TclOldFreeObj(Tcl_Obj *objPtr);
/* 31 */
EXTERN int Tcl_GetBoolean(Tcl_Interp *interp, const char *src,
int *boolPtr);
@@ -149,9 +160,9 @@ EXTERN int Tcl_GetDouble(Tcl_Interp *interp, const char *src,
EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, double *doublePtr);
/* 36 */
-EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr,
- CONST84 char *const *tablePtr,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_GetIndexFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, const char *const *tablePtr,
const char *msg, int flags, int *indexPtr);
/* 37 */
EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src,
@@ -190,24 +201,28 @@ EXTERN int Tcl_ListObjReplace(Tcl_Interp *interp,
Tcl_Obj *listPtr, int first, int count,
int objc, Tcl_Obj *const objv[]);
/* 49 */
-EXTERN Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj * Tcl_NewBooleanObj(int boolValue);
/* 50 */
EXTERN Tcl_Obj * Tcl_NewByteArrayObj(const unsigned char *bytes,
int length);
/* 51 */
EXTERN Tcl_Obj * Tcl_NewDoubleObj(double doubleValue);
/* 52 */
-EXTERN Tcl_Obj * Tcl_NewIntObj(int intValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj * Tcl_NewIntObj(int intValue);
/* 53 */
EXTERN Tcl_Obj * Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
/* 54 */
-EXTERN Tcl_Obj * Tcl_NewLongObj(long longValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj * Tcl_NewLongObj(long longValue);
/* 55 */
EXTERN Tcl_Obj * Tcl_NewObj(void);
/* 56 */
EXTERN Tcl_Obj * Tcl_NewStringObj(const char *bytes, int length);
/* 57 */
-EXTERN void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
/* 58 */
EXTERN unsigned char * Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
/* 59 */
@@ -216,22 +231,26 @@ EXTERN void Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
/* 60 */
EXTERN void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
/* 61 */
-EXTERN void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
/* 62 */
EXTERN void Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
Tcl_Obj *const objv[]);
/* 63 */
-EXTERN void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
/* 64 */
EXTERN void Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
/* 65 */
EXTERN void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
int length);
/* 66 */
-EXTERN void Tcl_AddErrorInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_AddErrorInfo(Tcl_Interp *interp,
const char *message);
/* 67 */
-EXTERN void Tcl_AddObjErrorInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_AddObjErrorInfo(Tcl_Interp *interp,
const char *message, int length);
/* 68 */
EXTERN void Tcl_AllowExceptions(Tcl_Interp *interp);
@@ -252,9 +271,11 @@ EXTERN void Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
EXTERN int Tcl_AsyncReady(void);
/* 76 */
-EXTERN void Tcl_BackgroundError(Tcl_Interp *interp);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
-EXTERN char Tcl_Backslash(const char *src, int *readPtr);
+TCL_DEPRECATED("Use Tcl_UtfBackslash")
+char Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp,
const char *optionName,
@@ -271,7 +292,7 @@ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan);
/* 82 */
EXTERN int Tcl_CommandComplete(const char *cmd);
/* 83 */
-EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv);
+EXTERN char * Tcl_Concat(int argc, const char *const *argv);
/* 84 */
EXTERN int Tcl_ConvertElement(const char *src, char *dst,
int flags);
@@ -282,7 +303,7 @@ EXTERN int Tcl_ConvertCountedElement(const char *src,
EXTERN int Tcl_CreateAlias(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
const char *targetCmd, int argc,
- CONST84 char *const *argv);
+ const char *const *argv);
/* 87 */
EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave,
const char *slaveCmd, Tcl_Interp *target,
@@ -313,7 +334,8 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc,
/* 94 */
EXTERN Tcl_Interp * Tcl_CreateInterp(void);
/* 95 */
-EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp,
+TCL_DEPRECATED("")
+void Tcl_CreateMathFunc(Tcl_Interp *interp,
const char *name, int numArgs,
Tcl_ValueType *argTypes, Tcl_MathProc *proc,
ClientData clientData);
@@ -403,16 +425,17 @@ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr);
/* 126 */
EXTERN int Tcl_Eof(Tcl_Channel chan);
/* 127 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
+EXTERN const char * Tcl_ErrnoId(void);
/* 128 */
-EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
+EXTERN const char * Tcl_ErrnoMsg(int err);
/* 129 */
EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
EXTERN int Tcl_EvalFile(Tcl_Interp *interp,
const char *fileName);
/* 131 */
-EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* 132 */
EXTERN void Tcl_EventuallyFree(ClientData clientData,
Tcl_FreeProc *freeProc);
@@ -460,13 +483,13 @@ EXTERN void Tcl_FreeResult(Tcl_Interp *interp);
EXTERN int Tcl_GetAlias(Tcl_Interp *interp,
const char *slaveCmd,
Tcl_Interp **targetInterpPtr,
- CONST84 char **targetCmdPtr, int *argcPtr,
- CONST84 char ***argvPtr);
+ const char **targetCmdPtr, int *argcPtr,
+ const char ***argvPtr);
/* 149 */
EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp,
const char *slaveCmd,
Tcl_Interp **targetInterpPtr,
- CONST84 char **targetCmdPtr, int *objcPtr,
+ const char **targetCmdPtr, int *objcPtr,
Tcl_Obj ***objv);
/* 150 */
EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp,
@@ -485,7 +508,7 @@ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan);
/* 155 */
EXTERN int Tcl_GetChannelMode(Tcl_Channel chan);
/* 156 */
-EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan);
+EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan);
/* 157 */
EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp,
Tcl_Channel chan, const char *optionName,
@@ -496,12 +519,12 @@ EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan);
EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp,
const char *cmdName, Tcl_CmdInfo *infoPtr);
/* 160 */
-EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp,
+EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp,
Tcl_Command command);
/* 161 */
EXTERN int Tcl_GetErrno(void);
/* 162 */
-EXTERN CONST84_RETURN char * Tcl_GetHostName(void);
+EXTERN const char * Tcl_GetHostName(void);
/* 163 */
EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp,
Tcl_Interp *slaveInterp);
@@ -537,19 +560,20 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp,
/* 173 */
EXTERN Tcl_Channel Tcl_GetStdChannel(int type);
/* 174 */
-EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp);
+EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp);
/* 175 */
-EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp,
- const char *varName, int flags);
-/* 176 */
-EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp,
- const char *part1, const char *part2,
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName,
int flags);
+/* 176 */
+EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, int flags);
/* 177 */
EXTERN int Tcl_GlobalEval(Tcl_Interp *interp,
const char *command);
/* 178 */
-EXTERN int Tcl_GlobalEvalObj(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_GlobalEvalObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 179 */
EXTERN int Tcl_HideCommand(Tcl_Interp *interp,
@@ -569,7 +593,7 @@ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp);
/* 185 */
EXTERN int Tcl_IsSafe(Tcl_Interp *interp);
/* 186 */
-EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv,
+EXTERN char * Tcl_JoinPath(int argc, const char *const *argv,
Tcl_DString *resultPtr);
/* 187 */
EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName,
@@ -582,7 +606,7 @@ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp);
/* 191 */
EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket);
/* 192 */
-EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv);
+EXTERN char * Tcl_Merge(int argc, const char *const *argv);
/* 193 */
EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr);
/* 194 */
@@ -596,7 +620,7 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
int flags);
/* 197 */
EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc,
- CONST84 char **argv, int flags);
+ const char **argv, int flags);
/* 198 */
EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp,
const char *fileName, const char *modeString,
@@ -618,7 +642,7 @@ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value,
/* 203 */
EXTERN int Tcl_PutEnv(const char *assignment);
/* 204 */
-EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp);
+EXTERN const char * Tcl_PosixError(Tcl_Interp *interp);
/* 205 */
EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr,
Tcl_QueuePosition position);
@@ -648,8 +672,7 @@ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text,
const char *pattern);
/* 215 */
EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index,
- CONST84 char **startPtr,
- CONST84 char **endPtr);
+ const char **startPtr, const char **endPtr);
/* 216 */
EXTERN void Tcl_Release(ClientData clientData);
/* 217 */
@@ -660,7 +683,8 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
int *flagPtr);
/* 220 */
-EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
+TCL_DEPRECATED("")
+int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* 221 */
EXTERN int Tcl_ServiceAll(void);
/* 222 */
@@ -704,26 +728,26 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp,
/* 236 */
EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type);
/* 237 */
-EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp,
- const char *varName, const char *newValue,
- int flags);
-/* 238 */
-EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp,
- const char *part1, const char *part2,
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName,
const char *newValue, int flags);
+/* 238 */
+EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
+ const char *part2, const char *newValue,
+ int flags);
/* 239 */
-EXTERN CONST84_RETURN char * Tcl_SignalId(int sig);
+EXTERN const char * Tcl_SignalId(int sig);
/* 240 */
-EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig);
+EXTERN const char * Tcl_SignalMsg(int sig);
/* 241 */
EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp);
/* 242 */
EXTERN int Tcl_SplitList(Tcl_Interp *interp,
const char *listStr, int *argcPtr,
- CONST84 char ***argvPtr);
+ const char ***argvPtr);
/* 243 */
EXTERN void Tcl_SplitPath(const char *path, int *argcPtr,
- CONST84 char ***argvPtr);
+ const char ***argvPtr);
/* 244 */
EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
const char *pkgName,
@@ -732,9 +756,11 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
/* 245 */
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
-EXTERN int Tcl_TellOld(Tcl_Channel chan);
+TCL_DEPRECATED("")
+int Tcl_TellOld(Tcl_Channel chan);
/* 247 */
-EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
int flags, Tcl_VarTraceProc *proc,
ClientData clientData);
/* 248 */
@@ -755,13 +781,15 @@ EXTERN void Tcl_UnlinkVar(Tcl_Interp *interp,
EXTERN int Tcl_UnregisterChannel(Tcl_Interp *interp,
Tcl_Channel chan);
/* 253 */
-EXTERN int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
int flags);
/* 254 */
EXTERN int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
const char *part2, int flags);
/* 255 */
-EXTERN void Tcl_UntraceVar(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+void Tcl_UntraceVar(Tcl_Interp *interp,
const char *varName, int flags,
Tcl_VarTraceProc *proc,
ClientData clientData);
@@ -774,7 +802,8 @@ EXTERN void Tcl_UntraceVar2(Tcl_Interp *interp,
EXTERN void Tcl_UpdateLinkedVar(Tcl_Interp *interp,
const char *varName);
/* 258 */
-EXTERN int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
const char *varName, const char *localName,
int flags);
/* 259 */
@@ -784,7 +813,8 @@ EXTERN int Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
/* 260 */
EXTERN int Tcl_VarEval(Tcl_Interp *interp, ...);
/* 261 */
-EXTERN ClientData Tcl_VarTraceInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+ClientData Tcl_VarTraceInfo(Tcl_Interp *interp,
const char *varName, int flags,
Tcl_VarTraceProc *procPtr,
ClientData prevClientData);
@@ -803,40 +833,46 @@ EXTERN int Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
-EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp,
+TCL_DEPRECATED("see TIP #422")
+void Tcl_AppendResultVA(Tcl_Interp *interp,
va_list argList);
/* 268 */
-EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
+TCL_DEPRECATED("see TIP #422")
+void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
va_list argList);
/* 269 */
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
/* 270 */
-EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp,
- const char *start, CONST84 char **termPtr);
+EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start,
+ const char **termPtr);
/* 271 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp,
- const char *name, const char *version,
- int exact);
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
+ const char *version, int exact);
/* 272 */
-EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp,
+EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp,
const char *name, const char *version,
int exact, void *clientDataPtr);
/* 273 */
-EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
const char *version);
/* 274 */
-EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
- const char *name, const char *version,
- int exact);
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
+ const char *version, int exact);
/* 275 */
-EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
+TCL_DEPRECATED("see TIP #422")
+void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
va_list argList);
/* 276 */
-EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
+TCL_DEPRECATED("see TIP #422")
+int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
-EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
+TCL_DEPRECATED("see TIP #422")
+TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
@@ -878,7 +914,7 @@ EXTERN int Tcl_EvalObjv(Tcl_Interp *interp, int objc,
EXTERN int Tcl_EvalObjEx(Tcl_Interp *interp, Tcl_Obj *objPtr,
int flags);
/* 294 */
-EXTERN void Tcl_ExitThread(int status);
+EXTERN TCL_NORETURN void Tcl_ExitThread(int status);
/* 295 */
EXTERN int Tcl_ExternalToUtf(Tcl_Interp *interp,
Tcl_Encoding encoding, const char *src,
@@ -901,7 +937,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void);
/* 301 */
EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name);
/* 302 */
-EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding);
+EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding);
/* 303 */
EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp);
/* 304 */
@@ -950,30 +986,30 @@ EXTERN void Tcl_ThreadAlert(Tcl_ThreadId threadId);
EXTERN void Tcl_ThreadQueueEvent(Tcl_ThreadId threadId,
Tcl_Event *evPtr, Tcl_QueuePosition position);
/* 320 */
-EXTERN Tcl_UniChar Tcl_UniCharAtIndex(const char *src, int index);
+EXTERN int Tcl_UniCharAtIndex(const char *src, int index);
/* 321 */
-EXTERN Tcl_UniChar Tcl_UniCharToLower(int ch);
+EXTERN int Tcl_UniCharToLower(int ch);
/* 322 */
-EXTERN Tcl_UniChar Tcl_UniCharToTitle(int ch);
+EXTERN int Tcl_UniCharToTitle(int ch);
/* 323 */
-EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch);
+EXTERN int Tcl_UniCharToUpper(int ch);
/* 324 */
EXTERN int Tcl_UniCharToUtf(int ch, char *buf);
/* 325 */
-EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index);
+EXTERN const char * Tcl_UtfAtIndex(const char *src, int index);
/* 326 */
EXTERN int Tcl_UtfCharComplete(const char *src, int length);
/* 327 */
EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr,
char *dst);
/* 328 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch);
+EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch);
/* 329 */
-EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch);
+EXTERN const char * Tcl_UtfFindLast(const char *src, int ch);
/* 330 */
-EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src);
+EXTERN const char * Tcl_UtfNext(const char *src);
/* 331 */
-EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start);
+EXTERN const char * Tcl_UtfPrev(const char *src, const char *start);
/* 332 */
EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp,
Tcl_Encoding encoding, const char *src,
@@ -1001,9 +1037,11 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char * Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
-EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
+TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
+const char * Tcl_GetDefaultEncodingDir(void);
/* 342 */
-EXTERN void Tcl_SetDefaultEncodingDir(const char *path);
+TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
+void Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
EXTERN void Tcl_AlertNotifier(ClientData clientData);
/* 344 */
@@ -1038,7 +1076,8 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length,
EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp,
Tcl_Obj *patObj, int flags);
/* 357 */
-EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
+TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
+Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp,
Tcl_Token *tokenPtr, int count);
/* 358 */
EXTERN void Tcl_FreeParse(Tcl_Parse *parsePtr);
@@ -1050,7 +1089,7 @@ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp,
EXTERN int Tcl_ParseBraces(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append,
- CONST84 char **termPtr);
+ const char **termPtr);
/* 361 */
EXTERN int Tcl_ParseCommand(Tcl_Interp *interp,
const char *start, int numBytes, int nested,
@@ -1062,7 +1101,7 @@ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp,
const char *start, int numBytes,
Tcl_Parse *parsePtr, int append,
- CONST84 char **termPtr);
+ const char **termPtr);
/* 364 */
EXTERN int Tcl_ParseVarName(Tcl_Interp *interp,
const char *start, int numBytes,
@@ -1108,9 +1147,10 @@ EXTERN void Tcl_SetUnicodeObj(Tcl_Obj *objPtr,
/* 380 */
EXTERN int Tcl_GetCharLength(Tcl_Obj *objPtr);
/* 381 */
-EXTERN Tcl_UniChar Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
+EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
/* 382 */
-EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
/* 384 */
@@ -1152,8 +1192,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan);
/* 397 */
EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan);
/* 398 */
-EXTERN CONST84_RETURN char * Tcl_ChannelName(
- const Tcl_ChannelType *chanTypePtr);
+EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr);
/* 399 */
EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion(
const Tcl_ChannelType *chanTypePtr);
@@ -1259,13 +1298,15 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel);
EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
int *lengthPtr);
/* 435 */
-EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("")
+int Tcl_GetMathFuncInfo(Tcl_Interp *interp,
const char *name, int *numArgsPtr,
Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr,
ClientData *clientDataPtr);
/* 436 */
-EXTERN Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
+TCL_DEPRECATED("")
+Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp,
const char *pattern);
/* 437 */
EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -1816,6 +1857,45 @@ EXTERN int Tcl_FSUnloadFile(Tcl_Interp *interp,
EXTERN void Tcl_ZlibStreamSetCompressionDictionary(
Tcl_ZlibStream zhandle,
Tcl_Obj *compressionDictionaryObj);
+/* 631 */
+EXTERN Tcl_Channel Tcl_OpenTcpServerEx(Tcl_Interp *interp,
+ const char *service, const char *host,
+ unsigned int flags,
+ Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData);
+/* 632 */
+EXTERN int TclZipfs_Mount(Tcl_Interp *interp,
+ const char *mountPoint, const char *zipname,
+ const char *passwd);
+/* 633 */
+EXTERN int TclZipfs_Unmount(Tcl_Interp *interp,
+ const char *mountPoint);
+/* 634 */
+EXTERN Tcl_Obj * TclZipfs_TclLibrary(void);
+/* 635 */
+EXTERN int TclZipfs_MountBuffer(Tcl_Interp *interp,
+ const char *mountPoint, unsigned char *data,
+ size_t datalen, int copy);
+/* 636 */
+EXTERN void Tcl_FreeIntRep(Tcl_Obj *objPtr);
+/* 637 */
+EXTERN char * Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
+ unsigned int numBytes);
+/* 638 */
+EXTERN Tcl_ObjIntRep * Tcl_FetchIntRep(Tcl_Obj *objPtr,
+ const Tcl_ObjType *typePtr);
+/* 639 */
+EXTERN void Tcl_StoreIntRep(Tcl_Obj *objPtr,
+ const Tcl_ObjType *typePtr,
+ const Tcl_ObjIntRep *irPtr);
+/* 640 */
+EXTERN int Tcl_HasStringRep(Tcl_Obj *objPtr);
+/* 641 */
+EXTERN void Tcl_IncrRefCount(Tcl_Obj *objPtr);
+/* 642 */
+EXTERN void Tcl_DecrRefCount(Tcl_Obj *objPtr);
+/* 643 */
+EXTERN int Tcl_IsShared(Tcl_Obj *objPtr);
typedef struct {
const struct TclPlatStubs *tclPlatStubs;
@@ -1828,7 +1908,7 @@ typedef struct TclStubs {
const TclStubHooks *hooks;
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
- CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
+ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
char * (*tcl_Alloc) (unsigned int size); /* 3 */
void (*tcl_Free) (char *ptr); /* 4 */
@@ -1865,21 +1945,21 @@ typedef struct TclStubs {
void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
- Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
- Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
- void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
+ void (*tclOldFreeObj) (Tcl_Obj *objPtr); /* 30 */
int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *boolPtr); /* 31 */
int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *boolPtr); /* 32 */
unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
- int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
@@ -1892,25 +1972,25 @@ typedef struct TclStubs {
int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
- Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
- Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
- Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
- void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
- void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
- void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
- void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
- void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
@@ -1919,17 +1999,17 @@ typedef struct TclStubs {
int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
int (*tcl_AsyncReady) (void); /* 75 */
- void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
- char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
+ TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
int (*tcl_CommandComplete) (const char *cmd); /* 82 */
- char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
+ char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */
int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */
- int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */
+ int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */
int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */
Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
@@ -1938,7 +2018,7 @@ typedef struct TclStubs {
void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
- void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
+ TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
@@ -1970,11 +2050,11 @@ typedef struct TclStubs {
void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
- CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
- CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
+ const char * (*tcl_ErrnoId) (void); /* 127 */
+ const char * (*tcl_ErrnoMsg) (int err); /* 128 */
int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
- int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
@@ -1987,25 +2067,25 @@ typedef struct TclStubs {
int (*tcl_ExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **resultPtrPtr); /* 141 */
int (*tcl_ExprString) (Tcl_Interp *interp, const char *expr); /* 142 */
void (*tcl_Finalize) (void); /* 143 */
- void (*tcl_FindExecutable) (const char *argv0); /* 144 */
+ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_FindExecutable) (const char *argv0); /* 144 */
Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */
int (*tcl_Flush) (Tcl_Channel chan); /* 146 */
void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */
- int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */
- int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
+ int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */
+ int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */
ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */
Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */
int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */
int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */
ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */
int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */
- CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
+ const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */
int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */
CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */
int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */
- CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
+ const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */
int (*tcl_GetErrno) (void); /* 161 */
- CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */
+ const char * (*tcl_GetHostName) (void); /* 162 */
int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */
Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */
const char * (*tcl_GetNameOfExecutable) (void); /* 165 */
@@ -2025,11 +2105,11 @@ typedef struct TclStubs {
int (*tcl_GetServiceMode) (void); /* 171 */
Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
- CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
- CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
- CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
+ const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
+ const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
- int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
@@ -2037,25 +2117,25 @@ typedef struct TclStubs {
int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */
int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */
int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */
- char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */
+ char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */
int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */
void (*reserved188)(void);
Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */
int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */
Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */
- char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */
+ char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */
Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */
void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */
Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */
Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */
- Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */
+ Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */
Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */
Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */
Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */
void (*tcl_Preserve) (ClientData data); /* 201 */
void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */
int (*tcl_PutEnv) (const char *assignment); /* 203 */
- CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
+ const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */
void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */
int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */
void (*tcl_ReapDetachedProcs) (void); /* 207 */
@@ -2066,12 +2146,12 @@ typedef struct TclStubs {
Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */
int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */
int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */
- void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */
+ void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */
void (*tcl_Release) (ClientData clientData); /* 216 */
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
- int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
+ TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
@@ -2081,55 +2161,55 @@ typedef struct TclStubs {
void (*tcl_SetErrno) (int err); /* 227 */
void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */
void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */
- void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
+ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */
int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */
void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */
int (*tcl_SetServiceMode) (int mode); /* 233 */
void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
- CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
- CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
- CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */
- CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
+ const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
+ const char * (*tcl_SignalId) (int sig); /* 239 */
+ const char * (*tcl_SignalMsg) (int sig); /* 240 */
void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
- int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */
- void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
- void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
+ int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
+ void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
+ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
- int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
- int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
+ TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
- int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
- void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
- int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
- ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
- void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
- void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
+ TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
+ TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
- CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
- CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
- CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
- int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
- CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
- void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
- int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
+ const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
+ const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
+ TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
+ TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
- TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
+ TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
@@ -2145,7 +2225,7 @@ typedef struct TclStubs {
int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */
int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
- void (*tcl_ExitThread) (int status); /* 294 */
+ TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */
int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
void (*tcl_FinalizeThread) (void); /* 297 */
@@ -2153,7 +2233,7 @@ typedef struct TclStubs {
void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */
Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */
Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */
- CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
+ const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */
void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */
int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */
void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */
@@ -2171,18 +2251,18 @@ typedef struct TclStubs {
Tcl_Obj * (*tcl_SetVar2Ex) (Tcl_Interp *interp, const char *part1, const char *part2, Tcl_Obj *newValuePtr, int flags); /* 317 */
void (*tcl_ThreadAlert) (Tcl_ThreadId threadId); /* 318 */
void (*tcl_ThreadQueueEvent) (Tcl_ThreadId threadId, Tcl_Event *evPtr, Tcl_QueuePosition position); /* 319 */
- Tcl_UniChar (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
- Tcl_UniChar (*tcl_UniCharToLower) (int ch); /* 321 */
- Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */
- Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */
+ int (*tcl_UniCharAtIndex) (const char *src, int index); /* 320 */
+ int (*tcl_UniCharToLower) (int ch); /* 321 */
+ int (*tcl_UniCharToTitle) (int ch); /* 322 */
+ int (*tcl_UniCharToUpper) (int ch); /* 323 */
int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
- CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
+ const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
- CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
- CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
- CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */
- CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
+ const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
+ const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
+ const char * (*tcl_UtfNext) (const char *src); /* 330 */
+ const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
int (*tcl_UtfToLower) (char *src); /* 334 */
@@ -2192,8 +2272,8 @@ typedef struct TclStubs {
int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
- CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
- void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
+ TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") const char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
+ TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
void (*tcl_ServiceModeHook) (int mode); /* 344 */
int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
@@ -2208,13 +2288,13 @@ typedef struct TclStubs {
char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
- Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
+ TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
- int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
+ int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 360 */
int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
- int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
+ int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */
int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */
int (*tcl_Chdir) (const char *dirName); /* 366 */
@@ -2232,8 +2312,8 @@ typedef struct TclStubs {
Tcl_Obj * (*tcl_NewUnicodeObj) (const Tcl_UniChar *unicode, int numChars); /* 378 */
void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
- Tcl_UniChar (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
- Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
+ int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
+ TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
@@ -2249,7 +2329,7 @@ typedef struct TclStubs {
int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */
Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */
int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */
- CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
+ const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */
Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */
Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */
Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */
@@ -2286,8 +2366,8 @@ typedef struct TclStubs {
int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
- int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
- Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
+ TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
+ TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
@@ -2370,7 +2450,7 @@ typedef struct TclStubs {
Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */
void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */
int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */
- Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */
+ TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */
void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */
void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */
int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */
@@ -2482,6 +2562,19 @@ typedef struct TclStubs {
void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
+ Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
+ int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
+ int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
+ Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
+ int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
+ void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */
+ char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
+ Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
+ void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
+ int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
+ void (*tcl_IncrRefCount) (Tcl_Obj *objPtr); /* 641 */
+ void (*tcl_DecrRefCount) (Tcl_Obj *objPtr); /* 642 */
+ int (*tcl_IsShared) (Tcl_Obj *objPtr); /* 643 */
} TclStubs;
extern const TclStubs *tclStubsPtr;
@@ -2568,8 +2661,8 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_DbNewStringObj) /* 28 */
#define Tcl_DuplicateObj \
(tclStubsPtr->tcl_DuplicateObj) /* 29 */
-#define TclFreeObj \
- (tclStubsPtr->tclFreeObj) /* 30 */
+#define TclOldFreeObj \
+ (tclStubsPtr->tclOldFreeObj) /* 30 */
#define Tcl_GetBoolean \
(tclStubsPtr->tcl_GetBoolean) /* 31 */
#define Tcl_GetBooleanFromObj \
@@ -3774,6 +3867,32 @@ extern const TclStubs *tclStubsPtr;
(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
#define Tcl_ZlibStreamSetCompressionDictionary \
(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
+#define Tcl_OpenTcpServerEx \
+ (tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
+#define TclZipfs_Mount \
+ (tclStubsPtr->tclZipfs_Mount) /* 632 */
+#define TclZipfs_Unmount \
+ (tclStubsPtr->tclZipfs_Unmount) /* 633 */
+#define TclZipfs_TclLibrary \
+ (tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
+#define TclZipfs_MountBuffer \
+ (tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
+#define Tcl_FreeIntRep \
+ (tclStubsPtr->tcl_FreeIntRep) /* 636 */
+#define Tcl_InitStringRep \
+ (tclStubsPtr->tcl_InitStringRep) /* 637 */
+#define Tcl_FetchIntRep \
+ (tclStubsPtr->tcl_FetchIntRep) /* 638 */
+#define Tcl_StoreIntRep \
+ (tclStubsPtr->tcl_StoreIntRep) /* 639 */
+#define Tcl_HasStringRep \
+ (tclStubsPtr->tcl_HasStringRep) /* 640 */
+#define Tcl_IncrRefCount \
+ (tclStubsPtr->tcl_IncrRefCount) /* 641 */
+#define Tcl_DecrRefCount \
+ (tclStubsPtr->tcl_DecrRefCount) /* 642 */
+#define Tcl_IsShared \
+ (tclStubsPtr->tcl_IsShared) /* 643 */
#endif /* defined(USE_TCL_STUBS) */
@@ -3785,15 +3904,12 @@ extern const TclStubs *tclStubsPtr;
# undef Tcl_GetStringResult
# undef Tcl_Init
# undef Tcl_SetPanicProc
-# undef Tcl_SetVar
+# undef Tcl_SetExitProc
# undef Tcl_ObjSetVar2
# undef Tcl_StaticPackage
# define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
# define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
# define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
-# define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
-# define Tcl_SetVar(interp, varName, newValue, flags) \
- (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
# define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
(tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
#endif
@@ -3803,6 +3919,7 @@ extern const TclStubs *tclStubsPtr;
# define Tcl_MainEx Tcl_MainExW
EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
+ EXTERN int TclZipfs_AppHook(int *argc, wchar_t ***argv);
#endif
#undef TCL_STORAGE_CLASS
@@ -3826,13 +3943,13 @@ extern const TclStubs *tclStubsPtr;
sizeof(char *), msg, flags, indexPtr)
#undef Tcl_NewBooleanObj
#define Tcl_NewBooleanObj(boolValue) \
- Tcl_NewIntObj((boolValue)!=0)
+ Tcl_NewWideIntObj((boolValue)!=0)
#undef Tcl_DbNewBooleanObj
#define Tcl_DbNewBooleanObj(boolValue, file, line) \
- Tcl_DbNewLongObj((boolValue)!=0, file, line)
+ Tcl_DbNewWideIntObj((boolValue)!=0, file, line)
#undef Tcl_SetBooleanObj
#define Tcl_SetBooleanObj(objPtr, boolValue) \
- Tcl_SetIntObj((objPtr), (boolValue)!=0)
+ Tcl_SetWideIntObj(objPtr, (boolValue)!=0)
#undef Tcl_SetVar
#define Tcl_SetVar(interp, varName, newValue, flags) \
Tcl_SetVar2(interp, varName, NULL, newValue, flags)
@@ -3854,6 +3971,51 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_UpVar
#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
+#undef Tcl_AddErrorInfo
+#define Tcl_AddErrorInfo(interp, message) \
+ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, -1))
+#undef Tcl_AddObjErrorInfo
+#define Tcl_AddObjErrorInfo(interp, message, length) \
+ Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
+#ifdef TCL_NO_DEPRECATED
+#undef Tcl_Eval
+#define Tcl_Eval(interp, objPtr) \
+ Tcl_EvalEx(interp, objPtr, -1, 0)
+#undef Tcl_GlobalEval
+#define Tcl_GlobalEval(interp, objPtr) \
+ Tcl_EvalEx(interp, objPtr, -1, TCL_EVAL_GLOBAL)
+#undef Tcl_SaveResult
+#define Tcl_SaveResult(interp, statePtr) \
+ do { \
+ (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
+ Tcl_IncrRefCount((statePtr)->objResultPtr); \
+ Tcl_SetObjResult(interp, Tcl_NewObj()); \
+ } while(0)
+#undef Tcl_RestoreResult
+#define Tcl_RestoreResult(interp, statePtr) \
+ do { \
+ Tcl_ResetResult(interp); \
+ Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
+ Tcl_DecrRefCount((statePtr)->objResultPtr); \
+ } while(0)
+#undef Tcl_DiscardResult
+#define Tcl_DiscardResult(statePtr) \
+ Tcl_DecrRefCount((statePtr)->objResultPtr)
+#undef Tcl_SetResult
+#define Tcl_SetResult(interp, result, freeProc) \
+ do { \
+ char *__result = result; \
+ Tcl_FreeProc *__freeProc = freeProc; \
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
+ if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
+ if (__freeProc == TCL_DYNAMIC) { \
+ ckfree(__result); \
+ } else { \
+ (*__freeProc)(__result); \
+ } \
+ } \
+ } while(0)
+#endif /* TCL_NO_DEPRECATED */
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
# if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
@@ -3864,20 +4026,14 @@ extern const TclStubs *tclStubsPtr;
* possible. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
*/
-# undef Tcl_DbNewLongObj
# undef Tcl_GetLongFromObj
-# undef Tcl_NewLongObj
-# undef Tcl_SetLongObj
# undef Tcl_ExprLong
# undef Tcl_ExprLongObj
# undef Tcl_UniCharNcmp
# undef Tcl_UtfNcmp
# undef Tcl_UtfNcasecmp
# undef Tcl_UniCharNcasecmp
-# define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))Tcl_DbNewWideIntObj)
# define Tcl_GetLongFromObj ((int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetWideIntFromObj)
-# define Tcl_NewLongObj ((Tcl_Obj*(*)(long))Tcl_NewWideIntObj)
-# define Tcl_SetLongObj ((void(*)(Tcl_Obj*,long))Tcl_SetWideIntObj)
# define Tcl_ExprLong TclExprLong
static inline int TclExprLong(Tcl_Interp *interp, const char *string, long *ptr){
int intValue;
@@ -3903,15 +4059,30 @@ extern const TclStubs *tclStubsPtr;
# endif
#endif
+#undef Tcl_NewLongObj
+#define Tcl_NewLongObj(value) Tcl_NewWideIntObj((long)(value))
+#undef Tcl_NewIntObj
+#define Tcl_NewIntObj(value) Tcl_NewWideIntObj((int)(value))
+#undef Tcl_DbNewLongObj
+#define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
+#undef Tcl_SetIntObj
+#define Tcl_SetIntObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (int)(value))
+#undef Tcl_SetLongObj
+#define Tcl_SetLongObj(objPtr, value) Tcl_SetWideIntObj((objPtr), (long)(value))
+#undef Tcl_GetUnicode
+#define Tcl_GetUnicode(objPtr) Tcl_GetUnicodeFromObj((objPtr), NULL)
+#undef Tcl_BackgroundError
+#define Tcl_BackgroundError(interp) Tcl_BackgroundException((interp), TCL_ERROR)
+
/*
* Deprecated Tcl procedures:
*/
#undef Tcl_EvalObj
-#define Tcl_EvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),0)
+#define Tcl_EvalObj(interp, objPtr) \
+ Tcl_EvalObjEx(interp, objPtr, 0)
#undef Tcl_GlobalEvalObj
-#define Tcl_GlobalEvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
+#define Tcl_GlobalEvalObj(interp, objPtr) \
+ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
#endif /* _TCLDECLS */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 32234a3..baf96a8 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -12,6 +12,7 @@
#include "tclInt.h"
#include "tommath.h"
+#include <assert.h>
/*
* Forward declaration.
@@ -141,7 +142,7 @@ typedef struct Dict {
* the dictionary. Used for doing traversal of
* the entries in the order that they are
* created. */
- int epoch; /* Epoch counter */
+ unsigned int epoch; /* Epoch counter */
size_t refCount; /* Reference counter (see above) */
Tcl_Obj *chain; /* Linked list used for invalidating the
* string representations of updated nested
@@ -149,13 +150,6 @@ typedef struct Dict {
} Dict;
/*
- * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
- * must be assignable as well as readable.
- */
-
-#define DICT(dictObj) ((dictObj)->internalRep.twoPtrValue.ptr1)
-
-/*
* The structure below defines the dictionary object type by means of
* functions that can be invoked by generic object code.
*/
@@ -168,6 +162,21 @@ const Tcl_ObjType tclDictType = {
SetDictFromAny /* setFromAnyProc */
};
+#define DictSetIntRep(objPtr, dictRepPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (dictRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &tclDictType, &ir); \
+ } while (0)
+
+#define DictGetIntRep(objPtr, dictRepPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &tclDictType); \
+ (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* The type of the specially adapted version of the Tcl_Obj*-containing hash
* table defined in the tclObj.c code. This version differs in that it
@@ -363,10 +372,11 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = DICT(srcPtr);
- Dict *newDict = ckalloc(sizeof(Dict));
+ Dict *oldDict, *newDict = ckalloc(sizeof(Dict));
ChainEntry *cPtr;
+ DictGetIntRep(srcPtr, oldDict);
+
/*
* Copy values across from the old hash table.
*/
@@ -390,7 +400,7 @@ DupDictInternalRep(
* Initialise other fields.
*/
- newDict->epoch = 0;
+ newDict->epoch = 1;
newDict->chain = NULL;
newDict->refCount = 1;
@@ -398,9 +408,7 @@ DupDictInternalRep(
* Store in the object.
*/
- DICT(copyPtr) = newDict;
- copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- copyPtr->typePtr = &tclDictType;
+ DictSetIntRep(copyPtr, newDict);
}
/*
@@ -425,12 +433,13 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = DICT(dictPtr);
+ Dict *dict;
+
+ DictGetIntRep(dictPtr, dict);
if (dict->refCount-- <= 1) {
DeleteDict(dict);
}
- dictPtr->typePtr = NULL;
}
/*
@@ -489,7 +498,7 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
- Dict *dict = DICT(dictPtr);
+ Dict *dict;
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
@@ -501,12 +510,17 @@ UpdateStringOfDict(
* is not exposed by any API function...
*/
- int numElems = dict->table.numEntries * 2;
+ int numElems;
+
+ DictGetIntRep(dictPtr, dict);
+
+ assert (dict != NULL);
+
+ numElems = dict->table.numEntries * 2;
/* Handle empty list case first, simplifies what follows */
if (numElems == 0) {
- dictPtr->bytes = tclEmptyStringRep;
- dictPtr->length = 0;
+ Tcl_InitStringRep(dictPtr, NULL, 0);
return;
}
@@ -550,9 +564,8 @@ UpdateStringOfDict(
* Pass 2: copy into string rep buffer.
*/
- dictPtr->length = bytesNeeded - 1;
- dictPtr->bytes = ckalloc(bytesNeeded);
- dst = dictPtr->bytes;
+ dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
+ TclOOM(dst, bytesNeeded);
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
@@ -566,7 +579,7 @@ UpdateStringOfDict(
dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
*dst++ = ' ';
}
- dictPtr->bytes[dictPtr->length] = '\0';
+ (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
if (flagPtr != localFlags) {
ckfree(flagPtr);
@@ -610,7 +623,7 @@ SetDictFromAny(
* the conversion from lists to dictionaries.
*/
- if (objPtr->typePtr == &tclListType) {
+ if (TclHasIntRep(objPtr, &tclListType)) {
int objc, i;
Tcl_Obj **objv;
@@ -665,10 +678,14 @@ SetDictFromAny(
TclNewStringObj(keyPtr, elemStart, elemSize);
} else {
/* Avoid double copy */
+ char *dst;
+
TclNewObj(keyPtr);
- keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
- keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
- keyPtr->bytes);
+ Tcl_InvalidateStringRep(keyPtr);
+ dst = Tcl_InitStringRep(keyPtr, NULL, elemSize);
+ TclOOM(dst, elemSize); /* Consider error */
+ (void)Tcl_InitStringRep(keyPtr, NULL,
+ TclCopyAndCollapse(elemSize, elemStart, dst));
}
if (TclFindDictElement(interp, nextElem, (limit - nextElem),
@@ -681,10 +698,14 @@ SetDictFromAny(
TclNewStringObj(valuePtr, elemStart, elemSize);
} else {
/* Avoid double copy */
+ char *dst;
+
TclNewObj(valuePtr);
- valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
- valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
- valuePtr->bytes);
+ Tcl_InvalidateStringRep(valuePtr);
+ dst = Tcl_InitStringRep(valuePtr, NULL, elemSize);
+ TclOOM(dst, elemSize); /* Consider error */
+ (void)Tcl_InitStringRep(valuePtr, NULL,
+ TclCopyAndCollapse(elemSize, elemStart, dst));
}
/* Store key and value in the hash table we're building. */
@@ -706,13 +727,10 @@ SetDictFromAny(
* Tcl_GetStringFromObj, to use that old internalRep.
*/
- TclFreeIntRep(objPtr);
- dict->epoch = 0;
+ dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
- DICT(objPtr) = dict;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclDictType;
+ DictSetIntRep(objPtr, dict);
return TCL_OK;
missingValue:
@@ -726,6 +744,23 @@ SetDictFromAny(
ckfree(dict);
return TCL_ERROR;
}
+
+static Dict *
+GetDictFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *dictPtr)
+{
+ Dict *dict;
+
+ DictGetIntRep(dictPtr, dict);
+ if (dict == NULL) {
+ if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
+ }
+ DictGetIntRep(dictPtr, dict);
+ }
+ return dict;
+}
/*
*----------------------------------------------------------------------
@@ -770,11 +805,13 @@ TclTraceDictPath(
Dict *dict, *newDict;
int i;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
- return NULL;
+ DictGetIntRep(dictPtr, dict);
+ if (dict == NULL) {
+ if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ return NULL;
+ }
+ DictGetIntRep(dictPtr, dict);
}
- dict = DICT(dictPtr);
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -810,13 +847,17 @@ TclTraceDictPath(
Tcl_SetHashValue(hPtr, tmpObj);
} else {
tmpObj = Tcl_GetHashValue(hPtr);
- if (tmpObj->typePtr != &tclDictType
- && SetDictFromAny(interp, tmpObj) != TCL_OK) {
- return NULL;
+
+ DictGetIntRep(tmpObj, newDict);
+
+ if (newDict == NULL) {
+ if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
+ return NULL;
+ }
}
}
- newDict = DICT(tmpObj);
+ DictGetIntRep(tmpObj, newDict);
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -824,7 +865,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, tmpObj);
dict->epoch++;
- newDict = DICT(tmpObj);
+ DictGetIntRep(tmpObj, newDict);
}
newDict->chain = dictPtr;
@@ -859,17 +900,24 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = DICT(dictObj);
+ Dict *dict;
+
+ DictGetIntRep(dictObj, dict);
+ assert( dict != NULL);
do {
+ dict->refCount++;
TclInvalidateStringRep(dictObj);
+ TclFreeIntRep(dictObj);
+ DictSetIntRep(dictObj, dict);
+
dict->epoch++;
dictObj = dict->chain;
if (dictObj == NULL) {
break;
}
dict->chain = NULL;
- dict = DICT(dictObj);
+ DictGetIntRep(dictObj, dict);
} while (dict != NULL);
}
@@ -907,16 +955,16 @@ Tcl_DictObjPut(
Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
}
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
- dict = DICT(dictPtr);
+ TclInvalidateStringRep(dictPtr);
hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+ dict->refCount++;
+ TclFreeIntRep(dictPtr)
+ DictSetIntRep(dictPtr, dict);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
@@ -958,13 +1006,12 @@ Tcl_DictObjGet(
Dict *dict;
Tcl_HashEntry *hPtr;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
*valuePtrPtr = NULL;
return TCL_ERROR;
}
- dict = DICT(dictPtr);
hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
@@ -1005,16 +1052,13 @@ Tcl_DictObjRemove(
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
}
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
if (DeleteChainEntry(dict, keyPtr)) {
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
+ TclInvalidateStringRep(dictPtr);
dict->epoch++;
}
return TCL_OK;
@@ -1046,12 +1090,11 @@ Tcl_DictObjSize(
{
Dict *dict;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -1098,15 +1141,14 @@ Tcl_DictObjFirst(
Dict *dict;
ChainEntry *cPtr;
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, dictPtr);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
cPtr = dict->entryChainHead;
if (cPtr == NULL) {
- searchPtr->epoch = -1;
+ searchPtr->epoch = 0;
*donePtr = 1;
} else {
*donePtr = 0;
@@ -1167,7 +1209,7 @@ Tcl_DictObjNext(
* If the searh is done; we do no work.
*/
- if (searchPtr->epoch == -1) {
+ if (!searchPtr->epoch) {
*donePtr = 1;
return;
}
@@ -1224,8 +1266,8 @@ Tcl_DictObjDone(
{
Dict *dict;
- if (searchPtr->epoch != -1) {
- searchPtr->epoch = -1;
+ if (searchPtr->epoch) {
+ searchPtr->epoch = 0;
dict = (Dict *) searchPtr->dictionaryPtr;
if (dict->refCount-- <= 1) {
DeleteDict(dict);
@@ -1277,7 +1319,8 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = DICT(dictPtr);
+ DictGetIntRep(dictPtr, dict);
+ assert(dict != NULL);
hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
@@ -1334,7 +1377,8 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = DICT(dictPtr);
+ DictGetIntRep(dictPtr, dict);
+ assert(dict != NULL);
DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
@@ -1377,12 +1421,10 @@ Tcl_NewDictObj(void)
TclInvalidateStringRep(dictPtr);
dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
- dict->epoch = 0;
+ dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
- DICT(dictPtr) = dict;
- dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
- dictPtr->typePtr = &tclDictType;
+ DictSetIntRep(dictPtr, dict);
return dictPtr;
#endif
}
@@ -1427,12 +1469,10 @@ Tcl_DbNewDictObj(
TclInvalidateStringRep(dictPtr);
dict = ckalloc(sizeof(Dict));
InitChainTable(dict);
- dict->epoch = 0;
+ dict->epoch = 1;
dict->chain = NULL;
dict->refCount = 1;
- DICT(dictPtr) = dict;
- dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
- dictPtr->typePtr = &tclDictType;
+ DictSetIntRep(dictPtr, dict);
return dictPtr;
#else /* !TCL_MEM_DEBUG */
return Tcl_NewDictObj();
@@ -1618,16 +1658,13 @@ DictReplaceCmd(
}
dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ if (GetDictFromObj(interp, dictPtr) == NULL) {
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
+ TclInvalidateStringRep(dictPtr);
for (i=2 ; i<objc ; i+=2) {
Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
}
@@ -1669,16 +1706,13 @@ DictRemoveCmd(
}
dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ if (GetDictFromObj(interp, dictPtr) == NULL) {
return TCL_ERROR;
}
if (Tcl_IsShared(dictPtr)) {
dictPtr = Tcl_DuplicateObj(dictPtr);
}
- if (dictPtr->bytes != NULL) {
- TclInvalidateStringRep(dictPtr);
- }
+ TclInvalidateStringRep(dictPtr);
for (i=2 ; i<objc ; i++) {
Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
}
@@ -1729,8 +1763,7 @@ DictMergeCmd(
*/
targetObj = objv[1];
- if (targetObj->typePtr != &tclDictType
- && SetDictFromAny(interp, targetObj) != TCL_OK) {
+ if (GetDictFromObj(interp, targetObj) == NULL) {
return TCL_ERROR;
}
@@ -1813,8 +1846,7 @@ DictKeysCmd(
* need. [Bug 1705778, leak K04]
*/
- if (objv[1]->typePtr != &tclDictType
- && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+ if (GetDictFromObj(interp, objv[1]) == NULL) {
return TCL_ERROR;
}
@@ -2021,7 +2053,6 @@ DictInfoCmd(
int objc,
Tcl_Obj *const *objv)
{
- Tcl_Obj *dictPtr;
Dict *dict;
char *statsStr;
@@ -2030,12 +2061,10 @@ DictInfoCmd(
return TCL_ERROR;
}
- dictPtr = objv[1];
- if (dictPtr->typePtr != &tclDictType
- && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+ dict = GetDictFromObj(interp, objv[1]);
+ if (dict == NULL) {
return TCL_ERROR;
}
- dict = DICT(dictPtr);
statsStr = Tcl_HashStats(&dict->table);
Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2096,12 +2125,11 @@ DictIncrCmd(
* soon be no good.
*/
- char *saved = dictPtr->bytes;
Tcl_Obj *oldPtr = dictPtr;
- dictPtr->bytes = NULL;
- dictPtr = Tcl_DuplicateObj(dictPtr);
- oldPtr->bytes = saved;
+ TclNewObj(dictPtr);
+ TclInvalidateStringRep(dictPtr);
+ DupDictInternalRep(oldPtr, dictPtr);
}
if (valuePtr == NULL) {
/*
@@ -2238,7 +2266,7 @@ DictLappendCmd(
if (allocatedValue) {
Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
- } else if (dictPtr->bytes != NULL) {
+ } else {
TclInvalidateStringRep(dictPtr);
}
@@ -2277,7 +2305,7 @@ DictAppendCmd(
Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
- int i, allocatedDict = 0;
+ int allocatedDict = 0;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "dictVarName key ?value ...?");
@@ -2300,17 +2328,49 @@ DictAppendCmd(
return TCL_ERROR;
}
- if (valuePtr == NULL) {
- TclNewObj(valuePtr);
- } else if (Tcl_IsShared(valuePtr)) {
- valuePtr = Tcl_DuplicateObj(valuePtr);
- }
+ if ((objc > 3) || (valuePtr == NULL)) {
+ /* Only go through append activites when something will change. */
+ Tcl_Obj *appendObjPtr = NULL;
+
+ if (objc > 3) {
+ /* Something to append */
- for (i=3 ; i<objc ; i++) {
- Tcl_AppendObjToObj(valuePtr, objv[i]);
+ if (objc == 4) {
+ appendObjPtr = objv[3];
+ } else {
+ appendObjPtr = TclStringCat(interp, objc-3, objv+3,
+ TCL_STRING_IN_PLACE);
+ if (appendObjPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ if (appendObjPtr == NULL) {
+ /* => (objc == 3) => (valuePtr == NULL) */
+ TclNewObj(valuePtr);
+ } else if (valuePtr == NULL) {
+ valuePtr = appendObjPtr;
+ appendObjPtr = NULL;
+ }
+
+ if (appendObjPtr) {
+ if (Tcl_IsShared(valuePtr)) {
+ valuePtr = Tcl_DuplicateObj(valuePtr);
+ }
+
+ Tcl_IncrRefCount(appendObjPtr);
+ Tcl_AppendObjToObj(valuePtr, appendObjPtr);
+ Tcl_DecrRefCount(appendObjPtr);
+ }
+
+ Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
}
- Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
+ /*
+ * Even if nothing changed, we still overwrite so that variable
+ * trace expectations are met.
+ */
resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr,
TCL_LEAVE_ERR_MSG);
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index f62c260..e5fce72 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -38,7 +38,7 @@ static void UpdateStringOfInstName(Tcl_Obj *objPtr);
* reporting of inner contexts in errorstack without string allocation.
*/
-static const Tcl_ObjType tclInstNameType = {
+static const Tcl_ObjType instNameType = {
"instname", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
@@ -46,12 +46,21 @@ static const Tcl_ObjType tclInstNameType = {
NULL, /* setFromAnyProc */
};
-/*
- * How to get the bytecode out of a Tcl_Obj.
- */
+#define InstNameSetIntRep(objPtr, inst) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.wideValue = (inst); \
+ Tcl_StoreIntRep((objPtr), &instNameType, &ir); \
+ } while (0)
+
+#define InstNameGetIntRep(objPtr, inst) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &instNameType); \
+ assert(irPtr != NULL); \
+ (inst) = (size_t)irPtr->wideValue; \
+ } while (0)
-#define BYTECODE(objPtr) \
- ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
/*
*----------------------------------------------------------------------
@@ -191,7 +200,7 @@ TclPrintObject(
char *bytes;
int length;
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
TclPrintSource(outFile, bytes, TclMin(length, maxChars));
}
@@ -245,17 +254,20 @@ DisassembleByteCodeObj(
Tcl_Interp *interp,
Tcl_Obj *objPtr) /* The bytecode object to disassemble. */
{
- ByteCode *codePtr = BYTECODE(objPtr);
+ ByteCode *codePtr;
unsigned char *codeStart, *codeLimit, *pc;
unsigned char *codeDeltaNext, *codeLengthNext;
unsigned char *srcDeltaNext, *srcLengthNext;
int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
- Interp *iPtr = (Interp *) *codePtr->interpHandle;
+ Interp *iPtr;
Tcl_Obj *bufferObj, *fileObj;
- char ptrBuf1[20], ptrBuf2[20];
+
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+
+ iPtr = (Interp *) *codePtr->interpHandle;
TclNewObj(bufferObj);
- if (codePtr->refCount <= 0) {
+ if (!codePtr->refCount) {
return bufferObj; /* Already freed. */
}
@@ -267,11 +279,9 @@ DisassembleByteCodeObj(
* Print header lines describing the ByteCode.
*/
- sprintf(ptrBuf1, "%p", codePtr);
- sprintf(ptrBuf2, "%p", iPtr);
Tcl_AppendPrintfToObj(bufferObj,
- "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
- ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
+ "ByteCode %p, refCt %u, epoch %u, interp %p (epoch %u)\n",
+ codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
Tcl_AppendToObj(bufferObj, " Source ", -1);
PrintSourceToObj(bufferObj, codePtr->source,
@@ -314,10 +324,9 @@ DisassembleByteCodeObj(
Proc *procPtr = codePtr->procPtr;
int numCompiledLocals = procPtr->numCompiledLocals;
- sprintf(ptrBuf1, "%p", procPtr);
Tcl_AppendPrintfToObj(bufferObj,
- " Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
- ptrBuf1, procPtr->refCount, procPtr->numArgs,
+ " Proc %p, refCt %u, args %d, compiled locals %d\n",
+ procPtr, procPtr->refCount, procPtr->numArgs,
numCompiledLocals);
if (numCompiledLocals > 0) {
CompiledLocal *localPtr = procPtr->firstLocalPtr;
@@ -648,7 +657,7 @@ FormatInstruction(
int length;
Tcl_AppendToObj(bufferObj, "\t# ", -1);
- bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+ bytes = TclGetStringFromObj(codePtr->objArrayPtr[opnd], &length);
PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
} else if (suffixBuffer[0]) {
Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
@@ -800,9 +809,8 @@ TclNewInstNameObj(
{
Tcl_Obj *objPtr = Tcl_NewObj();
- objPtr->typePtr = &tclInstNameType;
- objPtr->internalRep.longValue = (long) inst;
- objPtr->bytes = NULL;
+ TclInvalidateStringRep(objPtr);
+ InstNameSetIntRep(objPtr, (long) inst);
return objPtr;
}
@@ -821,20 +829,22 @@ static void
UpdateStringOfInstName(
Tcl_Obj *objPtr)
{
- int inst = objPtr->internalRep.longValue;
- char *s, buf[20];
- int len;
+ size_t inst; /* NOTE: We know this is really an unsigned char */
+ char *dst;
- if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
- sprintf(buf, "inst_%d", inst);
- s = buf;
+ InstNameGetIntRep(objPtr, inst);
+
+ if (inst > LAST_INST_OPCODE) {
+ dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
+ TclOOM(dst, TCL_INTEGER_SPACE + 5);
+ sprintf(dst, "inst_%" TCL_Z_MODIFIER "d", inst);
+ (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
} else {
- s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
+ const char *s = tclInstructionTable[inst].name;
+ unsigned int len = strlen(s);
+ dst = Tcl_InitStringRep(objPtr, s, len);
+ TclOOM(dst, len);
}
- len = strlen(s);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, s, len + 1);
- objPtr->length = len;
}
/*
@@ -898,7 +908,7 @@ PrintSourceToObj(
Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
i += 10;
} else
-#elif TCL_UTF_MAX > 3
+#else
/* If len == 0, this means we have a char > 0xffff, resulting in
* TclUtfToUniChar producing a surrogate pair. We want to output
* this pair as a single Unicode character.
@@ -946,13 +956,15 @@ DisassembleByteCodeAsDicts(
* procedure, if one exists. */
Tcl_Obj *objPtr) /* The bytecode-holding value to take apart */
{
- ByteCode *codePtr = BYTECODE(objPtr);
+ ByteCode *codePtr;
Tcl_Obj *description, *literals, *variables, *instructions, *inst;
Tcl_Obj *aux, *exn, *commands, *file;
unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
int codeOffset, codeLength, sourceOffset, sourceLength;
int i, val, line;
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+
/*
* Get the literals from the bytecode.
*/
@@ -1290,6 +1302,7 @@ Tcl_DisassembleObjCmd(
Proc *procPtr = NULL;
Tcl_HashEntry *hPtr;
Object *oPtr;
+ ByteCode *codePtr;
Method *methodPtr;
if (objc < 2) {
@@ -1308,27 +1321,19 @@ Tcl_DisassembleObjCmd(
/*
* Compile (if uncompiled) and disassemble a lambda term.
- *
- * WARNING! Pokes inside the lambda objtype.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
return TCL_ERROR;
}
- if (objv[2]->typePtr == &tclLambdaType) {
- procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
- }
- if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
- result = tclLambdaType.setFromAnyProc(interp, objv[2]);
- if (result != TCL_OK) {
- return result;
- }
- procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+
+ procPtr = TclGetLambdaFromObj(interp, objv[2], &nsObjPtr);
+ if (procPtr == NULL) {
+ return TCL_ERROR;
}
memset(&cmd, 0, sizeof(Command));
- nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return result;
@@ -1378,8 +1383,9 @@ Tcl_DisassembleObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, "script");
return TCL_ERROR;
}
- if ((objv[2]->typePtr != &tclByteCodeType)
- && (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+
+ if (!TclHasIntRep(objv[2], &tclByteCodeType) && (TCL_OK
+ != TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
return TCL_ERROR;
}
codeObjPtr = objv[2];
@@ -1429,7 +1435,7 @@ Tcl_DisassembleObjCmd(
* Compile if necessary.
*/
- if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
@@ -1494,7 +1500,7 @@ Tcl_DisassembleObjCmd(
* Compile if necessary.
*/
- if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
@@ -1579,7 +1585,7 @@ Tcl_DisassembleObjCmd(
"METHODTYPE", NULL);
return TCL_ERROR;
}
- if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ if (!TclHasIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
Command cmd;
/*
@@ -1607,14 +1613,16 @@ Tcl_DisassembleObjCmd(
* Do the actual disassembly.
*/
- if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) {
+ ByteCodeGetIntRep(codeObjPtr, &tclByteCodeType, codePtr);
+
+ if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not disassemble prebuilt bytecode", -1));
Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
"BYTECODE", NULL);
return TCL_ERROR;
}
- if (PTR2INT(clientData)) {
+ if (clientData) {
Tcl_SetObjResult(interp,
DisassembleByteCodeAsDicts(interp, codeObjPtr));
} else {
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 51909c2..e601c3a 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -18,7 +18,7 @@ typedef size_t (LengthProc)(const char *src);
* convert between various character sets and UTF-8.
*/
-typedef struct Encoding {
+typedef struct {
char *name; /* Name of encoding. Malloced because (1) hash
* table entry that owns this encoding may be
* freed prior to this encoding being freed,
@@ -46,7 +46,7 @@ typedef struct Encoding {
* nullSize is 2, this is a function that
* returns the number of bytes in a 0x0000
* terminated string. */
- int refCount; /* Number of uses of this structure. */
+ size_t refCount; /* Number of uses of this structure. */
Tcl_HashEntry *hPtr; /* Hash table entry that owns this encoding. */
} Encoding;
@@ -57,7 +57,7 @@ typedef struct Encoding {
* encoding.
*/
-typedef struct TableEncodingData {
+typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
@@ -91,7 +91,7 @@ typedef struct TableEncodingData {
* for switching character sets.
*/
-typedef struct EscapeSubTable {
+typedef struct {
unsigned sequenceLen; /* Length of following string. */
char sequence[16]; /* Escape code that marks this encoding. */
char name[32]; /* Name for encoding. */
@@ -100,7 +100,7 @@ typedef struct EscapeSubTable {
* yet. */
} EscapeSubTable;
-typedef struct EscapeEncodingData {
+typedef struct {
int fallback; /* Character (in this encoding) to substitute
* when this encoding cannot represent a UTF-8
* character. */
@@ -279,6 +279,21 @@ static int Iso88591ToUtfProc(ClientData clientData,
static const Tcl_ObjType encodingType = {
"encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
};
+#define EncodingSetIntRep(objPtr, encoding) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (encoding); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &encodingType, &ir); \
+ } while (0)
+
+#define EncodingGetIntRep(objPtr, encoding) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep ((objPtr), &encodingType); \
+ (encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
*----------------------------------------------------------------------
@@ -305,17 +320,16 @@ Tcl_GetEncodingFromObj(
Tcl_Obj *objPtr,
Tcl_Encoding *encodingPtr)
{
- const char *name = Tcl_GetString(objPtr);
-
- if (objPtr->typePtr != &encodingType) {
- Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
+ Tcl_Encoding encoding;
+ const char *name = TclGetString(objPtr);
+ EncodingGetIntRep(objPtr, encoding);
+ if (encoding == NULL) {
+ encoding = Tcl_GetEncoding(interp, name);
if (encoding == NULL) {
return TCL_ERROR;
}
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = encoding;
- objPtr->typePtr = &encodingType;
+ EncodingSetIntRep(objPtr, encoding);
}
*encodingPtr = Tcl_GetEncoding(NULL, name);
return TCL_OK;
@@ -335,8 +349,10 @@ static void
FreeEncodingIntRep(
Tcl_Obj *objPtr)
{
- Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
- objPtr->typePtr = NULL;
+ Tcl_Encoding encoding;
+
+ EncodingGetIntRep(objPtr, encoding);
+ Tcl_FreeEncoding(encoding);
}
/*
@@ -354,7 +370,8 @@ DupEncodingIntRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
+ Tcl_Encoding encoding = Tcl_GetEncoding(NULL, TclGetString(srcPtr));
+ EncodingSetIntRep(dupPtr, encoding);
}
/*
@@ -562,7 +579,7 @@ TclInitEncodingSubsystem(void)
* formed UTF-8 into a properly formed stream.
*/
- type.encodingName = "identity";
+ type.encodingName = NULL;
type.toUtfProc = BinaryProc;
type.fromUtfProc = BinaryProc;
type.freeProc = NULL;
@@ -692,6 +709,7 @@ TclFinalizeEncodingSubsystem(void)
*-------------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
const char *
Tcl_GetDefaultEncodingDir(void)
{
@@ -704,7 +722,7 @@ Tcl_GetDefaultEncodingDir(void)
}
Tcl_ListObjIndex(NULL, searchPath, 0, &first);
- return Tcl_GetString(first);
+ return TclGetString(first);
}
/*
@@ -735,6 +753,7 @@ Tcl_SetDefaultEncodingDir(
Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory);
Tcl_SetEncodingSearchPath(searchPath);
}
+#endif
/*
*-------------------------------------------------------------------------
@@ -843,18 +862,16 @@ FreeEncoding(
if (encodingPtr == NULL) {
return;
}
- if (encodingPtr->refCount<=0) {
- Tcl_Panic("FreeEncoding: refcount problem !!!");
- }
- encodingPtr->refCount--;
- if (encodingPtr->refCount == 0) {
+ if (encodingPtr->refCount-- <= 1) {
if (encodingPtr->freeProc != NULL) {
encodingPtr->freeProc(encodingPtr->clientData);
}
if (encodingPtr->hPtr != NULL) {
Tcl_DeleteHashEntry(encodingPtr->hPtr);
}
- ckfree(encodingPtr->name);
+ if (encodingPtr->name) {
+ ckfree(encodingPtr->name);
+ }
ckfree(encodingPtr);
}
}
@@ -1043,9 +1060,24 @@ Tcl_CreateEncoding(
const Tcl_EncodingType *typePtr)
/* The encoding type. */
{
+ Encoding *encodingPtr = ckalloc(sizeof(Encoding));
+ encodingPtr->name = NULL;
+ encodingPtr->toUtfProc = typePtr->toUtfProc;
+ encodingPtr->fromUtfProc = typePtr->fromUtfProc;
+ encodingPtr->freeProc = typePtr->freeProc;
+ encodingPtr->nullSize = typePtr->nullSize;
+ encodingPtr->clientData = typePtr->clientData;
+ if (typePtr->nullSize == 1) {
+ encodingPtr->lengthProc = (LengthProc *) strlen;
+ } else {
+ encodingPtr->lengthProc = (LengthProc *) unilen;
+ }
+ encodingPtr->refCount = 1;
+ encodingPtr->hPtr = NULL;
+
+ if (typePtr->encodingName) {
Tcl_HashEntry *hPtr;
int isNew;
- Encoding *encodingPtr;
char *name;
Tcl_MutexLock(&encodingMutex);
@@ -1056,30 +1088,17 @@ Tcl_CreateEncoding(
* reference goes away.
*/
- encodingPtr = Tcl_GetHashValue(hPtr);
- encodingPtr->hPtr = NULL;
+ Encoding *replaceMe = Tcl_GetHashValue(hPtr);
+ replaceMe->hPtr = NULL;
}
name = ckalloc(strlen(typePtr->encodingName) + 1);
-
- encodingPtr = ckalloc(sizeof(Encoding));
encodingPtr->name = strcpy(name, typePtr->encodingName);
- encodingPtr->toUtfProc = typePtr->toUtfProc;
- encodingPtr->fromUtfProc = typePtr->fromUtfProc;
- encodingPtr->freeProc = typePtr->freeProc;
- encodingPtr->nullSize = typePtr->nullSize;
- encodingPtr->clientData = typePtr->clientData;
- if (typePtr->nullSize == 1) {
- encodingPtr->lengthProc = (LengthProc *) strlen;
- } else {
- encodingPtr->lengthProc = (LengthProc *) unilen;
- }
- encodingPtr->refCount = 1;
encodingPtr->hPtr = hPtr;
Tcl_SetHashValue(hPtr, encodingPtr);
Tcl_MutexUnlock(&encodingMutex);
-
+ }
return (Tcl_Encoding) encodingPtr;
}
@@ -1518,10 +1537,10 @@ OpenEncodingFileChannel(
}
}
if (!verified) {
- const char *dirString = Tcl_GetString(directory);
+ const char *dirString = TclGetString(directory);
for (i=0; i<numDirs && !verified; i++) {
- if (strcmp(dirString, Tcl_GetString(dir[i])) == 0) {
+ if (strcmp(dirString, TclGetString(dir[i])) == 0) {
verified = 1;
}
}
@@ -1720,7 +1739,7 @@ LoadTableEncoding(
};
Tcl_DStringInit(&lineString);
- if (Tcl_Gets(chan, &lineString) < 0) {
+ if (Tcl_Gets(chan, &lineString) == TCL_IO_FAILURE) {
return NULL;
}
line = Tcl_DStringValue(&lineString);
@@ -1767,7 +1786,7 @@ LoadTableEncoding(
if (Tcl_ReadChars(chan, objPtr, expected, 0) != expected) {
return NULL;
}
- p = Tcl_GetString(objPtr);
+ p = TclGetString(objPtr);
hi = (staticHex[UCHAR(p[0])] << 4) + staticHex[UCHAR(p[1])];
dataPtr->toUnicode[hi] = pageMemPtr;
p += 2;
@@ -2060,7 +2079,7 @@ LoadEscapeEncoding(
dataPtr->numSubTables =
Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
- (size_t) Tcl_DStringLength(&escapeData));
+ Tcl_DStringLength(&escapeData));
Tcl_DStringFree(&escapeData);
memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));
@@ -2364,7 +2383,7 @@ UtfToUtfProc(
int len = TclUtfToUniChar(src, chPtr);
src += len;
dst += Tcl_UniCharToUtf(*chPtr, dst);
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!len) {
src += TclUtfToUniChar(src, chPtr);
dst += Tcl_UniCharToUtf(*chPtr, dst);
@@ -2784,7 +2803,7 @@ TableFromUtfProc(
if (ch & 0xffff0000) {
word = 0;
} else
-#elif TCL_UTF_MAX == 4
+#else
if (!len) {
word = 0;
} else
@@ -2986,7 +3005,7 @@ Iso88591FromUtfProc(
*/
if (ch > 0xff
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
|| !len
#endif
) {
@@ -2994,10 +3013,9 @@ Iso88591FromUtfProc(
result = TCL_CONVERT_UNKNOWN;
break;
}
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!len) len = 4;
#endif
-
/*
* Plunge on, using '?' as a fallback character.
*/
@@ -3631,11 +3649,11 @@ unilen(
static void
InitializeEncodingSearchPath(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *bytes;
- int i, numDirs, numBytes;
+ int i, numDirs;
Tcl_Obj *libPathObj, *encodingObj, *searchPathObj;
TclNewLiteralStringObj(encodingObj, "encoding");
@@ -3665,11 +3683,11 @@ InitializeEncodingSearchPath(
if (*encodingPtr) {
((Encoding *)(*encodingPtr))->refCount++;
}
- bytes = Tcl_GetStringFromObj(searchPathObj, &numBytes);
+ bytes = TclGetString(searchPathObj);
- *lengthPtr = numBytes;
- *valuePtr = ckalloc(numBytes + 1);
- memcpy(*valuePtr, bytes, (size_t) numBytes + 1);
+ *lengthPtr = searchPathObj->length;
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, bytes, *lengthPtr + 1);
Tcl_DecrRefCount(searchPathObj);
}
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index dfffe12..73e3ce7 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -21,8 +21,6 @@ static inline Tcl_Obj * NewNsObj(Tcl_Namespace *namespacePtr);
static inline int EnsembleUnknownCallback(Tcl_Interp *interp,
EnsembleConfig *ensemblePtr, int objc,
Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
-static int NsEnsembleImplementationCmd(ClientData clientData,
- Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NsEnsembleImplementationCmdNR(ClientData clientData,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static void BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
@@ -86,22 +84,36 @@ static const Tcl_ObjType ensembleCmdType = {
NULL /* setFromAnyProc */
};
+#define ECRSetIntRep(objPtr, ecRepPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (ecRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir); \
+ } while (0)
+
+#define ECRGetIntRep(objPtr, ecRepPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &ensembleCmdType); \
+ (ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
- * The internal rep for caching ensemble subcommand lookups and
- * spell corrections.
+ * The internal rep for caching ensemble subcommand lookups and spelling
+ * corrections.
*/
typedef struct {
- int epoch; /* Used to confirm when the data in this
+ unsigned int epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
Command *token; /* Reference to the command for which this
* structure is a cache of the resolution. */
Tcl_Obj *fix; /* Corrected spelling, if needed. */
- Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand
- * hash table. */
+ Tcl_HashEntry *hPtr; /* Direct link to entry in the subcommand hash
+ * table. */
} EnsembleCmdRep;
-
static inline Tcl_Obj *
NewNsObj(
@@ -111,9 +123,8 @@ NewNsObj(
if (namespacePtr == TclGetGlobalNamespace(nsPtr->interp)) {
return Tcl_NewStringObj("::", 2);
- } else {
- return Tcl_NewStringObj(nsPtr->fullName, -1);
}
+ return Tcl_NewStringObj(nsPtr->fullName, -1);
}
/*
@@ -147,7 +158,7 @@ TclNamespaceEnsembleCmd(
{
Tcl_Namespace *namespacePtr;
Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp), *cxtPtr,
- *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
+ *foundNsPtr, *altFoundNsPtr, *actualCxtPtr;
Tcl_Command token;
Tcl_DictSearch search;
Tcl_Obj *listObj;
@@ -302,7 +313,8 @@ TclNamespaceEnsembleCmd(
Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
newList);
}
- Tcl_DictObjNext(&search, &subcmdWordsObj,&listObj, &done);
+ Tcl_DictObjNext(&search, &subcmdWordsObj, &listObj,
+ &done);
} while (!done);
if (allocatedMapFlag) {
@@ -336,8 +348,8 @@ TclNamespaceEnsembleCmd(
}
TclGetNamespaceForQualName(interp, name, cxtPtr,
- TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr, &actualCxtPtr,
- &simpleName);
+ TCL_CREATE_NS_IF_UNKNOWN, &foundNsPtr, &altFoundNsPtr,
+ &actualCxtPtr, &simpleName);
/*
* Create the ensemble. Note that this might delete another ensemble
@@ -347,8 +359,8 @@ TclNamespaceEnsembleCmd(
*/
token = TclCreateEnsembleInNs(interp, simpleName,
- (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
- (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
+ (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr,
+ (permitPrefix ? TCL_ENSEMBLE_PREFIX : 0));
Tcl_SetEnsembleSubcommandList(interp, token, subcmdObj);
Tcl_SetEnsembleMappingDict(interp, token, mapObj);
Tcl_SetEnsembleUnknownHandler(interp, token, unknownObj);
@@ -576,7 +588,8 @@ TclNamespaceEnsembleCmd(
Tcl_AppendStringsToObj(newCmd, "::", NULL);
}
Tcl_AppendObjToObj(newCmd, listv[0]);
- Tcl_ListObjReplace(NULL, newList, 0,1, 1,&newCmd);
+ Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
+ &newCmd);
if (patchedDict == NULL) {
patchedDict = Tcl_DuplicateObj(objv[1]);
}
@@ -649,16 +662,14 @@ TclNamespaceEnsembleCmd(
Tcl_Command
TclCreateEnsembleInNs(
- Tcl_Interp *interp,
-
- const char *name, /* Simple name of command to create (no */
- /* namespace components). */
- Tcl_Namespace /* Name of namespace to create the command in. */
- *nameNsPtr,
- Tcl_Namespace
- *ensembleNsPtr, /* Name of the namespace for the ensemble. */
- int flags
- )
+ Tcl_Interp *interp,
+ const char *name, /* Simple name of command to create (no
+ * namespace components). */
+ Tcl_Namespace *nameNsPtr, /* Name of namespace to create the command
+ * in. */
+ Tcl_Namespace *ensembleNsPtr,
+ /* Name of the namespace for the ensemble. */
+ int flags)
{
Namespace *nsPtr = (Namespace *) ensembleNsPtr;
EnsembleConfig *ensemblePtr;
@@ -666,8 +677,8 @@ TclCreateEnsembleInNs(
ensemblePtr = ckalloc(sizeof(EnsembleConfig));
token = TclNRCreateCommandInNs(interp, name,
- (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
- NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
+ (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
+ NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
if (token == NULL) {
ckfree(ensemblePtr);
return NULL;
@@ -701,18 +712,15 @@ TclCreateEnsembleInNs(
}
return ensemblePtr->token;
-
}
-
-
+
/*
*----------------------------------------------------------------------
*
* Tcl_CreateEnsemble
*
- * Create a simple ensemble attached to the given namespace.
- *
- * Deprecated by TclCreateEnsembleInNs.
+ * Create a simple ensemble attached to the given namespace. Deprecated
+ * (internally) by TclCreateEnsembleInNs.
*
* Value
*
@@ -732,8 +740,8 @@ Tcl_CreateEnsemble(
Tcl_Namespace *namespacePtr,
int flags)
{
- Namespace *nsPtr = (Namespace *)namespacePtr, *foundNsPtr, *altNsPtr,
- *actualNsPtr;
+ Namespace *nsPtr = (Namespace *) namespacePtr, *foundNsPtr, *altNsPtr,
+ *actualNsPtr;
const char * simpleName;
if (nsPtr == NULL) {
@@ -741,11 +749,10 @@ Tcl_CreateEnsemble(
}
TclGetNamespaceForQualName(interp, name, nsPtr, TCL_CREATE_NS_IF_UNKNOWN,
- &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
+ &foundNsPtr, &altNsPtr, &actualNsPtr, &simpleName);
return TclCreateEnsembleInNs(interp, simpleName,
- (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
+ (Tcl_Namespace *) foundNsPtr, (Tcl_Namespace *) nsPtr, flags);
}
-
/*
*----------------------------------------------------------------------
@@ -774,7 +781,7 @@ Tcl_SetEnsembleSubcommandList(
EnsembleConfig *ensemblePtr;
Tcl_Obj *oldList;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -850,7 +857,7 @@ Tcl_SetEnsembleParameterList(
Tcl_Obj *oldList;
int length;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -926,7 +933,7 @@ Tcl_SetEnsembleMappingDict(
EnsembleConfig *ensemblePtr;
Tcl_Obj *oldDict;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -1025,7 +1032,7 @@ Tcl_SetEnsembleUnknownHandler(
EnsembleConfig *ensemblePtr;
Tcl_Obj *oldList;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -1091,7 +1098,7 @@ Tcl_SetEnsembleFlags(
EnsembleConfig *ensemblePtr;
int wasCompiled;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -1167,7 +1174,7 @@ Tcl_GetEnsembleSubcommandList(
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
@@ -1209,7 +1216,7 @@ Tcl_GetEnsembleParameterList(
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
@@ -1251,7 +1258,7 @@ Tcl_GetEnsembleMappingDict(
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
@@ -1292,7 +1299,7 @@ Tcl_GetEnsembleUnknownHandler(
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
@@ -1333,7 +1340,7 @@ Tcl_GetEnsembleFlags(
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
@@ -1374,7 +1381,7 @@ Tcl_GetEnsembleNamespace(
Command *cmdPtr = (Command *) token;
EnsembleConfig *ensemblePtr;
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"command is not an ensemble", -1));
@@ -1424,7 +1431,7 @@ Tcl_FindEnsemble(
return NULL;
}
- if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
/*
* Reuse existing infrastructure for following import link chains
* rather than duplicating it.
@@ -1432,7 +1439,8 @@ Tcl_FindEnsemble(
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
- if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
+ if (cmdPtr == NULL
+ || cmdPtr->objProc != TclEnsembleImplementationCmd) {
if (flags & TCL_LEAVE_ERR_MSG) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not an ensemble command",
@@ -1470,11 +1478,11 @@ Tcl_IsEnsemble(
{
Command *cmdPtr = (Command *) token;
- if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
+ if (cmdPtr->objProc == TclEnsembleImplementationCmd) {
return 1;
}
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
- if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+ if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) {
return 0;
}
return 1;
@@ -1637,7 +1645,7 @@ TclMakeEnsemble(
Tcl_DStringFree(&buf);
Tcl_DStringFree(&hiddenBuf);
if (nameParts != NULL) {
- ckfree((char *) nameParts);
+ ckfree(nameParts);
}
return ensemble;
}
@@ -1645,7 +1653,7 @@ TclMakeEnsemble(
/*
*----------------------------------------------------------------------
*
- * NsEnsembleImplementationCmd --
+ * TclEnsembleImplementationCmd --
*
* Implements an ensemble of commands (being those exported by a
* namespace other than the global namespace) as a command with the same
@@ -1664,8 +1672,8 @@ TclMakeEnsemble(
*----------------------------------------------------------------------
*/
-static int
-NsEnsembleImplementationCmd(
+int
+TclEnsembleImplementationCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
@@ -1749,10 +1757,10 @@ NsEnsembleImplementationCmdNR(
* check here, and if we're still valid, we can jump straight to the
* part where we do the invocation of the subcommand.
*/
+ EnsembleCmdRep *ensembleCmd;
- if (subObj->typePtr==&ensembleCmdType){
- EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
-
+ ECRGetIntRep(subObj, ensembleCmd);
+ if (ensembleCmd) {
if (ensembleCmd->epoch == ensemblePtr->epoch &&
ensembleCmd->token == (Command *)ensemblePtr->token) {
prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
@@ -1803,7 +1811,7 @@ NsEnsembleImplementationCmdNR(
int tableLength = ensemblePtr->subcommandTable.numEntries;
Tcl_Obj *fix;
- subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
+ subcmdName = TclGetStringFromObj(subObj, &stringLength);
for (i=0 ; i<tableLength ; i++) {
register int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
@@ -2123,7 +2131,7 @@ TclSpellFix(
*/
size = iPtr->ensembleRewrite.numRemovedObjs + objc
- - iPtr->ensembleRewrite.numInsertedObjs;
+ - iPtr->ensembleRewrite.numInsertedObjs;
search = iPtr->ensembleRewrite.sourceObjs;
if (search[0] == NULL) {
@@ -2398,8 +2406,8 @@ MakeCachedEnsembleCommand(
{
register EnsembleCmdRep *ensembleCmd;
- if (objPtr->typePtr == &ensembleCmdType) {
- ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ ECRGetIntRep(objPtr, ensembleCmd);
+ if (ensembleCmd) {
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
@@ -2410,10 +2418,8 @@ MakeCachedEnsembleCommand(
* our own.
*/
- TclFreeIntRep(objPtr);
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
- objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
- objPtr->typePtr = &ensembleCmdType;
+ ECRSetIntRep(objPtr, ensembleCmd);
}
/*
@@ -2539,9 +2545,10 @@ DeleteEnsembleConfig(
* BuildEnsembleConfig --
*
* Create the internal data structures that describe how an ensemble
- * looks, being a hash mapping from the simple command name to the Tcl list
+ * looks, being a hash mapping from the full command name to the Tcl list
* that describes the implementation prefix words, and a sorted array of
- * the names to allow for reasonably efficient unambiguous prefix handling.
+ * all the full command names to allow for reasonably efficient
+ * unambiguous prefix handling.
*
* Results:
* None.
@@ -2607,7 +2614,9 @@ BuildEnsembleConfig(
}
}
} else {
- /* Usual case where we can freely act on the list and dict. */
+ /*
+ * Usual case where we can freely act on the list and dict.
+ */
for (i = 0; i < subc; i++) {
name = TclGetString(subv[i]);
@@ -2616,7 +2625,10 @@ BuildEnsembleConfig(
continue;
}
- /* Lookup target in the dictionary */
+ /*
+ * Lookup target in the dictionary.
+ */
+
if (mapDict) {
Tcl_DictObjGet(NULL, mapDict, subv[i], &target);
if (target) {
@@ -2628,10 +2640,11 @@ BuildEnsembleConfig(
/*
* target was not in the dictionary so map onto the namespace.
- * Note in this case that we do not guarantee that the
- * command is actually there; that is the programmer's
- * responsibility (or [::unknown] of course).
+ * Note in this case that we do not guarantee that the command
+ * is actually there; that is the programmer's responsibility
+ * (or [::unknown] of course).
*/
+
cmdObj = Tcl_NewStringObj(name, -1);
cmdPrefixObj = Tcl_NewListObj(1, &cmdObj);
Tcl_SetHashValue(hPtr, cmdPrefixObj);
@@ -2810,14 +2823,14 @@ static void
FreeEnsembleCmdRep(
Tcl_Obj *objPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ EnsembleCmdRep *ensembleCmd;
+ ECRGetIntRep(objPtr, ensembleCmd);
TclCleanupCommandMacro(ensembleCmd->token);
if (ensembleCmd->fix) {
Tcl_DecrRefCount(ensembleCmd->fix);
}
ckfree(ensembleCmd);
- objPtr->typePtr = NULL;
}
/*
@@ -2843,11 +2856,12 @@ DupEnsembleCmdRep(
Tcl_Obj *objPtr,
Tcl_Obj *copyPtr)
{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+ EnsembleCmdRep *ensembleCmd;
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
- copyPtr->typePtr = &ensembleCmdType;
- copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+ ECRGetIntRep(objPtr, ensembleCmd);
+ ECRSetIntRep(copyPtr, ensembleCopy);
+
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
ensembleCopy->token->refCount++;
@@ -2973,7 +2987,7 @@ TclCompileEnsemble(
goto failed;
}
for (i=0 ; i<len ; i++) {
- str = Tcl_GetStringFromObj(elems[i], &sclen);
+ str = TclGetStringFromObj(elems[i], &sclen);
if ((sclen == (int) numBytes) && !memcmp(word, str, numBytes)) {
/*
* Exact match! Excellent!
@@ -3362,7 +3376,7 @@ CompileToInvokedCommand(
Tcl_Token *tokPtr;
Tcl_Obj *objPtr, **words;
char *bytes;
- int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
+ int i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME;
DefineLineInformation;
/*
@@ -3375,15 +3389,15 @@ CompileToInvokedCommand(
for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords;
i++, tokPtr = TokenAfter(tokPtr)) {
if (i > 0 && i < numWords+1) {
- bytes = Tcl_GetStringFromObj(words[i-1], &length);
- PushLiteral(envPtr, bytes, length);
+ bytes = TclGetString(words[i-1]);
+ PushLiteral(envPtr, bytes, words[i-1]->length);
continue;
}
SetLineInformation(i);
if (tokPtr->type == TCL_TOKEN_SIMPLE_WORD) {
- int literal = TclRegisterNewLiteral(envPtr,
- tokPtr[1].start, tokPtr[1].size);
+ int literal = TclRegisterLiteral(envPtr,
+ tokPtr[1].start, tokPtr[1].size, 0);
if (envPtr->clNext) {
TclContinuationsEnterDerived(
@@ -3404,11 +3418,11 @@ CompileToInvokedCommand(
objPtr = Tcl_NewObj();
Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr);
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetString(objPtr);
if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
extraLiteralFlags |= LITERAL_UNSHARED;
}
- cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags);
+ cmdLit = TclRegisterLiteral(envPtr, bytes, objPtr->length, extraLiteralFlags);
TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr);
TclEmitPush(cmdLit, envPtr);
TclDecrRefCount(objPtr);
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index b0b8188..7ce5ddd 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -37,7 +37,7 @@ typedef struct BgError {
* pending background errors for the interpreter.
*/
-typedef struct ErrAssocData {
+typedef struct {
Tcl_Interp *interp; /* Interpreter in which error occurred. */
Tcl_Obj *cmdPrefix; /* First word(s) of the handler command */
BgError *firstBgPtr; /* First in list of all background errors
@@ -100,7 +100,7 @@ typedef struct ThreadSpecificData {
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
-#ifdef TCL_THREADS
+#if TCL_THREADS
typedef struct {
Tcl_ThreadCreateProc *proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
@@ -139,6 +139,8 @@ static void FinalizeThread(int quick);
*----------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+#undef Tcl_BackgroundError
void
Tcl_BackgroundError(
Tcl_Interp *interp) /* Interpreter in which an error has
@@ -146,6 +148,7 @@ Tcl_BackgroundError(
{
Tcl_BackgroundException(interp, TCL_ERROR);
}
+#endif /* TCL_NO_DEPRECATED */
void
Tcl_BackgroundException(
@@ -1043,6 +1046,9 @@ TclInitSubsystems(void)
#if USE_TCLALLOC
TclInitAlloc(); /* Process wide mutex init */
#endif
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
+ TclInitThreadAlloc(); /* Setup thread allocator caches */
+#endif
#ifdef TCL_MEM_DEBUG
TclInitDbCkalloc(); /* Process wide mutex init */
#endif
@@ -1054,7 +1060,6 @@ TclInitSubsystems(void)
* mutexes. */
TclInitIOSubsystem(); /* Inits a tsd key (noop). */
TclInitEncodingSubsystem(); /* Process wide encoding init. */
- TclpSetInterfaces();
TclInitNamespaceSubsystem();/* Register ns obj type (mutexed). */
subsystemsInitialized = 1;
}
@@ -1218,7 +1223,7 @@ Tcl_Finalize(void)
* Close down the thread-specific object allocator.
*/
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
TclFinalizeThreadAlloc();
#endif
@@ -1536,7 +1541,7 @@ Tcl_UpdateObjCmd(
return TCL_OK;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1599,7 +1604,7 @@ Tcl_CreateThread(
int flags) /* Flags controlling behaviour of the new
* thread. */
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
int result;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fafd511..717ebf6 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -34,14 +34,14 @@
#endif
/*
- * A mask (should be 2**n-1) that is used to work out when the bytecode engine
- * should call Tcl_AsyncReady() to see whether there is a signal that needs
- * handling.
+ * A counter that is used to work out when the bytecode engine should call
+ * Tcl_AsyncReady() to see whether there is a signal that needs handling, and
+ * other expensive periodic operations.
*/
-#ifndef ASYNC_CHECK_COUNT_MASK
-# define ASYNC_CHECK_COUNT_MASK 63
-#endif /* !ASYNC_CHECK_COUNT_MASK */
+#ifndef ASYNC_CHECK_COUNT
+# define ASYNC_CHECK_COUNT 64
+#endif /* !ASYNC_CHECK_COUNT */
/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -498,29 +498,9 @@ VarHashCreateVar(
* ClientData *ptrPtr, int *tPtr);
*/
-#ifdef TCL_WIDE_INT_IS_LONG
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
- ? (*(tPtr) = TCL_NUMBER_LONG, \
- *(ptrPtr) = (ClientData) \
- (&((objPtr)->internalRep.longValue)), TCL_OK) : \
- ((objPtr)->typePtr == &tclDoubleType) \
- ? (((TclIsNaN((objPtr)->internalRep.doubleValue)) \
- ? (*(tPtr) = TCL_NUMBER_NAN) \
- : (*(tPtr) = TCL_NUMBER_DOUBLE)), \
- *(ptrPtr) = (ClientData) \
- (&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
- (((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
- ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
- TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-#else /* !TCL_WIDE_INT_IS_LONG */
-#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
- (((objPtr)->typePtr == &tclIntType) \
- ? (*(tPtr) = TCL_NUMBER_LONG, \
- *(ptrPtr) = (ClientData) \
- (&((objPtr)->internalRep.longValue)), TCL_OK) : \
- ((objPtr)->typePtr == &tclWideIntType) \
- ? (*(tPtr) = TCL_NUMBER_WIDE, \
+ ? (*(tPtr) = TCL_NUMBER_INT, \
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.wideValue)), TCL_OK) : \
((objPtr)->typePtr == &tclDoubleType) \
@@ -530,23 +510,8 @@ VarHashCreateVar(
*(ptrPtr) = (ClientData) \
(&((objPtr)->internalRep.doubleValue)), TCL_OK) : \
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0)) \
- ? (*(tPtr) = TCL_NUMBER_LONG),TCL_ERROR : \
+ ? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-#endif /* TCL_WIDE_INT_IS_LONG */
-
-/*
- * Macro used in this file to save a function call for common uses of
- * Tcl_GetBooleanFromObj(). The ANSI C "prototype" is:
- *
- * MODULE_SCOPE int TclGetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
- * int *boolPtr);
- */
-
-#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
- ((((objPtr)->typePtr == &tclIntType) \
- || ((objPtr)->typePtr == &tclBooleanType)) \
- ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
- : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
/*
* Macro used to make the check for type overflow more mnemonic. This works by
@@ -576,40 +541,6 @@ VarHashCreateVar(
* Auxiliary tables used to compute powers of small integers.
*/
-#if (LONG_MAX == 0x7fffffff)
-
-/*
- * Maximum base that, when raised to powers 2, 3, ... 8, fits in a 32-bit
- * signed integer.
- */
-
-static const long MaxBase32[] = {46340, 1290, 215, 73, 35, 21, 14};
-static const size_t MaxBase32Size = sizeof(MaxBase32)/sizeof(long);
-
-/*
- * Table giving 3, 4, ..., 11, raised to the powers 9, 10, ..., as far as they
- * fit in a 32-bit signed integer. Exp32Index[i] gives the starting index of
- * powers of i+3; Exp32Value[i] gives the corresponding powers.
- */
-
-static const unsigned short Exp32Index[] = {
- 0, 11, 18, 23, 26, 29, 31, 32, 33
-};
-static const size_t Exp32IndexSize =
- sizeof(Exp32Index) / sizeof(unsigned short);
-static const long Exp32Value[] = {
- 19683, 59049, 177147, 531441, 1594323, 4782969, 14348907, 43046721,
- 129140163, 387420489, 1162261467, 262144, 1048576, 4194304,
- 16777216, 67108864, 268435456, 1073741824, 1953125, 9765625,
- 48828125, 244140625, 1220703125, 10077696, 60466176, 362797056,
- 40353607, 282475249, 1977326743, 134217728, 1073741824, 387420489,
- 1000000000
-};
-static const size_t Exp32ValueSize = sizeof(Exp32Value)/sizeof(long);
-#endif /* LONG_MAX == 0x7fffffff -- 32 bit machine */
-
-#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
-
/*
* Maximum base that, when raised to powers 2, 3, ..., 16, fits in a
* Tcl_WideInt.
@@ -713,7 +644,6 @@ static const Tcl_WideInt Exp64Value[] = {
(Tcl_WideInt)371293*371293*371293*13*13
};
static const size_t Exp64ValueSize = sizeof(Exp64Value) / sizeof(Tcl_WideInt);
-#endif /* (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG) */
/*
* Markers for ExecuteExtendedBinaryMathOp.
@@ -744,8 +674,6 @@ static ByteCode * CompileExprObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void DeleteExecStack(ExecStack *esPtr);
static void DupExprCodeInternalRep(Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr);
-MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
- Tcl_Obj *value2Ptr);
static Tcl_Obj * ExecuteExtendedBinaryMathOp(Tcl_Interp *interp,
int opcode, Tcl_Obj **constants,
Tcl_Obj *valuePtr, Tcl_Obj *value2Ptr);
@@ -820,20 +748,22 @@ ReleaseDictIterator(
{
Tcl_DictSearch *searchPtr;
Tcl_Obj *dictPtr;
+ const Tcl_ObjIntRep *irPtr;
+
+ irPtr = TclFetchIntRep(objPtr, &dictIteratorType);
+ assert(irPtr != NULL);
/*
* First kill the search, and then release the reference to the dictionary
* that we were holding.
*/
- searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ searchPtr = irPtr->twoPtrValue.ptr1;
Tcl_DictObjDone(searchPtr);
ckfree(searchPtr);
- dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ dictPtr = irPtr->twoPtrValue.ptr2;
TclDecrRefCount(dictPtr);
-
- objPtr->typePtr = NULL;
}
/*
@@ -908,9 +838,9 @@ TclCreateExecEnv(
+ (size_t) (size-1) * sizeof(Tcl_Obj *));
eePtr->execStackPtr = esPtr;
- TclNewBooleanObj(eePtr->constants[0], 0);
+ TclNewIntObj(eePtr->constants[0], 0);
Tcl_IncrRefCount(eePtr->constants[0]);
- TclNewBooleanObj(eePtr->constants[1], 1);
+ TclNewIntObj(eePtr->constants[1], 1);
Tcl_IncrRefCount(eePtr->constants[1]);
eePtr->interp = interp;
eePtr->callbackPtr = NULL;
@@ -1272,7 +1202,7 @@ TclStackFree(
Tcl_Obj **markerPtr, *marker;
if (iPtr == NULL || iPtr->execEnvPtr == NULL) {
- ckfree((char *) freePtr);
+ ckfree(freePtr);
return;
}
@@ -1496,11 +1426,9 @@ ExprObjCallback(
*
* Results:
* A (ByteCode *) is returned pointing to the resulting ByteCode.
- * The caller must manage its refCount and arrange for a call to
- * TclCleanupByteCode() when the last reference disappears.
*
* Side effects:
- * The Tcl_ObjType of objPtr is changed to the "bytecode" type,
+ * The Tcl_ObjType of objPtr is changed to the "exprcode" type,
* and the ByteCode is kept in the internal rep (along with context
* data for checking validity) for faster operations the next time
* CompileExprObj is called on the same value.
@@ -1524,28 +1452,31 @@ CompileExprObj(
* Get the expression ByteCode from the object. If it exists, make sure it
* is valid in the current context.
*/
- if (objPtr->typePtr == &exprCodeType) {
+
+ ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+
+ if (codePtr != NULL) {
Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
- FreeExprCodeInternalRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &exprCodeType, NULL);
+ codePtr = NULL;
}
}
- if (objPtr->typePtr != &exprCodeType) {
+
+ if (codePtr == NULL) {
/*
* TIP #280: No invoker (yet) - Expression compilation.
*/
- int length;
- const char *string = TclGetStringFromObj(objPtr, &length);
+ const char *string = TclGetString(objPtr);
- TclInitCompileEnv(interp, &compEnv, string, length, NULL, 0);
- TclCompileExpr(interp, string, length, &compEnv, 0);
+ TclInitCompileEnv(interp, &compEnv, string, objPtr->length, NULL, 0);
+ TclCompileExpr(interp, string, objPtr->length, &compEnv, 0);
/*
* Successful compilation. If the expression yielded no instructions,
@@ -1553,7 +1484,7 @@ CompileExprObj(
*/
if (compEnv.codeNext == compEnv.codeStart) {
- TclEmitPush(TclRegisterNewLiteral(&compEnv, "0", 1),
+ TclEmitPush(TclRegisterLiteral(&compEnv, "0", 1, 0),
&compEnv);
}
@@ -1564,10 +1495,8 @@ CompileExprObj(
*/
TclEmitOpcode(INST_DONE, &compEnv);
- TclInitByteCodeObj(objPtr, &compEnv);
- objPtr->typePtr = &exprCodeType;
+ codePtr = TclInitByteCodeObj(objPtr, &exprCodeType, &compEnv);
TclFreeCompileEnv(&compEnv);
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1639,12 +1568,11 @@ static void
FreeExprCodeInternalRep(
Tcl_Obj *objPtr)
{
- ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+ ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+ assert(codePtr != NULL);
- objPtr->typePtr = NULL;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
}
/*
@@ -1680,7 +1608,8 @@ TclCompileObj(
* compilation). Otherwise, check that it is "fresh" enough.
*/
- if (objPtr->typePtr == &tclByteCodeType) {
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+ if (codePtr != NULL) {
/*
* Make sure the Bytecode hasn't been invalidated by, e.g., someone
* redefining a command with a compile procedure (this might make the
@@ -1698,7 +1627,6 @@ TclCompileObj(
* here.
*/
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != namespacePtr)
@@ -1826,7 +1754,7 @@ TclCompileObj(
iPtr->invokeWord = word;
TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
iPtr->invokeCmdFramePtr = NULL;
- codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
if (iPtr->varFramePtr->localCachePtr) {
codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
codePtr->localCachePtr->refCount++;
@@ -1885,37 +1813,6 @@ TclIncrObj(
return TCL_ERROR;
}
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- long augend = *((const long *) ptr1);
- long addend = *((const long *) ptr2);
- long sum = augend + addend;
-
- /*
- * Overflow when (augend and sum have different sign) and (augend and
- * addend have the same sign). This is encapsulated in the Overflowing
- * macro.
- */
-
- if (!Overflowing(augend, addend, sum)) {
- TclSetLongObj(valuePtr, sum);
- return TCL_OK;
- }
-#ifndef TCL_WIDE_INT_IS_LONG
- {
- Tcl_WideInt w1 = (Tcl_WideInt) augend;
- Tcl_WideInt w2 = (Tcl_WideInt) addend;
-
- /*
- * We know the sum value is outside the long range, so we use the
- * macro form that doesn't range test again.
- */
-
- TclSetWideIntObj(valuePtr, w1 + w2);
- return TCL_OK;
- }
-#endif
- }
-
if ((type1 == TCL_NUMBER_DOUBLE) || (type1 == TCL_NUMBER_NAN)) {
/*
* Produce error message (reparse?!)
@@ -1933,12 +1830,11 @@ TclIncrObj(
return TCL_ERROR;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
Tcl_WideInt w1, w2, sum;
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
- TclGetWideIntFromObj(NULL, incrPtr, &w2);
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
sum = w1 + w2;
/*
@@ -1946,11 +1842,10 @@ TclIncrObj(
*/
if (!Overflowing(w1, w2, sum)) {
- Tcl_SetWideIntObj(valuePtr, sum);
+ TclSetIntObj(valuePtr, sum);
return TCL_OK;
}
}
-#endif
Tcl_TakeBignumFromObj(interp, valuePtr, &value);
Tcl_GetBignumFromObj(interp, incrPtr, &incr);
@@ -2030,7 +1925,7 @@ TclNRExecuteByteCode(
* sizeof(void *);
int numWords = (size + sizeof(Tcl_Obj *) - 1) / sizeof(Tcl_Obj *);
- codePtr->refCount++;
+ TclPreserveByteCode(codePtr);
/*
* Reserve the stack, setup the TEBCdataPtr (TD) and CallFrame
@@ -2119,8 +2014,14 @@ TEBCresume(
* sporadically: no special need for speed.
*/
- int instructionCount = 0; /* Counter that is used to work out when to
- * call Tcl_AsyncReady() */
+ unsigned interruptCounter = 1;
+ /* Counter that is used to work out when to
+ * call Tcl_AsyncReady(). This must be 1
+ * initially so that we call the async-check
+ * stanza early, otherwise there are command
+ * sequences that can make the interpreter
+ * busy-loop without an opportunity to
+ * recognise an interrupt. */
const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
int traceInstructions; /* Whether we are doing instruction-level
@@ -2318,10 +2219,11 @@ TEBCresume(
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
- * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
+ * ASYNC_CHECK_COUNT instructions.
*/
- if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
+ if ((--interruptCounter) == 0) {
+ interruptCounter = ASYNC_CHECK_COUNT;
DECACHE_STACK_INFO();
if (TclAsyncReady(iPtr)) {
result = Tcl_AsyncInvoke(interp, result);
@@ -2535,7 +2437,7 @@ TEBCresume(
/* FIXME: What is the right thing to trace? */
fprintf(stdout, "%d: (%u) yielding to [%.30s]\n",
iPtr->numLevels, (unsigned)(pc - codePtr->codeStart),
- Tcl_GetString(valuePtr));
+ TclGetString(valuePtr));
}
fflush(stdout);
}
@@ -2682,154 +2584,18 @@ TEBCresume(
NEXT_INST_F(5, 0, 0);
}
- case INST_STR_CONCAT1: {
- int appendLen = 0;
- char *bytes, *p;
- Tcl_Obj **currPtr;
- int onlyb = 1;
+ case INST_STR_CONCAT1:
opnd = TclGetUInt1AtPtr(pc+1);
-
- /*
- * Detect only-bytearray-or-null case.
- */
-
- for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) {
- if (((*currPtr)->typePtr != &tclByteArrayType)
- && ((*currPtr)->bytes != tclEmptyStringRep)) {
- onlyb = 0;
- break;
- } else if (((*currPtr)->typePtr == &tclByteArrayType) &&
- ((*currPtr)->bytes != NULL)) {
- onlyb = 0;
- break;
- }
- }
-
- /*
- * Compute the length to be appended.
- */
-
- if (onlyb) {
- for (currPtr = &OBJ_AT_DEPTH(opnd-2);
- appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
- if ((*currPtr)->bytes != tclEmptyStringRep) {
- Tcl_GetByteArrayFromObj(*currPtr, &length);
- appendLen += length;
- }
- }
- } else {
- for (currPtr = &OBJ_AT_DEPTH(opnd-2);
- appendLen >= 0 && currPtr <= &OBJ_AT_TOS; currPtr++) {
- bytes = TclGetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- appendLen += length;
- }
- }
- }
-
- if (appendLen < 0) {
- /* TODO: convert panic to error ? */
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
- }
-
- /*
- * If nothing is to be appended, just return the first object by
- * dropping all the others from the stack; this saves both the
- * computation and copy of the string rep of the first object,
- * enabling the fast '$x[set x {}]' idiom for 'K $x [set x {}]'.
- */
-
- if (appendLen == 0) {
- TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
- NEXT_INST_V(2, (opnd-1), 0);
- }
-
- /*
- * If the first object is shared, we need a new obj for the result;
- * otherwise, we can reuse the first object. In any case, make sure it
- * has enough room to accomodate all the concatenated bytes. Note that
- * if it is unshared its bytes are copied by ckrealloc, so that we set
- * the loop parameters to avoid copying them again: p points to the
- * end of the already copied bytes, currPtr to the second object.
- */
-
- objResultPtr = OBJ_AT_DEPTH(opnd-1);
- if (!onlyb) {
- bytes = TclGetStringFromObj(objResultPtr, &length);
- if (length + appendLen < 0) {
- /* TODO: convert panic to error ? */
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
- INT_MAX);
- }
-#ifndef TCL_COMPILE_DEBUG
- if (bytes != tclEmptyStringRep && !Tcl_IsShared(objResultPtr)) {
- TclFreeIntRep(objResultPtr);
- objResultPtr->bytes = ckrealloc(bytes, length+appendLen+1);
- objResultPtr->length = length + appendLen;
- p = TclGetString(objResultPtr) + length;
- currPtr = &OBJ_AT_DEPTH(opnd - 2);
- } else
-#endif
- {
- p = ckalloc(length + appendLen + 1);
- TclNewObj(objResultPtr);
- objResultPtr->bytes = p;
- objResultPtr->length = length + appendLen;
- currPtr = &OBJ_AT_DEPTH(opnd - 1);
- }
-
- /*
- * Append the remaining characters.
- */
-
- for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
- bytes = TclGetStringFromObj(*currPtr, &length);
- if (bytes != NULL) {
- memcpy(p, bytes, (size_t) length);
- p += length;
- }
- }
- *p = '\0';
- } else {
- bytes = (char *) Tcl_GetByteArrayFromObj(objResultPtr, &length);
- if (length + appendLen < 0) {
- /* TODO: convert panic to error ? */
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded",
- INT_MAX);
- }
-#ifndef TCL_COMPILE_DEBUG
- if (!Tcl_IsShared(objResultPtr)) {
- bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
- length + appendLen);
- p = bytes + length;
- currPtr = &OBJ_AT_DEPTH(opnd - 2);
- } else
-#endif
- {
- TclNewObj(objResultPtr);
- bytes = (char *) Tcl_SetByteArrayLength(objResultPtr,
- length + appendLen);
- p = bytes;
- currPtr = &OBJ_AT_DEPTH(opnd - 1);
- }
-
- /*
- * Append the remaining characters.
- */
-
- for (; currPtr <= &OBJ_AT_TOS; currPtr++) {
- if ((*currPtr)->bytes != tclEmptyStringRep) {
- bytes = (char *) Tcl_GetByteArrayFromObj(*currPtr,&length);
- memcpy(p, bytes, (size_t) length);
- p += length;
- }
- }
+ objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
+ TCL_STRING_IN_PLACE);
+ if (objResultPtr == NULL) {
+ TRACE_ERROR(interp);
+ goto gotError;
}
TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
NEXT_INST_V(2, opnd, 1);
- }
case INST_CONCAT_STK:
/*
@@ -3763,9 +3529,7 @@ TEBCresume(
{
Tcl_Obj *incrPtr;
-#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w;
-#endif
long increment;
case INST_INCR_SCALAR1:
@@ -3864,9 +3628,9 @@ TEBCresume(
objPtr = varPtr->value.objPtr;
if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
- if (type == TCL_NUMBER_LONG) {
- long augend = *((const long *)ptr);
- long sum = augend + increment;
+ if (type == TCL_NUMBER_INT) {
+ Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
+ Tcl_WideInt sum = augend + increment;
/*
* Overflow when (augend and sum have different sign) and
@@ -3878,16 +3642,15 @@ TEBCresume(
TRACE(("%u %ld => ", opnd, increment));
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared. */
- TclNewLongObj(objResultPtr, sum);
+ TclNewIntObj(objResultPtr, sum);
Tcl_IncrRefCount(objResultPtr);
varPtr->value.objPtr = objResultPtr;
} else {
objResultPtr = objPtr;
- TclSetLongObj(objPtr, sum);
+ TclSetIntObj(objPtr, sum);
}
goto doneIncr;
}
-#ifndef TCL_WIDE_INT_IS_LONG
w = (Tcl_WideInt)augend;
TRACE(("%u %ld => ", opnd, increment));
@@ -3904,44 +3667,10 @@ TEBCresume(
* use macro form that doesn't range test again.
*/
- TclSetWideIntObj(objPtr, w+increment);
+ TclSetIntObj(objPtr, w+increment);
}
goto doneIncr;
-#endif
- } /* end if (type == TCL_NUMBER_LONG) */
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type == TCL_NUMBER_WIDE) {
- Tcl_WideInt sum;
-
- w = *((const Tcl_WideInt *) ptr);
- sum = w + increment;
-
- /*
- * Check for overflow.
- */
-
- if (!Overflowing(w, increment, sum)) {
- TRACE(("%u %ld => ", opnd, increment));
- if (Tcl_IsShared(objPtr)) {
- objPtr->refCount--; /* We know it's shared. */
- objResultPtr = Tcl_NewWideIntObj(sum);
- Tcl_IncrRefCount(objResultPtr);
- varPtr->value.objPtr = objResultPtr;
- } else {
- objResultPtr = objPtr;
-
- /*
- * We *do not* know the sum value is outside the
- * long range (wide + long can yield long); use
- * the function call that checks range.
- */
-
- Tcl_SetWideIntObj(objPtr, sum);
- }
- goto doneIncr;
- }
- }
-#endif
+ } /* end if (type == TCL_NUMBER_INT) */
}
if (Tcl_IsShared(objPtr)) {
objPtr->refCount--; /* We know it's shared */
@@ -3951,7 +3680,7 @@ TEBCresume(
} else {
objResultPtr = objPtr;
}
- TclNewLongObj(incrPtr, increment);
+ TclNewIntObj(incrPtr, increment);
if (TclIncrObj(interp, objResultPtr, incrPtr) != TCL_OK) {
Tcl_DecrRefCount(incrPtr);
TRACE_ERROR(interp);
@@ -3965,7 +3694,7 @@ TEBCresume(
* All other cases, flow through to generic handling.
*/
- TclNewLongObj(incrPtr, increment);
+ TclNewIntObj(incrPtr, increment);
Tcl_IncrRefCount(incrPtr);
doIncrScalar:
@@ -4349,10 +4078,7 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclSetVarArray(varPtr);
- varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
- TclInitVarHashTable(varPtr->value.tablePtr,
- TclGetVarNsPtr(varPtr));
+ TclInitArrayVar(varPtr);
#ifdef TCL_COMPILE_DEBUG
TRACE_APPEND(("done\n"));
} else {
@@ -5042,8 +4768,8 @@ TEBCresume(
*/
if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
- && (value2Ptr->typePtr != &tclListType)
- && (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
+ && !TclHasIntRep(value2Ptr, &tclListType)
+ && (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
&index) == TCL_OK)) {
TclDecrRefCount(value2Ptr);
tosPtr--;
@@ -5215,11 +4941,11 @@ TEBCresume(
TclGetInt4AtPtr(pc+5)));
/*
- * Get the contents of the list, making sure that it really is a list
+ * Get the length of the list, making sure that it really is a list
* in the process.
*/
- if (TclListObjGetElements(interp, valuePtr, &objc, &objv) != TCL_OK) {
+ if (TclListObjLength(interp, valuePtr, &objc) != TCL_OK) {
TRACE_ERROR(interp);
goto gotError;
}
@@ -5247,17 +4973,11 @@ TEBCresume(
/* Decode index value operands. */
- /*
- assert ( toIdx != TCL_INDEX_AFTER);
- *
- * Extra safety for legacy bytecodes:
- */
- if (toIdx == TCL_INDEX_AFTER) {
- toIdx = TCL_INDEX_END;
- }
-
- if ((toIdx == TCL_INDEX_BEFORE) || (fromIdx == TCL_INDEX_AFTER)) {
- goto emptyList;
+ if (toIdx == TCL_INDEX_NONE) {
+ emptyList:
+ objResultPtr = Tcl_NewObj();
+ TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
+ NEXT_INST_F(9, 1, 1);
}
toIdx = TclIndexDecode(toIdx, objc - 1);
if (toIdx < 0) {
@@ -5268,37 +4988,17 @@ TEBCresume(
assert ( toIdx >= 0 && toIdx < objc);
/*
- assert ( fromIdx != TCL_INDEX_BEFORE );
+ assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
- if (fromIdx == TCL_INDEX_BEFORE) {
+ if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
fromIdx = TclIndexDecode(fromIdx, objc - 1);
- if (fromIdx < 0) {
- fromIdx = 0;
- }
- if (fromIdx <= toIdx) {
- /* Construct the subsquence list */
- /* unshared optimization */
- if (Tcl_IsShared(valuePtr)) {
- objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
- } else {
- if (toIdx != objc - 1) {
- Tcl_ListObjReplace(NULL, valuePtr, toIdx + 1, LIST_MAX,
- 0, NULL);
- }
- Tcl_ListObjReplace(NULL, valuePtr, 0, fromIdx, 0, NULL);
- TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
- NEXT_INST_F(9, 0, 0);
- }
- } else {
- emptyList:
- TclNewObj(objResultPtr);
- }
+ objResultPtr = TclListObjRange(valuePtr, fromIdx, toIdx);
TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
NEXT_INST_F(9, 1, 1);
@@ -5515,17 +5215,23 @@ TEBCresume(
objResultPtr = Tcl_NewStringObj((const char *)
valuePtr->bytes+index, 1);
} else {
- char buf[TCL_UTF_MAX];
- Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
+ char buf[4];
+ int ch = Tcl_GetUniChar(valuePtr, index);
/*
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
* but creating the object as a string seems to be faster in
* practical use.
*/
-
- length = Tcl_UniCharToUtf(ch, buf);
- objResultPtr = Tcl_NewStringObj(buf, length);
+ if (ch == -1) {
+ objResultPtr = Tcl_NewObj();
+ } else {
+ length = Tcl_UniCharToUtf(ch, buf);
+ if (!length) {
+ length = Tcl_UniCharToUtf(-1, buf);
+ }
+ objResultPtr = Tcl_NewStringObj(buf, length);
+ }
}
TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
@@ -5573,17 +5279,13 @@ TEBCresume(
/* Decode index operands. */
/*
- assert ( toIdx != TCL_INDEX_BEFORE );
- assert ( toIdx != TCL_INDEX_AFTER);
+ assert ( toIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
- if (toIdx == TCL_INDEX_BEFORE) {
+ if (toIdx == TCL_INDEX_NONE) {
goto emptyRange;
}
- if (toIdx == TCL_INDEX_AFTER) {
- toIdx = TCL_INDEX_END;
- }
toIdx = TclIndexDecode(toIdx, length - 1);
if (toIdx < 0) {
@@ -5595,17 +5297,13 @@ TEBCresume(
assert ( toIdx >= 0 && toIdx < length );
/*
- assert ( fromIdx != TCL_INDEX_BEFORE );
- assert ( fromIdx != TCL_INDEX_AFTER);
+ assert ( fromIdx != TCL_INDEX_NONE );
*
* Extra safety for legacy bytecodes:
*/
- if (fromIdx == TCL_INDEX_BEFORE) {
+ if (fromIdx == TCL_INDEX_NONE) {
fromIdx = TCL_INDEX_START;
}
- if (fromIdx == TCL_INDEX_AFTER) {
- goto emptyRange;
- }
fromIdx = TclIndexDecode(fromIdx, length - 1);
if (fromIdx < 0) {
@@ -5668,82 +5366,9 @@ TEBCresume(
NEXT_INST_F(1, 0, 0);
}
- length3 = Tcl_GetCharLength(value3Ptr);
-
- /*
- * See if we can splice in place. This happens when the number of
- * characters being replaced is the same as the number of characters
- * in the string to be inserted.
- */
-
- if (length3 - 1 == toIdx - fromIdx) {
- unsigned char *bytes1, *bytes2;
+ objResultPtr = TclStringReplace(interp, valuePtr, fromIdx,
+ toIdx - fromIdx + 1, value3Ptr, TCL_STRING_IN_PLACE);
- if (Tcl_IsShared(valuePtr)) {
- objResultPtr = Tcl_DuplicateObj(valuePtr);
- } else {
- objResultPtr = valuePtr;
- }
- if (TclIsPureByteArray(objResultPtr)
- && TclIsPureByteArray(value3Ptr)) {
- bytes1 = Tcl_GetByteArrayFromObj(objResultPtr, NULL);
- bytes2 = Tcl_GetByteArrayFromObj(value3Ptr, NULL);
- memcpy(bytes1 + fromIdx, bytes2, length3);
- } else {
- ustring1 = Tcl_GetUnicodeFromObj(objResultPtr, NULL);
- ustring2 = Tcl_GetUnicodeFromObj(value3Ptr, NULL);
- memcpy(ustring1 + fromIdx, ustring2,
- length3 * sizeof(Tcl_UniChar));
- }
- Tcl_InvalidateStringRep(objResultPtr);
- TclDecrRefCount(value3Ptr);
- TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
- if (objResultPtr == valuePtr) {
- NEXT_INST_F(1, 0, 0);
- } else {
- NEXT_INST_F(1, 1, 1);
- }
- }
-
- /*
- * Get the unicode representation; this is where we guarantee to lose
- * bytearrays.
- */
-
- ustring1 = Tcl_GetUnicodeFromObj(valuePtr, &length);
- length--;
-
- /*
- * Remove substring using copying.
- */
-
- objResultPtr = NULL;
- if (fromIdx > 0) {
- objResultPtr = Tcl_NewUnicodeObj(ustring1, fromIdx);
- }
- if (length3 > 0) {
- if (objResultPtr) {
- Tcl_AppendObjToObj(objResultPtr, value3Ptr);
- } else if (Tcl_IsShared(value3Ptr)) {
- objResultPtr = Tcl_DuplicateObj(value3Ptr);
- } else {
- objResultPtr = value3Ptr;
- }
- }
- if (toIdx < length) {
- if (objResultPtr) {
- Tcl_AppendUnicodeToObj(objResultPtr, ustring1 + toIdx + 1,
- length - toIdx);
- } else {
- objResultPtr = Tcl_NewUnicodeObj(ustring1 + toIdx + 1,
- length - toIdx);
- }
- }
- if (objResultPtr == NULL) {
- /* This has to be the case [string replace $s 0 end {}] */
- /* which has result {} which is same as value3Ptr. */
- objResultPtr = value3Ptr;
- }
if (objResultPtr == value3Ptr) {
/* See [Bug 82e7f67325] */
TclDecrRefCount(OBJ_AT_TOS);
@@ -5816,20 +5441,7 @@ TEBCresume(
NEXT_INST_V(1, 3, 1);
case INST_STR_FIND:
- ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
- ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
-
- match = -1;
- if (length2 > 0 && length2 <= length) {
- end = ustring1 + length - length2 + 1;
- for (p=ustring1 ; p<end ; p++) {
- if ((*p == *ustring2) &&
- memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
- match = p - ustring1;
- break;
- }
- }
- }
+ match = TclStringFirst(OBJ_UNDER_TOS, OBJ_AT_TOS, 0);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
@@ -5837,23 +5449,10 @@ TEBCresume(
NEXT_INST_F(1, 2, 1);
case INST_STR_FIND_LAST:
- ustring1 = Tcl_GetUnicodeFromObj(OBJ_AT_TOS, &length); /* Haystack */
- ustring2 = Tcl_GetUnicodeFromObj(OBJ_UNDER_TOS, &length2);/* Needle */
-
- match = -1;
- if (length2 > 0 && length2 <= length) {
- for (p=ustring1+length-length2 ; p>=ustring1 ; p--) {
- if ((*p == *ustring2) &&
- memcmp(ustring2,p,sizeof(Tcl_UniChar)*length2) == 0) {
- match = p - ustring1;
- break;
- }
- }
- }
+ match = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
TRACE(("%.20s %.20s => %d\n",
O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), match));
-
TclNewIntObj(objResultPtr, match);
NEXT_INST_F(1, 2, 1);
@@ -6022,35 +5621,18 @@ TEBCresume(
{
ClientData ptr1, ptr2;
int type1, type2;
- long l1, l2, lResult;
+ Tcl_WideInt w1, w2, wResult;
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
type1 = 0;
- } else if (type1 == TCL_NUMBER_LONG) {
- /* value is between LONG_MIN and LONG_MAX */
- /* [string is integer] is -UINT_MAX to UINT_MAX range */
- int i;
-
- if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) != TCL_OK) {
- type1 = TCL_NUMBER_WIDE;
- }
-#ifndef TCL_WIDE_INT_IS_LONG
- } else if (type1 == TCL_NUMBER_WIDE) {
- /* value is between WIDE_MIN and WIDE_MAX */
- /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
- int i;
- if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
- type1 = TCL_NUMBER_LONG;
- }
-#endif
} else if (type1 == TCL_NUMBER_BIG) {
/* value is an integer outside the WIDE_MIN to WIDE_MAX range */
- /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+ /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
Tcl_WideInt w;
if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
- type1 = TCL_NUMBER_WIDE;
+ type1 = TCL_NUMBER_INT;
}
}
TclNewIntObj(objResultPtr, type1);
@@ -6096,10 +5678,10 @@ TEBCresume(
compare = MP_EQ;
goto convertComparison;
}
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
- compare = (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
+ compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
} else {
compare = TclCompareTwoNumbers(valuePtr, value2Ptr);
}
@@ -6175,17 +5757,17 @@ TEBCresume(
* Check for common, simple case.
*/
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_MOD:
- if (l2 == 0) {
+ if (w2 == 0) {
TRACE(("%s %s => DIVIDE BY ZERO\n", O2S(valuePtr),
O2S(value2Ptr)));
goto divideByZero;
- } else if ((l2 == 1) || (l2 == -1)) {
+ } else if ((w2 == 1) || (w2 == -1)) {
/*
* Div. by |1| always yields remainder of 0.
*/
@@ -6194,7 +5776,7 @@ TEBCresume(
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
- } else if (l1 == 0) {
+ } else if (w1 == 0) {
/*
* 0 % (non-zero) always yields remainder of 0.
*/
@@ -6204,24 +5786,24 @@ TEBCresume(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
} else {
- lResult = l1 / l2;
+ wResult = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
- if ((lResult < 0 || (lResult == 0 &&
- ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
- (lResult * l2 != l1)) {
- lResult -= 1;
+ if ((wResult < 0 || (wResult == 0 &&
+ ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+ (wResult * w2 != w1)) {
+ wResult -= 1;
}
- lResult = l1 - l2*lResult;
- goto longResultOfArithmetic;
+ wResult = w1 - w2*wResult;
+ goto wideResultOfArithmetic;
}
case INST_RSHIFT:
- if (l2 < 0) {
+ if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
@@ -6232,7 +5814,7 @@ TEBCresume(
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
- } else if (l1 == 0) {
+ } else if (w1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
@@ -6242,7 +5824,7 @@ TEBCresume(
* Quickly force large right shifts to 0 or -1.
*/
- if (l2 >= (long)(CHAR_BIT*sizeof(long))) {
+ if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
/*
* We assume that INT_MAX is much larger than the
* number of bits in a long. This is a pretty safe
@@ -6251,7 +5833,7 @@ TEBCresume(
*/
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
- if (l1 > 0L) {
+ if (w1 > 0L) {
objResultPtr = TCONST(0);
} else {
TclNewIntObj(objResultPtr, -1);
@@ -6264,12 +5846,12 @@ TEBCresume(
* Handle shifts within the native long range.
*/
- lResult = l1 >> ((int) l2);
- goto longResultOfArithmetic;
+ wResult = w1 >> ((int) w2);
+ goto wideResultOfArithmetic;
}
case INST_LSHIFT:
- if (l2 < 0) {
+ if (w2 < 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"negative shift argument", -1));
#ifdef ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR
@@ -6280,12 +5862,12 @@ TEBCresume(
CACHE_STACK_INFO();
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
- } else if (l1 == 0) {
+ } else if (w1 == 0) {
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
objResultPtr = TCONST(0);
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
- } else if (l2 > (long) INT_MAX) {
+ } else if (w2 > INT_MAX) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1))
* in an mp_int, but since we're using mp_mul_2d() to do
@@ -6303,17 +5885,17 @@ TEBCresume(
#endif /* ERROR_CODE_FOR_EARLY_DETECTED_ARITH_ERROR */
goto gotError;
} else {
- int shift = (int) l2;
+ int shift = (int) w2;
/*
* Handle shifts within the native long range.
*/
- if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0)
- && !((l1>0 ? l1 : ~l1) &
+ if ((size_t) shift < CHAR_BIT*sizeof(long) && (w1 != 0)
+ && !((w1>0 ? w1 : ~w1) &
-(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
- lResult = l1 << shift;
- goto longResultOfArithmetic;
+ wResult = w1 << shift;
+ goto wideResultOfArithmetic;
}
}
@@ -6325,23 +5907,14 @@ TEBCresume(
break;
case INST_BITAND:
- lResult = l1 & l2;
- goto longResultOfArithmetic;
+ wResult = w1 & w2;
+ goto wideResultOfArithmetic;
case INST_BITOR:
- lResult = l1 | l2;
- goto longResultOfArithmetic;
+ wResult = w1 | w2;
+ goto wideResultOfArithmetic;
case INST_BITXOR:
- lResult = l1 ^ l2;
- longResultOfArithmetic:
- TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
- if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, lResult);
- TRACE(("%s\n", O2S(objResultPtr)));
- NEXT_INST_F(1, 2, 1);
- }
- TclSetLongObj(valuePtr, lResult);
- TRACE(("%s\n", O2S(valuePtr)));
- NEXT_INST_F(1, 1, 0);
+ wResult = w1 ^ w2;
+ goto wideResultOfArithmetic;
}
}
@@ -6424,18 +5997,13 @@ TEBCresume(
* an external function.
*/
- if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) {
- Tcl_WideInt w1, w2, wResult;
-
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (*pc) {
case INST_ADD:
- w1 = (Tcl_WideInt) l1;
- w2 = (Tcl_WideInt) l2;
wResult = w1 + w2;
-#ifdef TCL_WIDE_INT_IS_LONG
/*
* Check for overflow.
*/
@@ -6443,14 +6011,10 @@ TEBCresume(
if (Overflowing(w1, w2, wResult)) {
goto overflow;
}
-#endif
goto wideResultOfArithmetic;
case INST_SUB:
- w1 = (Tcl_WideInt) l1;
- w2 = (Tcl_WideInt) l2;
wResult = w1 - w2;
-#ifdef TCL_WIDE_INT_IS_LONG
/*
* Must check for overflow. The macro tests for overflows in
* sums by looking at the sign bits. As we have a subtraction
@@ -6464,7 +6028,6 @@ TEBCresume(
if (Overflowing(w1, ~w2, wResult)) {
goto overflow;
}
-#endif
wideResultOfArithmetic:
TRACE(("%s %s => ", O2S(valuePtr), O2S(value2Ptr)));
if (Tcl_IsShared(valuePtr)) {
@@ -6472,45 +6035,45 @@ TEBCresume(
TRACE(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, 1);
}
- Tcl_SetWideIntObj(valuePtr, wResult);
+ TclSetIntObj(valuePtr, wResult);
TRACE(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 1, 0);
case INST_DIV:
- if (l2 == 0) {
+ if (w2 == 0) {
TRACE(("%s %s => DIVIDE BY ZERO\n",
O2S(valuePtr), O2S(value2Ptr)));
goto divideByZero;
- } else if ((l1 == LONG_MIN) && (l2 == -1)) {
+ } else if ((w1 == WIDE_MIN) && (w2 == -1)) {
/*
- * Can't represent (-LONG_MIN) as a long.
+ * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
*/
goto overflow;
}
- lResult = l1 / l2;
+ wResult = w1 / w2;
/*
* Force Tcl's integer division rules.
* TODO: examine for logic simplification
*/
- if (((lResult < 0) || ((lResult == 0) &&
- ((l1 < 0 && l2 > 0) || (l1 > 0 && l2 < 0)))) &&
- ((lResult * l2) != l1)) {
- lResult -= 1;
+ if (((wResult < 0) || ((wResult == 0) &&
+ ((w1 < 0 && w2 > 0) || (w1 > 0 && w2 < 0)))) &&
+ ((wResult * w2) != w1)) {
+ wResult -= 1;
}
- goto longResultOfArithmetic;
+ goto wideResultOfArithmetic;
case INST_MULT:
- if (((sizeof(long) >= 2*sizeof(int))
- && (l1 <= INT_MAX) && (l1 >= INT_MIN)
- && (l2 <= INT_MAX) && (l2 >= INT_MIN))
- || ((sizeof(long) >= 2*sizeof(short))
- && (l1 <= SHRT_MAX) && (l1 >= SHRT_MIN)
- && (l2 <= SHRT_MAX) && (l2 >= SHRT_MIN))) {
- lResult = l1 * l2;
- goto longResultOfArithmetic;
+ if (((sizeof(Tcl_WideInt) >= 2*sizeof(int))
+ && (w1 <= INT_MAX) && (w1 >= INT_MIN)
+ && (w2 <= INT_MAX) && (w2 >= INT_MIN))
+ || ((sizeof(Tcl_WideInt) >= 2*sizeof(short))
+ && (w1 <= SHRT_MAX) && (w1 >= SHRT_MIN)
+ && (w2 <= SHRT_MAX) && (w2 >= SHRT_MIN))) {
+ wResult = w1 * w2;
+ goto wideResultOfArithmetic;
}
}
@@ -6577,14 +6140,14 @@ TEBCresume(
CACHE_STACK_INFO();
goto gotError;
}
- if (type1 == TCL_NUMBER_LONG) {
- l1 = *((const long *) ptr1);
+ if (type1 == TCL_NUMBER_INT) {
+ w1 = *((const Tcl_WideInt *) ptr1);
if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, ~l1);
+ TclNewIntObj(objResultPtr, ~w1);
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
- TclSetLongObj(valuePtr, ~l1);
+ TclSetIntObj(valuePtr, ~w1);
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -6614,15 +6177,15 @@ TEBCresume(
/* -NaN => NaN */
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
- case TCL_NUMBER_LONG:
- l1 = *((const long *) ptr1);
- if (l1 != LONG_MIN) {
+ case TCL_NUMBER_INT:
+ w1 = *((const Tcl_WideInt *) ptr1);
+ if (w1 != WIDE_MIN) {
if (Tcl_IsShared(valuePtr)) {
- TclNewLongObj(objResultPtr, -l1);
+ TclNewIntObj(objResultPtr, -w1);
TRACE_APPEND(("%s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 1, 1);
}
- TclSetLongObj(valuePtr, -l1);
+ TclSetIntObj(valuePtr, -w1);
TRACE_APPEND(("%s\n", O2S(valuePtr)));
NEXT_INST_F(1, 0, 0);
}
@@ -6766,7 +6329,8 @@ TEBCresume(
Var *iterVarPtr, *listVarPtr;
Tcl_Obj *oldValuePtr, *listPtr, **elements;
ForeachVarList *varListPtr;
- int numLists, iterNum, listTmpIndex, listLen, numVars;
+ int numLists, listTmpIndex, listLen, numVars;
+ size_t iterNum;
int varIndex, valIndex, continueLoop, j, iterTmpIndex;
long i;
@@ -6783,10 +6347,10 @@ TEBCresume(
oldValuePtr = iterVarPtr->value.objPtr;
if (oldValuePtr == NULL) {
- TclNewLongObj(iterVarPtr->value.objPtr, -1);
+ TclNewIntObj(iterVarPtr->value.objPtr, -1);
Tcl_IncrRefCount(iterVarPtr->value.objPtr);
} else {
- TclSetLongObj(oldValuePtr, -1);
+ TclSetIntObj(oldValuePtr, -1);
}
TRACE(("%u => loop iter count temp %d\n", opnd, iterTmpIndex));
@@ -6820,8 +6384,8 @@ TEBCresume(
iterVarPtr = LOCAL(infoPtr->loopCtTemp);
valuePtr = iterVarPtr->value.objPtr;
- iterNum = valuePtr->internalRep.longValue + 1;
- TclSetLongObj(valuePtr, iterNum);
+ iterNum = (size_t)valuePtr->internalRep.wideValue + 1;
+ TclSetIntObj(valuePtr, iterNum);
/*
* Check whether all value lists are exhausted and we should stop the
@@ -6841,7 +6405,7 @@ TEBCresume(
i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
goto gotError;
}
- if (listLen > iterNum * numVars) {
+ if ((size_t)listLen > iterNum * numVars) {
continueLoop = 1;
}
listTmpIndex++;
@@ -6907,7 +6471,7 @@ TEBCresume(
listTmpIndex++;
}
}
- TRACE_APPEND(("%d lists, iter %d, %s loop\n",
+ TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n",
numLists, iterNum, (continueLoop? "continue" : "exit")));
/*
@@ -6928,8 +6492,9 @@ TEBCresume(
ForeachInfo *infoPtr;
Tcl_Obj *listPtr, **elements, *tmpPtr;
ForeachVarList *varListPtr;
- int numLists, iterMax, listLen, numVars;
- int iterTmp, iterNum, listTmpDepth;
+ int numLists, listLen, numVars;
+ int listTmpDepth;
+ size_t iterNum, iterMax, iterTmp;
int varIndex, valIndex, j;
long i;
@@ -6980,8 +6545,8 @@ TEBCresume(
*/
TclNewObj(tmpPtr);
- tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(0);
- tmpPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(iterMax);
+ tmpPtr->internalRep.twoPtrValue.ptr1 = NULL;
+ tmpPtr->internalRep.twoPtrValue.ptr2 = (void *)iterMax;
PUSH_OBJECT(tmpPtr); /* iterCounts object */
/*
@@ -7013,8 +6578,8 @@ TEBCresume(
TRACE(("=> "));
tmpPtr = OBJ_AT_DEPTH(1);
- iterNum = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr1);
- iterMax = PTR2INT(tmpPtr->internalRep.twoPtrValue.ptr2);
+ iterNum = (size_t)tmpPtr->internalRep.twoPtrValue.ptr1;
+ iterMax = (size_t)tmpPtr->internalRep.twoPtrValue.ptr2;
/*
* If some list still has a remaining list element iterate one more
@@ -7026,7 +6591,7 @@ TEBCresume(
* Set the variables and jump back to run the body
*/
- tmpPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(iterNum + 1);
+ tmpPtr->internalRep.twoPtrValue.ptr1 =(void *)(iterNum + 1);
listTmpDepth = numLists + 1;
@@ -7534,13 +7099,16 @@ TEBCresume(
TRACE_ERROR(interp);
goto gotError;
}
- TclNewObj(statePtr);
- statePtr->typePtr = &dictIteratorType;
- statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
- statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
+ {
+ Tcl_ObjIntRep ir;
+ TclNewObj(statePtr);
+ ir.twoPtrValue.ptr1 = searchPtr;
+ ir.twoPtrValue.ptr2 = dictPtr;
+ Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
+ }
varPtr = LOCAL(opnd);
if (varPtr->value.objPtr) {
- if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
+ if (TclHasIntRep(varPtr->value.objPtr, &dictIteratorType)) {
Tcl_Panic("mis-issued dictFirst!");
}
TclDecrRefCount(varPtr->value.objPtr);
@@ -7553,11 +7121,17 @@ TEBCresume(
opnd = TclGetUInt4AtPtr(pc+1);
TRACE(("%u => ", opnd));
statePtr = (*LOCAL(opnd)).value.objPtr;
- if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
- Tcl_Panic("mis-issued dictNext!");
+ {
+ const Tcl_ObjIntRep *irPtr;
+
+ if (statePtr &&
+ (irPtr = TclFetchIntRep(statePtr, &dictIteratorType))) {
+ searchPtr = irPtr->twoPtrValue.ptr1;
+ Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
+ } else {
+ Tcl_Panic("mis-issued dictNext!");
+ }
}
- searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
- Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
pushDictIteratorResult:
if (done) {
TclNewObj(emptyPtr);
@@ -7820,7 +7394,6 @@ TEBCresume(
default:
Tcl_Panic("clockRead instruction with unknown clock#");
}
- /* TclNewWideObj(objResultPtr, wval); doesn't exist */
objResultPtr = Tcl_NewWideIntObj(wval);
TRACE_WITH_OBJ(("=> "), objResultPtr);
NEXT_INST_F(2, 0, 1);
@@ -8114,9 +7687,7 @@ TEBCresume(
}
iPtr->cmdFramePtr = bcFramePtr->nextPtr;
- if (codePtr->refCount-- <= 1) {
- TclCleanupByteCode(codePtr);
- }
+ TclReleaseByteCode(codePtr);
TclStackFree(interp, TD); /* free my stack */
return result;
@@ -8222,6 +7793,91 @@ FinalizeOONextFilter(
}
/*
+ * WidePwrSmallExpon --
+ *
+ * Helper to calculate small powers of integers whose result is wide.
+ */
+static inline Tcl_WideInt
+WidePwrSmallExpon(Tcl_WideInt w1, long exponent) {
+
+ Tcl_WideInt wResult;
+
+ wResult = w1 * w1; /* b**2 */
+ switch (exponent) {
+ case 2:
+ break;
+ case 3:
+ wResult *= w1; /* b**3 */
+ break;
+ case 4:
+ wResult *= wResult; /* b**4 */
+ break;
+ case 5:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ break;
+ case 6:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ break;
+ case 7:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ break;
+ case 8:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ break;
+ case 9:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ wResult *= w1; /* b**9 */
+ break;
+ case 10:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ wResult *= wResult; /* b**10 */
+ break;
+ case 11:
+ wResult *= wResult; /* b**4 */
+ wResult *= w1; /* b**5 */
+ wResult *= wResult; /* b**10 */
+ wResult *= w1; /* b**11 */
+ break;
+ case 12:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= wResult; /* b**12 */
+ break;
+ case 13:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= wResult; /* b**12 */
+ wResult *= w1; /* b**13 */
+ break;
+ case 14:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ wResult *= wResult; /* b**14 */
+ break;
+ case 15:
+ wResult *= w1; /* b**3 */
+ wResult *= wResult; /* b**6 */
+ wResult *= w1; /* b**7 */
+ wResult *= wResult; /* b**14 */
+ wResult *= w1; /* b**15 */
+ break;
+ case 16:
+ wResult *= wResult; /* b**4 */
+ wResult *= wResult; /* b**8 */
+ wResult *= wResult; /* b**16 */
+ break;
+ }
+ return wResult;
+}
+/*
*----------------------------------------------------------------------
*
* ExecuteExtendedBinaryMathOp, ExecuteExtendedUnaryMathOp --
@@ -8254,19 +7910,11 @@ ExecuteExtendedBinaryMathOp(
Tcl_Obj *valuePtr, /* The first operand on the stack. */
Tcl_Obj *value2Ptr) /* The second operand on the stack. */
{
-#define LONG_RESULT(l) \
- if (Tcl_IsShared(valuePtr)) { \
- TclNewLongObj(objResultPtr, l); \
- return objResultPtr; \
- } else { \
- Tcl_SetLongObj(valuePtr, l); \
- return NULL; \
- }
#define WIDE_RESULT(w) \
if (Tcl_IsShared(valuePtr)) { \
return Tcl_NewWideIntObj(w); \
} else { \
- Tcl_SetWideIntObj(valuePtr, w); \
+ TclSetIntObj(valuePtr, w); \
return NULL; \
}
#define BIG_RESULT(b) \
@@ -8288,11 +7936,10 @@ ExecuteExtendedBinaryMathOp(
int type1, type2;
ClientData ptr1, ptr2;
double d1, d2, dResult;
- long l1, l2, lResult;
Tcl_WideInt w1, w2, wResult;
mp_int big1, big2, bigResult, bigRemainder;
Tcl_Obj *objResultPtr;
- int invalid, numPos, zero;
+ int invalid, zero;
long shift;
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
@@ -8302,13 +7949,13 @@ ExecuteExtendedBinaryMathOp(
case INST_MOD:
/* TODO: Attempts to re-use unshared operands on stack */
- l2 = 0; /* silence gcc warning */
- if (type2 == TCL_NUMBER_LONG) {
- l2 = *((const long *)ptr2);
- if (l2 == 0) {
+ w2 = 0; /* silence gcc warning */
+ if (type2 == TCL_NUMBER_INT) {
+ w2 = *((const Tcl_WideInt *)ptr2);
+ if (w2 == 0) {
return DIVIDED_BY_ZERO;
}
- if ((l2 == 1) || (l2 == -1)) {
+ if ((w2 == 1) || (w2 == -1)) {
/*
* Div. by |1| always yields remainder of 0.
*/
@@ -8316,12 +7963,19 @@ ExecuteExtendedBinaryMathOp(
return constants[0];
}
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type1 == TCL_NUMBER_WIDE) {
+ if (type1 == TCL_NUMBER_INT) {
w1 = *((const Tcl_WideInt *)ptr1);
- if (type2 != TCL_NUMBER_BIG) {
+
+ if (w1 == 0) {
+ /*
+ * 0 % (non-zero) always yields remainder of 0.
+ */
+
+ return constants[0];
+ }
+ if (type2 == TCL_NUMBER_INT) {
Tcl_WideInt wQuotient, wRemainder;
- Tcl_GetWideIntFromObj(NULL, value2Ptr, &w2);
+ w2 = *((const Tcl_WideInt *)ptr2);
wQuotient = w1 / w2;
/*
@@ -8348,7 +8002,7 @@ ExecuteExtendedBinaryMathOp(
* Arguments are opposite sign; remainder is sum.
*/
- TclBNInitBignumFromWideInt(&big1, w1);
+ TclInitBignumFromWideInt(&big1, w1);
mp_add(&big2, &big1, &big2);
mp_clear(&big1);
BIG_RESULT(&big2);
@@ -8361,7 +8015,6 @@ ExecuteExtendedBinaryMathOp(
mp_clear(&big2);
return NULL;
}
-#endif
Tcl_GetBignumFromObj(NULL, valuePtr, &big1);
Tcl_GetBignumFromObj(NULL, value2Ptr, &big2);
mp_init(&bigResult);
@@ -8388,17 +8041,12 @@ ExecuteExtendedBinaryMathOp(
*/
switch (type2) {
- case TCL_NUMBER_LONG:
- invalid = (*((const long *)ptr2) < 0L);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
break;
-#endif
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- invalid = (mp_cmp_d(&big2, 0) == MP_LT);
+ invalid = mp_isneg(&big2);
mp_clear(&big2);
break;
default:
@@ -8415,7 +8063,7 @@ ExecuteExtendedBinaryMathOp(
* Zero shifted any number of bits is still zero.
*/
- if ((type1==TCL_NUMBER_LONG) && (*((const long *)ptr1) == (long)0)) {
+ if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
return constants[0];
}
@@ -8428,8 +8076,8 @@ ExecuteExtendedBinaryMathOp(
* counterparts, leading to incorrect results.
*/
- if ((type2 != TCL_NUMBER_LONG)
- || (*((const long *)ptr2) > (long) INT_MAX)) {
+ if ((type2 != TCL_NUMBER_INT)
+ || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
/*
* Technically, we could hold the value (1 << (INT_MAX+1)) in
* an mp_int, but since we're using mp_mul_2d() to do the
@@ -8441,15 +8089,15 @@ ExecuteExtendedBinaryMathOp(
"integer value too large to represent", -1));
return GENERAL_ARITHMETIC_ERROR;
}
- shift = (int)(*((const long *)ptr2));
+ shift = (int)(*((const Tcl_WideInt *)ptr2));
/*
* Handle shifts within the native wide range.
*/
- if ((type1 != TCL_NUMBER_BIG)
+ if ((type1 == TCL_NUMBER_INT)
&& ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) {
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
+ w1 = *((const Tcl_WideInt *)ptr1);
if (!((w1>0 ? w1 : ~w1)
& -(((Tcl_WideInt)1)
<< (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) {
@@ -8461,8 +8109,8 @@ ExecuteExtendedBinaryMathOp(
* Quickly force large right shifts to 0 or -1.
*/
- if ((type2 != TCL_NUMBER_LONG)
- || (*(const long *)ptr2 > INT_MAX)) {
+ if ((type2 != TCL_NUMBER_INT)
+ || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
/*
* Again, technically, the value to be shifted could be an
* mp_int so huge that a right shift by (INT_MAX+1) bits could
@@ -8472,17 +8120,12 @@ ExecuteExtendedBinaryMathOp(
*/
switch (type1) {
- case TCL_NUMBER_LONG:
- zero = (*(const long *)ptr1 > 0L);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
break;
-#endif
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
- zero = (mp_cmp_d(&big1, 0) == MP_GT);
+ zero = (!mp_isneg(&big1));
mp_clear(&big1);
break;
default:
@@ -8492,26 +8135,24 @@ ExecuteExtendedBinaryMathOp(
if (zero) {
return constants[0];
}
- LONG_RESULT(-1);
+ WIDE_RESULT(-1);
}
- shift = (int)(*(const long *)ptr2);
+ shift = (int)(*(const Tcl_WideInt *)ptr2);
-#ifndef TCL_WIDE_INT_IS_LONG
/*
* Handle shifts within the native wide range.
*/
- if (type1 == TCL_NUMBER_WIDE) {
+ if (type1 == TCL_NUMBER_INT) {
w1 = *(const Tcl_WideInt *)ptr1;
if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
if (w1 >= (Tcl_WideInt)0) {
return constants[0];
}
- LONG_RESULT(-1);
+ WIDE_RESULT(-1);
}
WIDE_RESULT(w1 >> shift);
}
-#endif
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
@@ -8520,16 +8161,7 @@ ExecuteExtendedBinaryMathOp(
if (opcode == INST_LSHIFT) {
mp_mul_2d(&big1, shift, &bigResult);
} else {
- mp_init(&bigRemainder);
- mp_div_2d(&big1, shift, &bigResult, &bigRemainder);
- if (mp_cmp_d(&bigRemainder, 0) == MP_LT) {
- /*
- * Convert to Tcl's integer division rules.
- */
-
- mp_sub_d(&bigResult, 1, &bigResult);
- }
- mp_clear(&bigRemainder);
+ mp_tc_div_2d(&big1, shift, &bigResult);
}
mp_clear(&big1);
BIG_RESULT(&bigResult);
@@ -8538,139 +8170,23 @@ ExecuteExtendedBinaryMathOp(
case INST_BITOR:
case INST_BITXOR:
case INST_BITAND:
- if ((type1 == TCL_NUMBER_BIG) || (type2 == TCL_NUMBER_BIG)) {
- mp_int *First, *Second;
-
+ if ((type1 != TCL_NUMBER_INT) || (type2 != TCL_NUMBER_INT)) {
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- /*
- * Count how many positive arguments we have. If only one of the
- * arguments is negative, store it in 'Second'.
- */
-
- if (mp_cmp_d(&big1, 0) != MP_LT) {
- numPos = 1 + (mp_cmp_d(&big2, 0) != MP_LT);
- First = &big1;
- Second = &big2;
- } else {
- First = &big2;
- Second = &big1;
- numPos = (mp_cmp_d(First, 0) != MP_LT);
- }
mp_init(&bigResult);
switch (opcode) {
case INST_BITAND:
- switch (numPos) {
- case 2:
- /*
- * Both arguments positive, base case.
- */
-
- mp_and(First, Second, &bigResult);
- break;
- case 1:
- /*
- * First is positive; second negative:
- * P & N = P & ~~N = P&~(-N-1) = P & (P ^ (-N-1))
- */
-
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- mp_and(First, &bigResult, &bigResult);
- break;
- case 0:
- /*
- * Both arguments negative:
- * a & b = ~ (~a | ~b) = -(-a-1|-b-1)-1
- */
-
- mp_neg(First, First);
- mp_sub_d(First, 1, First);
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_or(First, Second, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- }
+ mp_tc_and(&big1, &big2, &bigResult);
break;
case INST_BITOR:
- switch (numPos) {
- case 2:
- /*
- * Both arguments positive, base case.
- */
-
- mp_or(First, Second, &bigResult);
- break;
- case 1:
- /*
- * First is positive; second negative:
- * N|P = ~(~N&~P) = ~((-N-1)&~P) = -((-N-1)&((-N-1)^P))-1
- */
-
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- mp_and(Second, &bigResult, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- case 0:
- /*
- * Both arguments negative:
- * a | b = ~ (~a & ~b) = -(-a-1&-b-1)-1
- */
-
- mp_neg(First, First);
- mp_sub_d(First, 1, First);
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_and(First, Second, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- }
+ mp_tc_or(&big1, &big2, &bigResult);
break;
case INST_BITXOR:
- switch (numPos) {
- case 2:
- /*
- * Both arguments positive, base case.
- */
-
- mp_xor(First, Second, &bigResult);
- break;
- case 1:
- /*
- * First is positive; second negative:
- * P^N = ~(P^~N) = -(P^(-N-1))-1
- */
-
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- mp_neg(&bigResult, &bigResult);
- mp_sub_d(&bigResult, 1, &bigResult);
- break;
- case 0:
- /*
- * Both arguments negative:
- * a ^ b = (~a ^ ~b) = (-a-1^-b-1)
- */
-
- mp_neg(First, First);
- mp_sub_d(First, 1, First);
- mp_neg(Second, Second);
- mp_sub_d(Second, 1, Second);
- mp_xor(First, Second, &bigResult);
- break;
- }
+ mp_tc_xor(&big1, &big2, &bigResult);
break;
}
@@ -8679,46 +8195,24 @@ ExecuteExtendedBinaryMathOp(
BIG_RESULT(&bigResult);
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
- TclGetWideIntFromObj(NULL, value2Ptr, &w2);
-
- switch (opcode) {
- case INST_BITAND:
- wResult = w1 & w2;
- break;
- case INST_BITOR:
- wResult = w1 | w2;
- break;
- case INST_BITXOR:
- wResult = w1 ^ w2;
- break;
- default:
- /* Unused, here to silence compiler warning. */
- wResult = 0;
- }
- WIDE_RESULT(wResult);
- }
-#endif
- l1 = *((const long *)ptr1);
- l2 = *((const long *)ptr2);
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (opcode) {
case INST_BITAND:
- lResult = l1 & l2;
+ wResult = w1 & w2;
break;
case INST_BITOR:
- lResult = l1 | l2;
+ wResult = w1 | w2;
break;
case INST_BITXOR:
- lResult = l1 ^ l2;
+ wResult = w1 ^ w2;
break;
default:
/* Unused, here to silence compiler warning. */
- lResult = 0;
+ wResult = 0;
}
- LONG_RESULT(lResult);
+ WIDE_RESULT(wResult);
case INST_EXPON: {
int oddExponent = 0, negativeExponent = 0;
@@ -8734,51 +8228,38 @@ ExecuteExtendedBinaryMathOp(
dResult = pow(d1, d2);
goto doubleResult;
}
- l1 = l2 = 0;
- if (type2 == TCL_NUMBER_LONG) {
- l2 = *((const long *) ptr2);
- if (l2 == 0) {
+ w1 = w2 = 0; /* to silence compiler warning (maybe-uninitialized) */
+ if (type2 == TCL_NUMBER_INT) {
+ w2 = *((const Tcl_WideInt *) ptr2);
+ if (w2 == 0) {
/*
* Anything to the zero power is 1.
*/
return constants[1];
- } else if (l2 == 1) {
+ } else if (w2 == 1) {
/*
* Anything to the first power is itself
*/
return NULL;
}
- }
- switch (type2) {
- case TCL_NUMBER_LONG:
- negativeExponent = (l2 < 0);
- oddExponent = (int) (l2 & 1);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
- w2 = *((const Tcl_WideInt *)ptr2);
negativeExponent = (w2 < 0);
oddExponent = (int) (w2 & (Tcl_WideInt)1);
- break;
-#endif
- case TCL_NUMBER_BIG:
+ } else {
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- negativeExponent = (mp_cmp_d(&big2, 0) == MP_LT);
+ negativeExponent = mp_isneg(&big2);
mp_mod_2d(&big2, 1, &big2);
oddExponent = !mp_iszero(&big2);
mp_clear(&big2);
- break;
}
- if (type1 == TCL_NUMBER_LONG) {
- l1 = *((const long *)ptr1);
- }
- if (negativeExponent) {
- if (type1 == TCL_NUMBER_LONG) {
- switch (l1) {
+ if (type1 == TCL_NUMBER_INT) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+
+ if (negativeExponent) {
+ switch (w1) {
case 0:
/*
* Zero to a negative power is div by zero error.
@@ -8787,7 +8268,7 @@ ExecuteExtendedBinaryMathOp(
return EXPONENT_OF_ZERO;
case -1:
if (oddExponent) {
- LONG_RESULT(-1);
+ WIDE_RESULT(-1);
}
/* fallthrough */
case 1:
@@ -8798,17 +8279,21 @@ ExecuteExtendedBinaryMathOp(
return constants[1];
}
}
+ }
+ if (negativeExponent) {
/*
* Integers with magnitude greater than 1 raise to a negative
* power yield the answer zero (see TIP 123).
*/
-
return constants[0];
}
- if (type1 == TCL_NUMBER_LONG) {
- switch (l1) {
+ if (type1 != TCL_NUMBER_INT) {
+ goto overflowExpon;
+ }
+
+ switch (w1) {
case 0:
/*
* Zero to a positive power is zero.
@@ -8825,8 +8310,7 @@ ExecuteExtendedBinaryMathOp(
if (!oddExponent) {
return constants[1];
}
- LONG_RESULT(-1);
- }
+ WIDE_RESULT(-1);
}
/*
@@ -8834,208 +8318,49 @@ ExecuteExtendedBinaryMathOp(
* which means the max exponent value is 2**28-1 = 0x0fffffff =
* 268435455, which fits into a signed 32 bit int which is within the
* range of the long int type. This means any numeric Tcl_Obj value
- * not using TCL_NUMBER_LONG type must hold a value larger than we
+ * not using TCL_NUMBER_INT type must hold a value larger than we
* accept.
*/
- if (type2 != TCL_NUMBER_LONG) {
+ if (type2 != TCL_NUMBER_INT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"exponent too large", -1));
return GENERAL_ARITHMETIC_ERROR;
}
- if (type1 == TCL_NUMBER_LONG) {
- if (l1 == 2) {
- /*
- * Reduce small powers of 2 to shifts.
- */
-
- if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
- LONG_RESULT(1L << l2);
- }
-#if !defined(TCL_WIDE_INT_IS_LONG)
- if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
- WIDE_RESULT(((Tcl_WideInt) 1) << l2);
- }
-#endif
- goto overflowExpon;
- }
- if (l1 == -2) {
- int signum = oddExponent ? -1 : 1;
+ /* From here (up to overflowExpon) w1 and exponent w2 are wide-int's. */
+ assert(type1 == TCL_NUMBER_INT && type2 == TCL_NUMBER_INT);
- /*
- * Reduce small powers of 2 to shifts.
- */
+ if (w1 == 2) {
+ /*
+ * Reduce small powers of 2 to shifts.
+ */
- if ((unsigned long) l2 < CHAR_BIT * sizeof(long) - 1) {
- LONG_RESULT(signum * (1L << l2));
- }
-#if !defined(TCL_WIDE_INT_IS_LONG)
- if ((unsigned long)l2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
- WIDE_RESULT(signum * (((Tcl_WideInt) 1) << l2));
- }
-#endif
- goto overflowExpon;
+ if ((Tcl_WideUInt) w2 < (Tcl_WideUInt) CHAR_BIT*sizeof(Tcl_WideInt) - 1) {
+ WIDE_RESULT(((Tcl_WideInt) 1) << (int)w2);
}
-#if (LONG_MAX == 0x7fffffff)
- if (l2 - 2 < (long)MaxBase32Size
- && l1 <= MaxBase32[l2 - 2]
- && l1 >= -MaxBase32[l2 - 2]) {
- /*
- * Small powers of 32-bit integers.
- */
-
- lResult = l1 * l1; /* b**2 */
- switch (l2) {
- case 2:
- break;
- case 3:
- lResult *= l1; /* b**3 */
- break;
- case 4:
- lResult *= lResult; /* b**4 */
- break;
- case 5:
- lResult *= lResult; /* b**4 */
- lResult *= l1; /* b**5 */
- break;
- case 6:
- lResult *= l1; /* b**3 */
- lResult *= lResult; /* b**6 */
- break;
- case 7:
- lResult *= l1; /* b**3 */
- lResult *= lResult; /* b**6 */
- lResult *= l1; /* b**7 */
- break;
- case 8:
- lResult *= lResult; /* b**4 */
- lResult *= lResult; /* b**8 */
- break;
- }
- LONG_RESULT(lResult);
- }
-
- if (l1 - 3 >= 0 && l1 -2 < (long)Exp32IndexSize
- && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
- base = Exp32Index[l1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase32Size);
- if (base < Exp32Index[l1 - 2]) {
- /*
- * 32-bit number raised to intermediate power, done by
- * table lookup.
- */
+ goto overflowExpon;
+ }
+ if (w1 == -2) {
+ int signum = oddExponent ? -1 : 1;
- LONG_RESULT(Exp32Value[base]);
- }
- }
- if (-l1 - 3 >= 0 && -l1 - 2 < (long)Exp32IndexSize
- && l2 - 2 < (long)(Exp32ValueSize + MaxBase32Size)) {
- base = Exp32Index[-l1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase32Size);
- if (base < Exp32Index[-l1 - 2]) {
- /*
- * 32-bit number raised to intermediate power, done by
- * table lookup.
- */
+ /*
+ * Reduce small powers of 2 to shifts.
+ */
- lResult = (oddExponent) ?
- -Exp32Value[base] : Exp32Value[base];
- LONG_RESULT(lResult);
- }
+ if ((Tcl_WideUInt)w2 < CHAR_BIT*sizeof(Tcl_WideInt) - 1){
+ WIDE_RESULT(signum * (((Tcl_WideInt) 1) << (int) w2));
}
-#endif
- }
-#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
- if (type1 == TCL_NUMBER_LONG) {
- w1 = l1;
-#ifndef TCL_WIDE_INT_IS_LONG
- } else if (type1 == TCL_NUMBER_WIDE) {
- w1 = *((const Tcl_WideInt *) ptr1);
-#endif
- } else {
goto overflowExpon;
}
- if (l2 - 2 < (long)MaxBase64Size
- && w1 <= MaxBase64[l2 - 2]
- && w1 >= -MaxBase64[l2 - 2]) {
+ if (w2 - 2 < (long)MaxBase64Size
+ && w1 <= MaxBase64[w2 - 2]
+ && w1 >= -MaxBase64[w2 - 2]) {
/*
* Small powers of integers whose result is wide.
*/
+ wResult = WidePwrSmallExpon(w1, (long)w2);
- wResult = w1 * w1; /* b**2 */
- switch (l2) {
- case 2:
- break;
- case 3:
- wResult *= l1; /* b**3 */
- break;
- case 4:
- wResult *= wResult; /* b**4 */
- break;
- case 5:
- wResult *= wResult; /* b**4 */
- wResult *= w1; /* b**5 */
- break;
- case 6:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- break;
- case 7:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= w1; /* b**7 */
- break;
- case 8:
- wResult *= wResult; /* b**4 */
- wResult *= wResult; /* b**8 */
- break;
- case 9:
- wResult *= wResult; /* b**4 */
- wResult *= wResult; /* b**8 */
- wResult *= w1; /* b**9 */
- break;
- case 10:
- wResult *= wResult; /* b**4 */
- wResult *= w1; /* b**5 */
- wResult *= wResult; /* b**10 */
- break;
- case 11:
- wResult *= wResult; /* b**4 */
- wResult *= w1; /* b**5 */
- wResult *= wResult; /* b**10 */
- wResult *= w1; /* b**11 */
- break;
- case 12:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= wResult; /* b**12 */
- break;
- case 13:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= wResult; /* b**12 */
- wResult *= w1; /* b**13 */
- break;
- case 14:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= w1; /* b**7 */
- wResult *= wResult; /* b**14 */
- break;
- case 15:
- wResult *= w1; /* b**3 */
- wResult *= wResult; /* b**6 */
- wResult *= w1; /* b**7 */
- wResult *= wResult; /* b**14 */
- wResult *= w1; /* b**15 */
- break;
- case 16:
- wResult *= wResult; /* b**4 */
- wResult *= wResult; /* b**8 */
- wResult *= wResult; /* b**16 */
- break;
- }
WIDE_RESULT(wResult);
}
@@ -9045,9 +8370,9 @@ ExecuteExtendedBinaryMathOp(
*/
if (w1 - 3 >= 0 && w1 - 2 < (long)Exp64IndexSize
- && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+ && w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
base = Exp64Index[w1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase64Size);
+ + (unsigned short) (w2 - 2 - MaxBase64Size);
if (base < Exp64Index[w1 - 2]) {
/*
* 64-bit number raised to intermediate power, done by
@@ -9059,9 +8384,9 @@ ExecuteExtendedBinaryMathOp(
}
if (-w1 - 3 >= 0 && -w1 - 2 < (long)Exp64IndexSize
- && l2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
+ && w2 - 2 < (long)(Exp64ValueSize + MaxBase64Size)) {
base = Exp64Index[-w1 - 3]
- + (unsigned short) (l2 - 2 - MaxBase64Size);
+ + (unsigned short) (w2 - 2 - MaxBase64Size);
if (base < Exp64Index[-w1 - 2]) {
/*
* 64-bit number raised to intermediate power, done by
@@ -9072,7 +8397,6 @@ ExecuteExtendedBinaryMathOp(
WIDE_RESULT(wResult);
}
}
-#endif
overflowExpon:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
@@ -9084,7 +8408,7 @@ ExecuteExtendedBinaryMathOp(
}
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
mp_init(&bigResult);
- mp_expt_d(&big1, big2.dp[0], &bigResult);
+ mp_expt_d_ex(&big1, big2.dp[0], &bigResult, 1);
mp_clear(&big1);
mp_clear(&big2);
BIG_RESULT(&bigResult);
@@ -9145,16 +8469,14 @@ ExecuteExtendedBinaryMathOp(
#endif
DOUBLE_RESULT(dResult);
}
- if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
- TclGetWideIntFromObj(NULL, valuePtr, &w1);
- TclGetWideIntFromObj(NULL, value2Ptr, &w2);
+ if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
+ w1 = *((const Tcl_WideInt *)ptr1);
+ w2 = *((const Tcl_WideInt *)ptr2);
switch (opcode) {
case INST_ADD:
wResult = w1 + w2;
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
+ if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Check for overflow.
@@ -9168,9 +8490,7 @@ ExecuteExtendedBinaryMathOp(
case INST_SUB:
wResult = w1 - w2;
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
-#endif
+ if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
{
/*
* Must check for overflow. The macro tests for overflows
@@ -9190,8 +8510,7 @@ ExecuteExtendedBinaryMathOp(
break;
case INST_MULT:
- if ((type1 != TCL_NUMBER_LONG) || (type2 != TCL_NUMBER_LONG)
- || (sizeof(Tcl_WideInt) < 2*sizeof(long))) {
+ if ((w1 < INT_MIN) || (w1 > INT_MAX) || (w2 < INT_MIN) || (w2 > INT_MAX)) {
goto overflowBasic;
}
wResult = w1 * w2;
@@ -9203,10 +8522,10 @@ ExecuteExtendedBinaryMathOp(
}
/*
- * Need a bignum to represent (LLONG_MIN / -1)
+ * Need a bignum to represent (WIDE_MIN / -1)
*/
- if ((w1 == LLONG_MIN) && (w2 == -1)) {
+ if ((w1 == WIDE_MIN) && (w2 == -1)) {
goto overflowBasic;
}
wResult = w1 / w2;
@@ -9294,12 +8613,10 @@ ExecuteExtendedUnaryMathOp(
switch (opcode) {
case INST_BITNOT:
-#ifndef TCL_WIDE_INT_IS_LONG
- if (type == TCL_NUMBER_WIDE) {
+ if (type == TCL_NUMBER_INT) {
w = *((const Tcl_WideInt *) ptr);
WIDE_RESULT(~w);
}
-#endif
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
/* ~a = - a - 1 */
mp_neg(&big, &big);
@@ -9309,22 +8626,13 @@ ExecuteExtendedUnaryMathOp(
switch (type) {
case TCL_NUMBER_DOUBLE:
DOUBLE_RESULT(-(*((const double *) ptr)));
- case TCL_NUMBER_LONG:
- w = (Tcl_WideInt) (*((const long *) ptr));
- if (w != LLONG_MIN) {
- WIDE_RESULT(-w);
- }
- TclBNInitBignumFromLong(&big, *(const long *) ptr);
- break;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
w = *((const Tcl_WideInt *) ptr);
- if (w != LLONG_MIN) {
+ if (w != WIDE_MIN) {
WIDE_RESULT(-w);
}
- TclBNInitBignumFromWideInt(&big, w);
+ TclInitBignumFromWideInt(&big, w);
break;
-#endif
default:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big);
}
@@ -9335,7 +8643,6 @@ ExecuteExtendedUnaryMathOp(
Tcl_Panic("unexpected opcode");
return NULL;
}
-#undef LONG_RESULT
#undef WIDE_RESULT
#undef BIG_RESULT
#undef DOUBLE_RESULT
@@ -9367,31 +8674,22 @@ TclCompareTwoNumbers(
ClientData ptr1, ptr2;
mp_int big1, big2;
double d1, d2, tmp;
- long l1, l2;
-#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w1, w2;
-#endif
(void) GetNumberFromObj(NULL, valuePtr, &ptr1, &type1);
(void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
switch (type1) {
- case TCL_NUMBER_LONG:
- l1 = *((const long *)ptr1);
+ case TCL_NUMBER_INT:
+ w1 = *((const Tcl_WideInt *)ptr1);
switch (type2) {
- case TCL_NUMBER_LONG:
- l2 = *((const long *)ptr2);
- longCompare:
- return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
- w1 = (Tcl_WideInt)l1;
- goto wideCompare;
-#endif
+ wideCompare:
+ return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
case TCL_NUMBER_DOUBLE:
d2 = *((const double *)ptr2);
- d1 = (double) l1;
+ d1 = (double) w1;
/*
* If the double has a fractional part, or if the long can be
@@ -9399,7 +8697,7 @@ TclCompareTwoNumbers(
* doubles.
*/
- if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l1 == (long) d1
+ if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt) || w1 == (Tcl_WideInt) d1
|| modf(d2, &tmp) != 0.0) {
goto doubleCompare;
}
@@ -9416,55 +8714,17 @@ TclCompareTwoNumbers(
* integer comparison can tell the difference.
*/
- if (d2 < (double)LONG_MIN) {
- return MP_GT;
- }
- if (d2 > (double)LONG_MAX) {
- return MP_LT;
- }
- l2 = (long) d2;
- goto longCompare;
- case TCL_NUMBER_BIG:
- Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if (mp_cmp_d(&big2, 0) == MP_LT) {
- compare = MP_GT;
- } else {
- compare = MP_LT;
- }
- mp_clear(&big2);
- return compare;
- }
-
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
- w1 = *((const Tcl_WideInt *)ptr1);
- switch (type2) {
- case TCL_NUMBER_WIDE:
- w2 = *((const Tcl_WideInt *)ptr2);
- wideCompare:
- return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
- case TCL_NUMBER_LONG:
- l2 = *((const long *)ptr2);
- w2 = (Tcl_WideInt)l2;
- goto wideCompare;
- case TCL_NUMBER_DOUBLE:
- d2 = *((const double *)ptr2);
- d1 = (double) w1;
- if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
- || w1 == (Tcl_WideInt) d1 || modf(d2, &tmp) != 0.0) {
- goto doubleCompare;
- }
- if (d2 < (double)LLONG_MIN) {
+ if (d2 < (double)WIDE_MIN) {
return MP_GT;
}
- if (d2 > (double)LLONG_MAX) {
+ if (d2 > (double)WIDE_MAX) {
return MP_LT;
}
w2 = (Tcl_WideInt) d2;
goto wideCompare;
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if (mp_cmp_d(&big2, 0) == MP_LT) {
+ if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
compare = MP_LT;
@@ -9472,7 +8732,6 @@ TclCompareTwoNumbers(
mp_clear(&big2);
return compare;
}
-#endif
case TCL_NUMBER_DOUBLE:
d1 = *((const double *)ptr1);
@@ -9481,45 +8740,28 @@ TclCompareTwoNumbers(
d2 = *((const double *)ptr2);
doubleCompare:
return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
- case TCL_NUMBER_LONG:
- l2 = *((const long *)ptr2);
- d2 = (double) l2;
- if (DBL_MANT_DIG > CHAR_BIT*sizeof(long) || l2 == (long) d2
- || modf(d1, &tmp) != 0.0) {
- goto doubleCompare;
- }
- if (d1 < (double)LONG_MIN) {
- return MP_LT;
- }
- if (d1 > (double)LONG_MAX) {
- return MP_GT;
- }
- l1 = (long) d1;
- goto longCompare;
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
+ case TCL_NUMBER_INT:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
|| w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
goto doubleCompare;
}
- if (d1 < (double)LLONG_MIN) {
+ if (d1 < (double)WIDE_MIN) {
return MP_LT;
}
- if (d1 > (double)LLONG_MAX) {
+ if (d1 > (double)WIDE_MAX) {
return MP_GT;
}
w1 = (Tcl_WideInt) d1;
goto wideCompare;
-#endif
case TCL_NUMBER_BIG:
if (TclIsInfinite(d1)) {
return (d1 > 0.0) ? MP_GT : MP_LT;
}
Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
- if ((d1 < (double)LONG_MAX) && (d1 > (double)LONG_MIN)) {
- if (mp_cmp_d(&big2, 0) == MP_LT) {
+ if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
+ if (mp_isneg(&big2)) {
compare = MP_GT;
} else {
compare = MP_LT;
@@ -9540,10 +8782,7 @@ TclCompareTwoNumbers(
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
switch (type2) {
-#ifndef TCL_WIDE_INT_IS_LONG
- case TCL_NUMBER_WIDE:
-#endif
- case TCL_NUMBER_LONG:
+ case TCL_NUMBER_INT:
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
@@ -9554,7 +8793,7 @@ TclCompareTwoNumbers(
mp_clear(&big1);
return compare;
}
- if ((d2 < (double)LONG_MAX) && (d2 > (double)LONG_MIN)) {
+ if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
compare = mp_cmp_d(&big1, 0);
mp_clear(&big1);
return compare;
@@ -9608,8 +8847,8 @@ PrintByteCodeInfo(
Proc *procPtr = codePtr->procPtr;
Interp *iPtr = (Interp *) *codePtr->interpHandle;
- fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %u, epoch %u, interp 0x%p (epoch %u)\n",
- codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr,
+ fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %u, interp 0x%p (epoch %u)\n",
+ codePtr, (size_t)codePtr->refCount, codePtr->compileEpoch, iPtr,
iPtr->compileEpoch);
fprintf(stdout, " Source: ");
@@ -9707,7 +8946,7 @@ ValidatePcAndStackTop(
TclNewLiteralStringObj(message, "\n executing ");
Tcl_IncrRefCount(message);
Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL);
- fprintf(stderr,"%s\n", Tcl_GetString(message));
+ fprintf(stderr,"%s\n", TclGetString(message));
Tcl_DecrRefCount(message);
} else {
fprintf(stderr, "\n");
@@ -9757,7 +8996,7 @@ IllegalExprOperandType(
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
int numBytes;
- const char *bytes = Tcl_GetStringFromObj(opndPtr, &numBytes);
+ const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
if (numBytes == 0) {
description = "empty string";
@@ -10170,7 +9409,7 @@ TclExprFloatError(
"unknown floating-point error, errno = %d", errno);
Tcl_SetErrorCode(interp, "ARITH", "UNKNOWN",
- Tcl_GetString(objPtr), NULL);
+ TclGetString(objPtr), NULL);
Tcl_SetObjResult(interp, objPtr);
}
}
@@ -10383,10 +9622,10 @@ EvalStatsCmd(
for (i = 0; i < globalTablePtr->numBuckets; i++) {
for (entryPtr = globalTablePtr->buckets[i]; entryPtr != NULL;
entryPtr = entryPtr->nextPtr) {
- if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
+ if (TclHasIntRep(entryPtr->objPtr, &tclByteCodeType)) {
numByteCodeLits++;
}
- (void) Tcl_GetStringFromObj(entryPtr->objPtr, &length);
+ (void) TclGetStringFromObj(entryPtr->objPtr, &length);
refCountSum += entryPtr->refCount;
objBytesIfUnshared += (entryPtr->refCount * sizeof(Tcl_Obj));
strBytesIfUnshared += (entryPtr->refCount * (length+1));
@@ -10608,7 +9847,7 @@ EvalStatsCmd(
Tcl_SetObjResult(interp, objPtr);
} else {
Tcl_Channel outChan;
- char *str = Tcl_GetStringFromObj(objv[1], &length);
+ char *str = TclGetStringFromObj(objv[1], &length);
if (length) {
if (strcmp(str, "stdout") == 0) {
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 99372c5..a4dded2 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -1085,12 +1085,9 @@ TclFileAttrsCmd(
}
if (Tcl_GetIndexFromObj(interp, objv[0], attributeStrings,
- "option", 0, &index) != TCL_OK) {
+ "option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
- if (attributeStringsAllocated != NULL) {
- TclFreeIntRep(objv[0]);
- }
if (Tcl_FSFileAttrsGet(interp, index, filePtr,
&objPtr) != TCL_OK) {
goto end;
@@ -1113,12 +1110,9 @@ TclFileAttrsCmd(
for (i = 0; i < objc ; i += 2) {
if (Tcl_GetIndexFromObj(interp, objv[i], attributeStrings,
- "option", 0, &index) != TCL_OK) {
+ "option", INDEX_TEMP_TABLE, &index) != TCL_OK) {
goto end;
}
- if (attributeStringsAllocated != NULL) {
- TclFreeIntRep(objv[i]);
- }
if (i + 1 == objc) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"value for \"%s\" missing", TclGetString(objv[i])));
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 7afcdaf..7dba19c 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -387,7 +387,7 @@ TclpGetNativePathType(
{
Tcl_PathType type = TCL_PATH_ABSOLUTE;
int pathLen;
- const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ const char *path = TclGetStringFromObj(pathPtr, &pathLen);
if (path[0] == '~') {
/*
@@ -578,7 +578,7 @@ Tcl_SplitPath(
size = 1;
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
- Tcl_GetStringFromObj(eltPtr, &len);
+ TclGetStringFromObj(eltPtr, &len);
size += len + 1;
}
@@ -597,7 +597,7 @@ Tcl_SplitPath(
p = (char *) &(*argvPtr)[(*argcPtr) + 1];
for (i = 0; i < *argcPtr; i++) {
Tcl_ListObjIndex(NULL, resultPtr, i, &eltPtr);
- str = Tcl_GetStringFromObj(eltPtr, &len);
+ str = TclGetStringFromObj(eltPtr, &len);
memcpy(p, str, (size_t) len+1);
p += len+1;
}
@@ -857,7 +857,7 @@ TclpNativeJoinPath(
const char *p;
const char *start;
- start = Tcl_GetStringFromObj(prefix, &length);
+ start = TclGetStringFromObj(prefix, &length);
/*
* Remove the ./ from tilde prefixed elements, and drive-letter prefixed
@@ -885,7 +885,7 @@ TclpNativeJoinPath(
if (length > 0 && (start[length-1] != '/')) {
Tcl_AppendToObj(prefix, "/", 1);
- Tcl_GetStringFromObj(prefix, &length);
+ TclGetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -921,7 +921,7 @@ TclpNativeJoinPath(
if ((length > 0) &&
(start[length-1] != '/') && (start[length-1] != ':')) {
Tcl_AppendToObj(prefix, "/", 1);
- Tcl_GetStringFromObj(prefix, &length);
+ TclGetStringFromObj(prefix, &length);
}
needsSep = 0;
@@ -1003,7 +1003,7 @@ Tcl_JoinPath(
* Store the result.
*/
- resultStr = Tcl_GetStringFromObj(resultObj, &len);
+ resultStr = TclGetStringFromObj(resultObj, &len);
Tcl_DStringAppend(resultPtr, resultStr, len);
Tcl_DecrRefCount(resultObj);
@@ -1249,7 +1249,7 @@ Tcl_GlobObjCmd(
for (i = 1; i < objc; i++) {
if (Tcl_GetIndexFromObj(interp, objv[i], options, "option", 0,
&index) != TCL_OK) {
- string = Tcl_GetStringFromObj(objv[i], &length);
+ string = TclGetStringFromObj(objv[i], &length);
if (string[0] == '-') {
/*
* It looks like the command contains an option so signal an
@@ -1357,7 +1357,7 @@ Tcl_GlobObjCmd(
if (dir == PATH_GENERAL) {
int pathlength;
const char *last;
- const char *first = Tcl_GetStringFromObj(pathOrDir,&pathlength);
+ const char *first = TclGetStringFromObj(pathOrDir,&pathlength);
/*
* Find the last path separator in the path
@@ -1460,7 +1460,7 @@ Tcl_GlobObjCmd(
const char *str;
Tcl_ListObjIndex(interp, typePtr, length, &look);
- str = Tcl_GetStringFromObj(look, &len);
+ str = TclGetStringFromObj(look, &len);
if (strcmp("readonly", str) == 0) {
globTypes->perm |= TCL_GLOB_PERM_RONLY;
} else if (strcmp("hidden", str) == 0) {
@@ -1881,7 +1881,7 @@ TclGlob(
separators = "/\\";
} else if (tclPlatform == TCL_PLATFORM_UNIX) {
- if (pathPrefix == NULL && tail[0] == '/') {
+ if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
pathPrefix = Tcl_NewStringObj(tail, 1);
tail++;
Tcl_IncrRefCount(pathPrefix);
@@ -1992,7 +1992,7 @@ TclGlob(
Tcl_Panic("Called TclGlob with TCL_GLOBMODE_TAILS and pathPrefix==NULL");
}
- pre = Tcl_GetStringFromObj(pathPrefix, &prefixLen);
+ pre = TclGetStringFromObj(pathPrefix, &prefixLen);
if (prefixLen > 0
&& (strchr(separators, pre[prefixLen-1]) == NULL)) {
/*
@@ -2010,7 +2010,7 @@ TclGlob(
Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv);
for (i = 0; i< objc; i++) {
int len;
- const char *oldStr = Tcl_GetStringFromObj(objv[i], &len);
+ const char *oldStr = TclGetStringFromObj(objv[i], &len);
Tcl_Obj *elem;
if (len == prefixLen) {
@@ -2362,7 +2362,7 @@ DoGlob(
Tcl_Obj *fixme, *newObj;
Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
- bytes = Tcl_GetStringFromObj(fixme, &numBytes);
+ bytes = TclGetStringFromObj(fixme, &numBytes);
newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
1, &newObj);
@@ -2400,7 +2400,7 @@ DoGlob(
Tcl_DStringAppend(&append, pattern, p-pattern);
if (pathPtr != NULL) {
- (void) Tcl_GetStringFromObj(pathPtr, &length);
+ (void) TclGetStringFromObj(pathPtr, &length);
} else {
length = 0;
}
@@ -2446,7 +2446,7 @@ DoGlob(
*/
int len;
- const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+ const char *joined = TclGetStringFromObj(joinedPtr,&len);
if (strchr(separators, joined[len-1]) == NULL) {
Tcl_AppendToObj(joinedPtr, "/", 1);
@@ -2483,7 +2483,7 @@ DoGlob(
*/
int len;
- const char *joined = Tcl_GetStringFromObj(joinedPtr,&len);
+ const char *joined = TclGetStringFromObj(joinedPtr,&len);
if (strchr(separators, joined[len-1]) == NULL) {
if (Tcl_FSGetPathType(pathPtr) != TCL_PATH_VOLUME_RELATIVE) {
diff --git a/generic/tclGet.c b/generic/tclGet.c
index 97e8c7b..12e0e79 100644
--- a/generic/tclGet.c
+++ b/generic/tclGet.c
@@ -142,7 +142,7 @@ Tcl_GetBoolean(
Tcl_Panic("invalid sharing of Tcl_Obj on C stack");
}
if (code == TCL_OK) {
- *boolPtr = obj.internalRep.longValue;
+ TclGetBooleanFromObj(NULL, &obj, boolPtr);
}
return code;
}
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index ce7c2ce..59f85bd 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -897,7 +897,7 @@ TclDatelex(
location->first_column = yyInput - info->dateStart;
for ( ; ; ) {
- while (TclIsSpaceProc(*yyInput)) {
+ while (TclIsSpaceProc(UCHAR(*yyInput))) {
yyInput++;
}
@@ -960,7 +960,7 @@ TclDatelex(
int
TclClockOldscanObjCmd(
- ClientData clientData, /* Unused */
+ void *clientData, /* Unused */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Count of paraneters */
Tcl_Obj *const *objv) /* Parameters */
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 7e8961d..32c9aec 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -43,20 +43,7 @@
static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
-static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
-
-/*
- * Prototypes for the one word hash key methods. Not actually declared because
- * this is a critical path that is implemented in the core hash table access
- * function.
- */
-
-#if 0
-static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr,
- void *keyPtr);
-static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
-static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
-#endif
+static TCL_HASH_TYPE HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the string hash key methods.
@@ -65,7 +52,7 @@ static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr,
void *keyPtr);
static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
-static unsigned int HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
+static TCL_HASH_TYPE HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Function prototypes for static functions in this file:
@@ -321,11 +308,9 @@ CreateHashEntry(
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
if (hash != PTR2UINT(hPtr->hash)) {
continue;
}
-#endif
if (((void *) key == hPtr) || compareKeysProc((void *) key, hPtr)) {
if (newPtr) {
*newPtr = 0;
@@ -336,11 +321,9 @@ CreateHashEntry(
} else {
for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
hPtr = hPtr->nextPtr) {
-#if TCL_HASH_KEY_STORE_HASH
if (hash != PTR2UINT(hPtr->hash)) {
continue;
}
-#endif
if (key == hPtr->key.oneWordValue) {
if (newPtr) {
*newPtr = 0;
@@ -368,15 +351,9 @@ CreateHashEntry(
}
hPtr->tablePtr = tablePtr;
-#if TCL_HASH_KEY_STORE_HASH
hPtr->hash = UINT2PTR(hash);
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
-#else
- hPtr->bucketPtr = &tablePtr->buckets[index];
- hPtr->nextPtr = *hPtr->bucketPtr;
- *hPtr->bucketPtr = hPtr;
-#endif
tablePtr->numEntries++;
/*
@@ -416,9 +393,7 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
-#if TCL_HASH_KEY_STORE_HASH
int index;
-#endif
tablePtr = entryPtr->tablePtr;
@@ -433,7 +408,6 @@ Tcl_DeleteHashEntry(
typePtr = &tclArrayHashKeyType;
}
-#if TCL_HASH_KEY_STORE_HASH
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
@@ -442,9 +416,6 @@ Tcl_DeleteHashEntry(
}
bucketPtr = &tablePtr->buckets[index];
-#else
- bucketPtr = entryPtr->bucketPtr;
-#endif
if (*bucketPtr == entryPtr) {
*bucketPtr = entryPtr->nextPtr;
@@ -790,7 +761,7 @@ CompareArrayKeys(
*----------------------------------------------------------------------
*/
-static unsigned int
+static TCL_HASH_TYPE
HashArrayKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
@@ -803,7 +774,7 @@ HashArrayKey(
count--, array++) {
result += *array;
}
- return result;
+ return (TCL_HASH_TYPE) result;
}
/*
@@ -886,7 +857,7 @@ CompareStringKeys(
*----------------------------------------------------------------------
*/
-static unsigned
+static TCL_HASH_TYPE
HashStringKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
@@ -932,7 +903,7 @@ HashStringKey(
result += (result << 3) + UCHAR(c);
}
}
- return result;
+ return (TCL_HASH_TYPE) result;
}
/*
@@ -940,7 +911,7 @@ HashStringKey(
*
* BogusFind --
*
- * This function is invoked when an Tcl_FindHashEntry is called on a
+ * This function is invoked when Tcl_FindHashEntry is called on a
* table that has been deleted.
*
* Results:
@@ -967,7 +938,7 @@ BogusFind(
*
* BogusCreate --
*
- * This function is invoked when an Tcl_CreateHashEntry is called on a
+ * This function is invoked when Tcl_CreateHashEntry is called on a
* table that has been deleted.
*
* Results:
@@ -1065,7 +1036,6 @@ RebuildTable(
for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
*oldChainPtr = hPtr->nextPtr;
-#if TCL_HASH_KEY_STORE_HASH
if (typePtr->hashKeyProc == NULL
|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
@@ -1074,26 +1044,6 @@ RebuildTable(
}
hPtr->nextPtr = tablePtr->buckets[index];
tablePtr->buckets[index] = hPtr;
-#else
- void *key = Tcl_GetHashKey(tablePtr, hPtr);
-
- if (typePtr->hashKeyProc) {
- unsigned int hash;
-
- hash = typePtr->hashKeyProc(tablePtr, key);
- if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
- index = RANDOM_INDEX(tablePtr, hash);
- } else {
- index = hash & tablePtr->mask;
- }
- } else {
- index = RANDOM_INDEX(tablePtr, key);
- }
-
- hPtr->bucketPtr = &tablePtr->buckets[index];
- hPtr->nextPtr = *hPtr->bucketPtr;
- *hPtr->bucketPtr = hPtr;
-#endif
}
}
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index b08e352..47806d4 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -62,15 +62,14 @@ Tcl_RecordAndEval(
* instead of Tcl_Eval. */
{
register Tcl_Obj *cmdPtr;
- int length = strlen(cmd);
int result;
- if (length > 0) {
+ if (cmd[0]) {
/*
* Call Tcl_RecordAndEvalObj to do the actual work.
*/
- cmdPtr = Tcl_NewStringObj(cmd, length);
+ cmdPtr = Tcl_NewStringObj(cmd, -1);
Tcl_IncrRefCount(cmdPtr);
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index d603d76..7c93e1a 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -116,7 +116,7 @@ typedef struct CopyState {
* The structure defined below is used in this file only.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
NextChannelHandler *nestedHandlerPtr;
/* This variable holds the list of nested
* Tcl_NotifyChannel invocations. */
@@ -321,9 +321,9 @@ static int WillRead(Channel *chanPtr);
typedef struct ResolvedChanName {
ChannelState *statePtr; /* The saved lookup result */
Tcl_Interp *interp; /* The interp in which the lookup was done. */
- int epoch; /* The epoch of the channel when the lookup
+ size_t epoch; /* The epoch of the channel when the lookup
* was done. Use to verify validity. */
- int refCount; /* Share this struct among many Tcl_Obj. */
+ size_t refCount; /* Share this struct among many Tcl_Obj. */
} ResolvedChanName;
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
@@ -337,6 +337,22 @@ static const Tcl_ObjType chanObjType = {
NULL /* setFromAnyProc */
};
+#define ChanSetIntRep(objPtr, resPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (resPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (resPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &chanObjType, &ir); \
+ } while (0)
+
+#define ChanGetIntRep(objPtr, resPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &chanObjType); \
+ (resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
#define BUSY_STATE(st, fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
@@ -381,20 +397,20 @@ ChanCloseHalf(
*
* ChanRead --
*
- * Read up to dstSize bytes using the inputProc of chanPtr, store
- * them at dst, and return the number of bytes stored.
+ * Read up to dstSize bytes using the inputProc of chanPtr, store them at
+ * dst, and return the number of bytes stored.
*
* Results:
* The return value of the driver inputProc,
* - number of bytes stored at dst, ot
- * - -1 on error, with a Posix error code available to the
- * caller by calling Tcl_GetErrno().
+ * - -1 on error, with a Posix error code available to the caller by
+ * calling Tcl_GetErrno().
*
* Side effects:
- * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are
- * set as appropriate.
- * On EOF, the inputEncodingFlags are set to perform ending operations
- * on decoding.
+ * The CHANNEL_BLOCKED and CHANNEL_EOF flags of the channel state are set
+ * as appropriate. On EOF, the inputEncodingFlags are set to perform
+ * ending operations on decoding.
+ *
* TODO - Is this really the right place for that?
*
*---------------------------------------------------------------------------
@@ -408,15 +424,17 @@ ChanRead(
int bytesRead, result;
/*
- * If the caller asked for zero bytes, we'd force the inputProc
- * to return zero bytes, and then misinterpret that as EOF.
+ * If the caller asked for zero bytes, we'd force the inputProc to return
+ * zero bytes, and then misinterpret that as EOF.
*/
+
assert(dstSize > 0);
/*
* Each read op must set the blocked and eof states anew, not let
* the effect of prior reads leak through.
*/
+
if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
}
@@ -429,7 +447,10 @@ ChanRead(
bytesRead = chanPtr->typePtr->inputProc(chanPtr->instanceData,
dst, dstSize, &result);
- /* Stop any flag leakage through stacked channel levels */
+ /*
+ * Stop any flag leakage through stacked channel levels.
+ */
+
if (GotFlag(chanPtr->state, CHANNEL_EOF)) {
chanPtr->state->inputEncodingFlags |= TCL_ENCODING_START;
}
@@ -437,10 +458,10 @@ ChanRead(
chanPtr->state->inputEncodingFlags &= ~TCL_ENCODING_END;
if (bytesRead > 0) {
/*
- * If we get a short read, signal up that we may be BLOCKED.
- * We should avoid calling the driver because on some
- * platforms we will block in the low level reading code even
- * though the channel is set into nonblocking mode.
+ * If we get a short read, signal up that we may be BLOCKED. We should
+ * avoid calling the driver because on some platforms we will block in
+ * the low level reading code even though the channel is set into
+ * nonblocking mode.
*/
if (bytesRead < dstSize) {
@@ -477,13 +498,13 @@ ChanSeek(
offset, mode, errnoPtr);
}
- if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+ if (offset<LONG_MIN || offset>LONG_MAX) {
*errnoPtr = EOVERFLOW;
- return Tcl_LongAsWide(-1);
+ return -1;
}
- return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
- Tcl_WideAsLong(offset), mode, errnoPtr));
+ return chanPtr->typePtr->seekProc(chanPtr->instanceData,
+ offset, mode, errnoPtr);
}
static inline void
@@ -574,7 +595,10 @@ TclFinalizeIOSubsystem(void)
int active = 1; /* Flag == 1 while there's still work to do */
int doflushnb;
- /* Fetch the pre-TIP#398 compatibility flag */
+ /*
+ * Fetch the pre-TIP#398 compatibility flag.
+ */
+
{
const char *s;
Tcl_DString ds;
@@ -619,18 +643,20 @@ TclFinalizeIOSubsystem(void)
*/
if (active) {
-
TclChannelPreserve((Tcl_Channel)chanPtr);
+
/*
- * TIP #398: by default, we no longer set the channel back into
- * blocking mode. To restore the old blocking behavior, the
- * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
+ * TIP #398: by default, we no longer set the channel back into
+ * blocking mode. To restore the old blocking behavior, the
+ * environment variable TCL_FLUSH_NONBLOCKING_ON_EXIT must be set
* and not be "0".
*/
+
if (doflushnb) {
- /* Set the channel back into blocking mode to ensure that we wait
- * for all data to flush out.
- */
+ /*
+ * Set the channel back into blocking mode to ensure that we
+ * wait for all data to flush out.
+ */
(void) Tcl_SetChannelOption(NULL, (Tcl_Channel) chanPtr,
"-blocking", "on");
@@ -1505,18 +1531,20 @@ TclGetChannelFromObj(
return TCL_ERROR;
}
- if (objPtr->typePtr == &chanObjType) {
+ ChanGetIntRep(objPtr, resPtr);
+ if (resPtr) {
/*
* Confirm validity of saved lookup results.
*/
- resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
statePtr = resPtr->statePtr;
if ((resPtr->interp == interp) /* Same interp context */
/* No epoch change in channel since lookup */
&& (resPtr->epoch == statePtr->epoch)) {
+ /*
+ * Have a valid saved lookup. Jump to end to return it.
+ */
- /* Have a valid saved lookup. Jump to end to return it. */
goto valid;
}
}
@@ -1525,22 +1553,21 @@ TclGetChannelFromObj(
if (chan == NULL) {
if (resPtr) {
- FreeChannelIntRep(objPtr);
+ Tcl_StoreIntRep(objPtr, &chanObjType, NULL);
}
return TCL_ERROR;
}
if (resPtr && resPtr->refCount == 1) {
- /* Re-use the ResolvedCmdName struct */
- Tcl_Release((ClientData) resPtr->statePtr);
+ /*
+ * Re-use the ResolvedCmdName struct.
+ */
+ Tcl_Release((ClientData) resPtr->statePtr);
} else {
- TclFreeIntRep(objPtr);
-
resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
- resPtr->refCount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
- objPtr->typePtr = &chanObjType;
+ resPtr->refCount = 0;
+ ChanSetIntRep(objPtr, resPtr); /* Overwrites, if needed */
}
statePtr = ((Channel *)chan)->state;
resPtr->statePtr = statePtr;
@@ -1675,7 +1702,7 @@ Tcl_CreateChannel(
* Set the channel up initially in AUTO input translation mode to accept
* "\n", "\r" and "\r\n". Output translation mode is set to a platform
* specific default value. The eofChar is set to 0 for both input and
- * output, so that Tcl does not look for an in-file EOF indicator (e.g.
+ * output, so that Tcl does not look for an in-file EOF indicator (e.g.,
* ^Z) and does not append an EOF indicator to files.
*/
@@ -1903,7 +1930,6 @@ Tcl_StackChannel(
*/
if (((mask & TCL_READABLE) != 0) && (statePtr->inQueueHead != NULL)) {
-
/*
* When statePtr->inQueueHead is not NULL, we know
* prevChanPtr->inQueueHead must be NULL.
@@ -2035,9 +2061,7 @@ Tcl_UnstackChannel(
* of registered channels we wind down the state of the
* transformation, and then restore the state of underlying channel
* into the old structure.
- */
-
- /*
+ *
* TODO: Figure out how to handle the situation where the chan
* operations called below by this unstacking operation cause
* another unstacking recursively. In that case the downChanPtr
@@ -2515,6 +2539,7 @@ RecycleBuffer(
/*
* Do we have to free the buffer to the OS?
*/
+
if (IsShared(bufPtr)) {
mustDiscard = 1;
}
@@ -2525,9 +2550,8 @@ RecycleBuffer(
}
/*
- * Only save buffers which have the requested buffersize for the
- * channel. This is to honor dynamic changes of the buffersize
- * made by the user.
+ * Only save buffers which have 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) {
@@ -2697,14 +2721,18 @@ FlushChannel(
/*
* Should we shift the current output buffer over to the output queue?
* First check that there are bytes in it. If so then...
- * If the output queue is empty, then yes, trusting the caller called
- * us only when written bytes ought to be flushed.
- * If the current output buffer is full, then yes, so we can meet
- * the post-condition that on a successful return to caller we've
- * left space in the current output buffer for more writing (the flush
- * call was to make new room).
- * If the channel is blocking, then yes, so we guarantee that
- * blocking flushes actually flush all pending data.
+ *
+ * If the output queue is empty, then yes, trusting the caller called us
+ * only when written bytes ought to be flushed.
+ *
+ * If the current output buffer is full, then yes, so we can meet the
+ * post-condition that on a successful return to caller we've left space
+ * in the current output buffer for more writing (the flush call was to
+ * make new room).
+ *
+ * If the channel is blocking, then yes, so we guarantee that blocking
+ * flushes actually flush all pending data.
+ *
* Otherwise, no. Keep the current output buffer where it is so more
* can be written to it, possibly filling it, to promote more efficient
* buffer usage.
@@ -2798,8 +2826,8 @@ FlushChannel(
/*
* TIP #219, Tcl Channel Reflection API.
* When defering the error copy a message from the bypass into
- * the unreported area. Or discard it if the new error is to be
- * ignored in favor of an earlier defered error.
+ * the unreported area. Or discard it if the new error is to
+ * be ignored in favor of an earlier defered error.
*/
Tcl_Obj *msg = statePtr->chanMsg;
@@ -2851,8 +2879,11 @@ FlushChannel(
ReleaseChannelBuffer(bufPtr);
break;
} else {
- /* TODO: Consider detecting and reacting to short writes
- * on blocking channels. Ought not happen. See iocmd-24.2. */
+ /*
+ * TODO: Consider detecting and reacting to short writes on
+ * blocking channels. Ought not happen. See iocmd-24.2.
+ */
+
wroteSome = 1;
}
@@ -2886,7 +2917,6 @@ FlushChannel(
ResetFlag(statePtr, BG_FLUSH_SCHEDULED);
ChanWatch(chanPtr, statePtr->interestMask);
} else {
-
/*
* When we are calledFromAsyncFlush, that means a writable
* state on the channel triggered the call, so we should be
@@ -2931,7 +2961,8 @@ FlushChannel(
(statePtr->outQueueHead == NULL) &&
((statePtr->curOutPtr == NULL) ||
IsBufferEmpty(statePtr->curOutPtr))) {
- errorCode = CloseChannelPart(interp, chanPtr, errorCode, TCL_CLOSE_WRITE);
+ errorCode = CloseChannelPart(interp, chanPtr, errorCode,
+ TCL_CLOSE_WRITE);
goto done;
}
@@ -3402,7 +3433,6 @@ Tcl_Close(
if (GotFlag(statePtr, TCL_WRITABLE) && (statePtr->encoding != NULL)
&& !(statePtr->outputEncodingFlags & TCL_ENCODING_START)) {
-
int code = CheckChannelErrors(statePtr, TCL_WRITABLE);
if (code == 0) {
@@ -3492,12 +3522,14 @@ Tcl_Close(
}
return TCL_ERROR;
}
+
/*
* Bug 97069ea11a: set error message if a flush code is set and no error
* message set up to now.
*/
+
if (flushcode != 0 && interp != NULL
- && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp)) ) {
+ && 0 == Tcl_GetCharLength(Tcl_GetObjResult(interp))) {
Tcl_SetErrno(flushcode);
Tcl_SetObjResult(interp,
Tcl_NewStringObj(Tcl_PosixError(interp), -1));
@@ -3592,8 +3624,8 @@ Tcl_CloseEx(
}
/*
- * A user may try to call half-close from within a channel close
- * handler. That won't do.
+ * A user may try to call half-close from within a channel close handler.
+ * That won't do.
*/
if (statePtr->flags & CHANNEL_INCLOSE) {
@@ -3664,9 +3696,12 @@ CloseWrite(
* closed. May still be used by some
* interpreter */
{
- /* Notes: clear-channel-handlers - write side only ? or keep around, just
- * not called. */
- /* No close cllbacks are run - channel is still open (read side) */
+ /*
+ * Notes: clear-channel-handlers - write side only ? or keep around, just
+ * not called.
+ *
+ * No close callbacks are run - channel is still open (read side)
+ */
ChannelState *statePtr = chanPtr->state;
/* State of real IO channel. */
@@ -3691,9 +3726,9 @@ CloseWrite(
* Notes: Due to the assertion of CHANNEL_CLOSEDWRITE in the flags
* FlushChannel() has called CloseChannelPart(). While we can still access
* "chan" (no structures were freed), the only place which may still
- * contain a message is the interpreter itself, and "CloseChannelPart" made
- * sure to lift any channel message it generated into it. Hence the NULL
- * argument in the call below.
+ * contain a message is the interpreter itself, and "CloseChannelPart"
+ * made sure to lift any channel message it generated into it. Hence the
+ * NULL argument in the call below.
*/
if (TclChanCaughtErrorBypass(interp, NULL)) {
@@ -3917,10 +3952,10 @@ Tcl_ClearChannelHandlers(
StopCopy(statePtr->csPtrW);
/*
- * Must set the interest mask now to 0, otherwise infinite loops
- * will occur if Tcl_DoOneEvent is called before the channel is
- * finally deleted in FlushChannel. This can happen if the channel
- * has a background flush active.
+ * Must set the interest mask now to 0, otherwise infinite loops will
+ * occur if Tcl_DoOneEvent is called before the channel is finally deleted
+ * in FlushChannel. This can happen if the channel has a background flush
+ * active.
*/
statePtr->interestMask = 0;
@@ -4189,22 +4224,24 @@ WillRead(
Channel *chanPtr)
{
if (chanPtr->typePtr == NULL) {
- /* Prevent read attempts on a closed channel */
+ /*
+ * Prevent read attempts on a closed channel.
+ */
+
DiscardInputQueued(chanPtr->state, 0);
Tcl_SetErrno(EINVAL);
return -1;
}
if ((chanPtr->typePtr->seekProc != NULL)
&& (Tcl_OutputBuffered((Tcl_Channel) chanPtr) > 0)) {
-
/*
- * CAVEAT - The assumption here is that FlushChannel() will
- * push out the bytes of any writes that are in progress.
- * Since this is a seekable channel, we assume it is not one
- * that can block and force bg flushing. Channels we know that
- * can do that -- sockets, pipes -- are not seekable. If the
- * assumption is wrong, more drastic measures may be required here
- * like temporarily setting the channel into blocking mode.
+ * CAVEAT - The assumption here is that FlushChannel() will push out
+ * the bytes of any writes that are in progress. Since this is a
+ * seekable channel, we assume it is not one that can block and force
+ * bg flushing. Channels we know that can do that - sockets, pipes -
+ * are not seekable. If the assumption is wrong, more drastic measures
+ * may be required here like temporarily setting the channel into
+ * blocking mode.
*/
if (FlushChannel(NULL, chanPtr, 0) != 0) {
@@ -4296,11 +4333,17 @@ Write(
&statePtr->outputEncodingState, dst,
dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
- /* See chan-io-1.[89]. Tcl Bug 506297. */
+ /*
+ * See chan-io-1.[89]. Tcl Bug 506297.
+ */
+
statePtr->outputEncodingFlags &= ~TCL_ENCODING_START;
if ((result != TCL_OK) && (srcRead + dstWrote == 0)) {
- /* We're reading from invalid/incomplete UTF-8 */
+ /*
+ * We're reading from invalid/incomplete UTF-8.
+ */
+
ReleaseChannelBuffer(bufPtr);
if (total == 0) {
Tcl_SetErrno(EINVAL);
@@ -4340,11 +4383,10 @@ Write(
}
result |= Tcl_UtfToExternal(NULL, encoding, nl, nlLen,
- statePtr->outputEncodingFlags,
- &statePtr->outputEncodingState, dst,
- dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
-
- assert (srcRead == nlLen);
+ statePtr->outputEncodingFlags,
+ &statePtr->outputEncodingState, dst,
+ dstLen + BUFFER_PADDING, &srcRead, &dstWrote, NULL);
+ assert(srcRead == nlLen);
bufPtr->nextAdded += dstWrote;
src++;
@@ -4358,11 +4400,11 @@ Write(
if (IsBufferOverflowing(bufPtr)) {
/*
- * When translating from UTF-8 to external encoding, we
- * allowed the translation to produce a character that crossed
- * the end of the output buffer, so that we would get a
- * completely full buffer before flushing it. The extra bytes
- * will be moved to the beginning of the next buffer.
+ * When translating from UTF-8 to external encoding, we allowed
+ * the translation to produce a character that crossed the end of
+ * the output buffer, so that we would get a completely full
+ * buffer before flushing it. The extra bytes will be moved to the
+ * beginning of the next buffer.
*/
saved = -SpaceLeft(bufPtr);
@@ -4382,15 +4424,16 @@ Write(
flushed += statePtr->bufSize;
/*
- * We just flushed. So if we have needNlFlush set to record
- * that we need to flush because theres a (translated) newline
- * in the buffer, that's likely not true any more. But there
- * is a tricky exception. If we have saved bytes that did not
- * really get flushed and those bytes came from a translation
- * of a newline as the last thing taken from the src array,
- * then needNlFlush needs to remain set to flag that the
- * next buffer still needs a newline flush.
+ * We just flushed. So if we have needNlFlush set to record that
+ * we need to flush because theres a (translated) newline in the
+ * buffer, that's likely not true any more. But there is a tricky
+ * exception. If we have saved bytes that did not really get
+ * flushed and those bytes came from a translation of a newline as
+ * the last thing taken from the src array, then needNlFlush needs
+ * to remain set to flag that the next buffer still needs a
+ * newline flush.
*/
+
if (needNlFlush && (saved == 0 || src[-1] != '\n')) {
needNlFlush = 0;
}
@@ -4496,8 +4539,8 @@ Tcl_GetsObj(
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
- assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
- assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+ assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
+ assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
/* TODO: Do we need this? */
UpdateInterest(chanPtr);
@@ -4837,17 +4880,17 @@ Tcl_GetsObj(
*/
done:
- assert(!GotFlag(statePtr, CHANNEL_EOF)
- || GotFlag(statePtr, CHANNEL_STICKY_EOF)
- || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
-
- assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
- == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)));
/*
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
+
if (chanPtr != statePtr->topChanPtr) {
TclChannelRelease((Tcl_Channel)chanPtr);
chanPtr = statePtr->topChanPtr;
@@ -4867,10 +4910,9 @@ Tcl_GetsObj(
* end-of-line or end-of-file has been seen. Bytes read from the input
* channel return as a ByteArray obj.
*
- * WARNING! The notion of "binary" used here is different from
- * notions of "binary" used in other places. In particular, this
- * "binary" routine may be called when an -eofchar is set on the
- * channel.
+ * WARNING! The notion of "binary" used here is different from notions
+ * of "binary" used in other places. In particular, this "binary" routine
+ * may be called when an -eofchar is set on the channel.
*
* Results:
* Number of characters accumulated in the object or -1 if error,
@@ -4936,8 +4978,8 @@ TclGetsObjBinary(
ResetFlag(statePtr, CHANNEL_BLOCKED);
while (1) {
/*
- * Subtract the number of bytes that were removed from channel
- * buffer during last call.
+ * Subtract the number of bytes that were removed from channel buffer
+ * during last call.
*/
if (bufPtr != NULL) {
@@ -4949,10 +4991,11 @@ TclGetsObjBinary(
if ((bufPtr == NULL) || (bufPtr->nextAdded == BUFFER_PADDING)) {
/*
- * All channel buffers were exhausted and the caller still
- * hasn't seen EOL. Need to read more bytes from the channel
- * device. Side effect is to allocate another channel buffer.
+ * All channel buffers were exhausted and the caller still hasn't
+ * seen EOL. Need to read more bytes from the channel device. Side
+ * effect is to allocate another channel buffer.
*/
+
if (GetInput(chanPtr) != 0) {
goto restore;
}
@@ -4962,15 +5005,15 @@ TclGetsObjBinary(
}
} else {
/*
- * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
- * A new CHANNEL_STICKY_EOF set in this routine leads to
- * return before coming back here. When we are not dealing
- * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
- * empty buffer. Here the buffer is non-empty so we know
- * we're a non-EOF */
+ * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new
+ * CHANNEL_STICKY_EOF set in this routine leads to return before
+ * coming back here. When we are not dealing with
+ * CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an empty buffer.
+ * Here the buffer is non-empty so we know we're a non-EOF.
+ */
- assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
- assert ( !GotFlag(statePtr, CHANNEL_EOF) );
+ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
+ assert(!GotFlag(statePtr, CHANNEL_EOF));
}
dst = (unsigned char *) RemovePoint(bufPtr);
@@ -5037,8 +5080,8 @@ TclGetsObjBinary(
}
/*
- * Copy bytes from the channel buffer to the ByteArray.
- * This may realloc space, so keep track of result.
+ * Copy bytes from the channel buffer to the ByteArray. This may
+ * realloc space, so keep track of result.
*/
rawLen = dstEnd - dst;
@@ -5122,11 +5165,11 @@ TclGetsObjBinary(
*/
done:
- assert(!GotFlag(statePtr, CHANNEL_EOF)
- || GotFlag(statePtr, CHANNEL_STICKY_EOF)
- || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
- assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
- == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)));
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return copiedTotal;
@@ -5259,15 +5302,15 @@ FilterInputBytes(
}
} else {
/*
- * Incoming CHANNEL_STICKY_EOF is filtered out on entry.
- * A new CHANNEL_STICKY_EOF set in this routine leads to
- * return before coming back here. When we are not dealing
- * with CHANNEL_STICKY_EOF, a CHANNEL_EOF implies an
- * empty buffer. Here the buffer is non-empty so we know
- * we're a non-EOF */
+ * Incoming CHANNEL_STICKY_EOF is filtered out on entry. A new
+ * CHANNEL_STICKY_EOF set in this routine leads to return before
+ * coming back here. When we are not dealing with CHANNEL_STICKY_EOF,
+ * a CHANNEL_EOF implies an empty buffer. Here the buffer is
+ * non-empty so we know we're a non-EOF.
+ */
- assert ( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
- assert ( !GotFlag(statePtr, CHANNEL_EOF) );
+ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
+ assert(!GotFlag(statePtr, CHANNEL_EOF));
}
/*
@@ -5597,7 +5640,9 @@ Tcl_ReadRaw(
return -1;
}
- /* First read bytes from the push-back buffers. */
+ /*
+ * First read bytes from the push-back buffers.
+ */
while (chanPtr->inQueueHead && bytesToRead > 0) {
ChannelBuffer *bufPtr = chanPtr->inQueueHead;
@@ -5605,7 +5650,9 @@ Tcl_ReadRaw(
int toCopy = (bytesInBuffer < bytesToRead) ? bytesInBuffer
: bytesToRead;
- /* Copy the current chunk into the read buffer. */
+ /*
+ * Copy the current chunk into the read buffer.
+ */
memcpy(readBuf, RemovePoint(bufPtr), (size_t) toCopy);
bufPtr->nextRemoved += toCopy;
@@ -5613,7 +5660,9 @@ Tcl_ReadRaw(
readBuf += toCopy;
bytesToRead -= toCopy;
- /* If the current buffer is empty recycle it. */
+ /*
+ * If the current buffer is empty recycle it.
+ */
if (IsBufferEmpty(bufPtr)) {
chanPtr->inQueueHead = bufPtr->nextPtr;
@@ -5625,37 +5674,40 @@ Tcl_ReadRaw(
}
/*
- * Go to the driver only if we got nothing from pushback.
- * Have to do it this way to avoid EOF mis-timings when we
- * consider the ability that EOF may not be a permanent
- * condition in the driver, and in that case we have to
- * synchronize.
+ * Go to the driver only if we got nothing from pushback. Have to do it
+ * this way to avoid EOF mis-timings when we consider the ability that EOF
+ * may not be a permanent condition in the driver, and in that case we
+ * have to synchronize.
*/
if (copied) {
return copied;
}
- /* This test not needed. */
- if (bytesToRead > 0) {
+ /*
+ * This test not needed.
+ */
+ if (bytesToRead > 0) {
int nread = ChanRead(chanPtr, readBuf, bytesToRead);
if (nread > 0) {
- /* Successful read (short is OK) - add to bytes copied */
+ /*
+ * Successful read (short is OK) - add to bytes copied.
+ */
+
copied += nread;
} else if (nread < 0) {
/*
- * An error signaled. If CHANNEL_BLOCKED, then the error
- * is not real, but an indication of blocked state. In
- * that case, retain the flag and let caller receive the
- * short read of copied bytes from the pushback.
- * HOWEVER, if copied==0 bytes from pushback then repeat
- * signalling the blocked state as an error to caller so
- * there is no false report of an EOF.
- * When !CHANNEL_BLOCKED, the error is real and passes on
- * to caller.
+ * An error signaled. If CHANNEL_BLOCKED, then the error is not
+ * real, but an indication of blocked state. In that case, retain
+ * the flag and let caller receive the short read of copied bytes
+ * from the pushback. HOWEVER, if copied==0 bytes from pushback
+ * then repeat signalling the blocked state as an error to caller
+ * so there is no false report of an EOF. When !CHANNEL_BLOCKED,
+ * the error is real and passes on to caller.
*/
+
if (!GotFlag(statePtr, CHANNEL_BLOCKED) || copied == 0) {
copied = -1;
}
@@ -5792,21 +5844,23 @@ DoReadChars(
/*
* Early out when next read will see eofchar.
*
- * NOTE: See DoRead for argument that it's a bug (one we're keeping)
- * to have this escape before the one for zero-char read request.
+ * NOTE: See DoRead for argument that it's a bug (one we're keeping) to
+ * have this escape before the one for zero-char read request.
*/
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
- assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
- assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+ assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
+ assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
/* TODO: We don't need this call? */
UpdateInterest(chanPtr);
return 0;
}
- /* Special handling for zero-char read request. */
+ /*
+ * Special handling for zero-char read request.
+ */
if (toRead == 0) {
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
@@ -5825,7 +5879,10 @@ DoReadChars(
chanPtr = statePtr->topChanPtr;
TclChannelPreserve((Tcl_Channel)chanPtr);
- /* Must clear the BLOCKED|EOF flags here since we check before reading */
+ /*
+ * Must clear the BLOCKED|EOF flags here since we check before reading.
+ */
+
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
}
@@ -5883,10 +5940,11 @@ DoReadChars(
}
/*
- * Failure to fill a channel buffer may have left channel reporting
- * a "blocked" state, but so long as we fulfilled the request here,
- * the caller does not consider us blocked.
+ * Failure to fill a channel buffer may have left channel reporting a
+ * "blocked" state, but so long as we fulfilled the request here, the
+ * caller does not consider us blocked.
*/
+
if (toRead == 0) {
ResetFlag(statePtr, CHANNEL_BLOCKED);
}
@@ -5895,6 +5953,7 @@ DoReadChars(
* Regenerate the top channel, in case it was changed due to
* self-modifying reflected transforms.
*/
+
if (chanPtr != statePtr->topChanPtr) {
TclChannelRelease((Tcl_Channel)chanPtr);
chanPtr = statePtr->topChanPtr;
@@ -5905,11 +5964,12 @@ DoReadChars(
* Update the notifier state so we don't block while there is still data
* in the buffers.
*/
- assert(!GotFlag(statePtr, CHANNEL_EOF)
- || GotFlag(statePtr, CHANNEL_STICKY_EOF)
- || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
- assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
- == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)));
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return copied;
@@ -6026,11 +6086,10 @@ ReadChars(
int numBytes, srcLen = BytesLeft(bufPtr);
/*
- * One src byte can yield at most one character. So when the
- * number of src bytes we plan to read is less than the limit on
- * character count to be read, clearly we will remain within that
- * limit, and we can use the value of "srcLen" as a tighter limit
- * for sizing receiving buffers.
+ * One src byte can yield at most one character. So when the number of
+ * src bytes we plan to read is less than the limit on character count to
+ * be read, clearly we will remain within that limit, and we can use the
+ * value of "srcLen" as a tighter limit for sizing receiving buffers.
*/
int toRead = ((charsToRead<0)||(charsToRead > srcLen)) ? srcLen : charsToRead;
@@ -6048,6 +6107,7 @@ ReadChars(
Tcl_AppendToObj(objPtr, NULL, dstLimit);
if (toRead == srcLen) {
unsigned int size;
+
dst = TclGetStringStorage(objPtr, &size) + numBytes;
dstLimit = size - numBytes;
} else {
@@ -6055,19 +6115,18 @@ ReadChars(
}
/*
- * This routine is burdened with satisfying several constraints.
- * It cannot append more than 'charsToRead` chars onto objPtr.
- * This is measured after encoding and translation transformations
- * are completed. There is no precise number of src bytes that can
- * be associated with the limit. Yet, when we are done, we must know
- * precisely the number of src bytes that were consumed to produce
- * the appended chars, so that all subsequent bytes are left in
- * the buffers for future read operations.
+ * This routine is burdened with satisfying several constraints. It cannot
+ * append more than 'charsToRead` chars onto objPtr. This is measured
+ * after encoding and translation transformations are completed. There is
+ * no precise number of src bytes that can be associated with the limit.
+ * Yet, when we are done, we must know precisely the number of src bytes
+ * that were consumed to produce the appended chars, so that all
+ * subsequent bytes are left in the buffers for future read operations.
*
- * The consequence is that we have no choice but to implement a
- * "trial and error" approach, where in general we may need to
- * perform transformations and copies multiple times to achieve
- * a consistent set of results. This takes the shape of a loop.
+ * The consequence is that we have no choice but to implement a "trial and
+ * error" approach, where in general we may need to perform
+ * transformations and copies multiple times to achieve a consistent set
+ * of results. This takes the shape of a loop.
*/
while (1) {
@@ -6080,18 +6139,17 @@ ReadChars(
}
/*
- * Perform the encoding transformation. Read no more than
- * srcLen bytes, write no more than dstLimit bytes.
+ * Perform the encoding transformation. Read no more than srcLen
+ * bytes, write no more than dstLimit bytes.
*
- * Some trickiness with encoding flags here. We do not want
- * the end of a buffer to be treated as the end of all input
- * when the presence of bytes in a next buffer are already
- * known to exist. This is checked with an assert() because
- * so far no test case causing the assertion to be false has
- * been created. The normal operations of channel reading
- * appear to cause EOF and TCL_ENCODING_END setting to appear
- * only in situations where there are no further bytes in
- * any buffers.
+ * Some trickiness with encoding flags here. We do not want the end
+ * of a buffer to be treated as the end of all input when the presence
+ * of bytes in a next buffer are already known to exist. This is
+ * checked with an assert() because so far no test case causing the
+ * assertion to be false has been created. The normal operations of
+ * channel reading appear to cause EOF and TCL_ENCODING_END setting to
+ * appear only in situations where there are no further bytes in any
+ * buffers.
*/
assert(bufPtr->nextPtr == NULL || BytesLeft(bufPtr->nextPtr) == 0
@@ -6102,10 +6160,10 @@ ReadChars(
dst, dstLimit, &srcRead, &dstDecoded, &numChars);
/*
- * Perform the translation transformation in place. Read no more
- * than the dstDecoded bytes the encoding transformation actually
- * produced. Capture the number of bytes written in dstWrote.
- * Capture the number of bytes actually consumed in dstRead.
+ * Perform the translation transformation in place. Read no more than
+ * the dstDecoded bytes the encoding transformation actually produced.
+ * Capture the number of bytes written in dstWrote. Capture the number
+ * of bytes actually consumed in dstRead.
*/
dstWrote = dstLimit;
@@ -6113,11 +6171,9 @@ ReadChars(
TranslateInputEOL(statePtr, dst, dst, &dstWrote, &dstRead);
if (dstRead < dstDecoded) {
-
/*
- * The encoding transformation produced bytes that the
- * translation transformation did not consume. Why did
- * this happen?
+ * The encoding transformation produced bytes that the translation
+ * transformation did not consume. Why did this happen?
*/
if (statePtr->inEofChar && dst[dstRead] == statePtr->inEofChar) {
@@ -6126,40 +6182,38 @@ ReadChars(
* we saw it and stopped translating at that point.
*
* NOTE the bizarre spec of TranslateInputEOL in this case.
- * Clearly the eof char had to be read in order to account
- * for the stopping, but the value of dstRead does not
- * include it.
+ * Clearly the eof char had to be read in order to account for
+ * the stopping, but the value of dstRead does not include it.
*
- * Also rather bizarre, our caller can only notice an
- * EOF condition if we return the value -1 as the number
- * of chars read. This forces us to perform a 2-call
- * dance where the first call can read all the chars
- * up to the eof char, and the second call is solely
- * for consuming the encoded eof char then pointed at
- * by src so that we can return that magic -1 value.
- * This seems really wasteful, especially since
- * the first decoding pass of each call is likely to
- * decode many bytes beyond that eof char that's all we
- * care about.
+ * Also rather bizarre, our caller can only notice an EOF
+ * condition if we return the value -1 as the number of chars
+ * read. This forces us to perform a 2-call dance where the
+ * first call can read all the chars up to the eof char, and
+ * the second call is solely for consuming the encoded eof
+ * char then pointed at by src so that we can return that
+ * magic -1 value. This seems really wasteful, especially
+ * since the first decoding pass of each call is likely to
+ * decode many bytes beyond that eof char that's all we care
+ * about.
*/
if (dstRead == 0) {
/*
- * Curious choice in the eof char handling. We leave
- * the eof char in the buffer. So, no need to compute
- * a proper srcRead value. At this point, there
- * are no chars before the eof char in the buffer.
+ * Curious choice in the eof char handling. We leave the
+ * eof char in the buffer. So, no need to compute a proper
+ * srcRead value. At this point, there are no chars before
+ * the eof char in the buffer.
*/
+
Tcl_SetObjLength(objPtr, numBytes);
return -1;
}
{
/*
- * There are chars leading the buffer before the eof
- * char. Adjust the dstLimit so we go back and read
- * only those and do not encounter the eof char this
- * time.
+ * There are chars leading the buffer before the eof char.
+ * Adjust the dstLimit so we go back and read only those
+ * and do not encounter the eof char this time.
*/
dstLimit = dstRead - 1 + TCL_UTF_MAX;
@@ -6171,10 +6225,9 @@ ReadChars(
}
/*
- * 2) The other way to read fewer bytes than are decoded
- * is when the final byte is \r and we're in a CRLF
- * translation mode so we cannot decide whether to
- * record \r or \n yet.
+ * 2) The other way to read fewer bytes than are decoded is when
+ * the final byte is \r and we're in a CRLF translation mode so
+ * we cannot decide whether to record \r or \n yet.
*/
assert(dst[dstRead] == '\r');
@@ -6182,10 +6235,10 @@ ReadChars(
if (dstWrote > 0) {
/*
- * There are chars we can read before we hit the bare cr.
- * Go back with a smaller dstLimit so we get them in the
- * next pass, compute a matching srcRead, and don't end
- * up back here in this call.
+ * There are chars we can read before we hit the bare CR. Go
+ * back with a smaller dstLimit so we get them in the next
+ * pass, compute a matching srcRead, and don't end up back
+ * here in this call.
*/
dstLimit = dstRead - 1 + TCL_UTF_MAX;
@@ -6199,9 +6252,9 @@ ReadChars(
assert(dstRead == 0);
/*
- * We decoded only the bare cr, and we cannot read a
- * translated char from that alone. We have to know what's
- * next. So why do we only have the one decoded char?
+ * We decoded only the bare CR, and we cannot read a translated
+ * char from that alone. We have to know what's next. So why do
+ * we only have the one decoded char?
*/
if (code != TCL_OK) {
@@ -6242,10 +6295,9 @@ ReadChars(
}
} else if (statePtr->flags & CHANNEL_EOF) {
-
/*
- * The bare \r is the only char and we will never read
- * a subsequent char to make the determination.
+ * The bare \r is the only char and we will never read a
+ * subsequent char to make the determination.
*/
dst[0] = '\r';
@@ -6255,8 +6307,8 @@ ReadChars(
}
/*
- * Revise the dstRead value so that the numChars calc
- * below correctly computes zero characters read.
+ * Revise the dstRead value so that the numChars calc below
+ * correctly computes zero characters read.
*/
dstRead = numChars;
@@ -6265,9 +6317,9 @@ ReadChars(
}
/*
- * The translation transformation can only reduce the number
- * of chars when it converts \r\n into \n. The reduction in
- * the number of chars is the difference in bytes read and written.
+ * The translation transformation can only reduce the number of chars
+ * when it converts \r\n into \n. The reduction in the number of chars
+ * is the difference in bytes read and written.
*/
numChars -= (dstRead - dstWrote);
@@ -6277,10 +6329,9 @@ ReadChars(
/*
* TODO: This cannot happen anymore.
*
- * We read more chars than allowed. Reset limits to
- * prevent that and try again. Don't forget the extra
- * padding of TCL_UTF_MAX bytes demanded by the
- * Tcl_ExternalToUtf() call!
+ * We read more chars than allowed. Reset limits to prevent that
+ * and try again. Don't forget the extra padding of TCL_UTF_MAX
+ * bytes demanded by the Tcl_ExternalToUtf() call!
*/
dstLimit = Tcl_UtfAtIndex(dst, charsToRead) - 1 + TCL_UTF_MAX - dst;
@@ -6293,18 +6344,19 @@ ReadChars(
if (dstWrote == 0) {
ChannelBuffer *nextPtr;
- /* We were not able to read any chars. */
+ /*
+ * We were not able to read any chars.
+ */
- assert (numChars == 0);
+ assert(numChars == 0);
/*
- * There is one situation where this is the correct final
- * result. If the src buffer contains only a single \n
- * byte, and we are in TCL_TRANSLATE_AUTO mode, and
- * when the translation pass was made the INPUT_SAW_CR
- * flag was set on the channel. In that case, the
- * correct behavior is to consume that \n and produce the
- * empty string.
+ * There is one situation where this is the correct final result.
+ * If the src buffer contains only a single \n byte, and we are in
+ * TCL_TRANSLATE_AUTO mode, and when the translation pass was made
+ * the INPUT_SAW_CR flag was set on the channel. In that case, the
+ * correct behavior is to consume that \n and produce the empty
+ * string.
*/
if (dstRead == 1 && dst[0] == '\n') {
@@ -6313,12 +6365,13 @@ ReadChars(
goto consume;
}
- /* Otherwise, reading zero characters indicates there's
- * something incomplete at the end of the src buffer.
- * Maybe there were not enough src bytes to decode into
- * a char. Maybe a lone \r could not be translated (crlf
- * mode). Need to combine any unused src bytes we have
- * in the first buffer with subsequent bytes to try again.
+ /*
+ * Otherwise, reading zero characters indicates there's something
+ * incomplete at the end of the src buffer. Maybe there were not
+ * enough src bytes to decode into a char. Maybe a lone \r could
+ * not be translated (crlf mode). Need to combine any unused src
+ * bytes we have in the first buffer with subsequent bytes to try
+ * again.
*/
nextPtr = bufPtr->nextPtr;
@@ -6333,15 +6386,15 @@ ReadChars(
/*
* Space is made at the beginning of the buffer to copy the
- * previous unused bytes there. Check first if the buffer we
- * are using actually has enough space at its beginning for
- * the data we are copying. Because if not we will write over
- * the buffer management information, especially the 'nextPtr'.
+ * previous unused bytes there. Check first if the buffer we are
+ * using actually has enough space at its beginning for the data
+ * we are copying. Because if not we will write over the buffer
+ * management information, especially the 'nextPtr'.
*
- * Note that the BUFFER_PADDING (See AllocChannelBuffer) is
- * used to prevent exactly this situation. I.e. it should never
- * happen. Therefore it is ok to panic should it happen despite
- * the precautions.
+ * Note that the BUFFER_PADDING (See AllocChannelBuffer) is used
+ * to prevent exactly this situation. I.e. it should never happen.
+ * Therefore it is ok to panic should it happen despite the
+ * precautions.
*/
if (nextPtr->nextRemoved - srcLen < 0) {
@@ -6360,10 +6413,12 @@ ReadChars(
consume:
bufPtr->nextRemoved += srcRead;
+
/*
- * If this read contained multibyte characters, revise factorPtr
- * so the next read will allocate bigger buffers.
+ * If this read contained multibyte characters, revise factorPtr so
+ * the next read will allocate bigger buffers.
*/
+
if (numChars && numChars < srcRead) {
*factorPtr = srcRead * UTF_EXPANSION_FACTOR / numChars;
}
@@ -6411,22 +6466,27 @@ TranslateInputEOL(
int inEofChar = statePtr->inEofChar;
/*
- * Depending on the translation mode in use, there's no need
- * to scan more srcLen bytes at srcStart than can possibly transform
- * to dstLen bytes. This keeps the scan for eof char below from
- * being pointlessly long.
+ * Depending on the translation mode in use, there's no need to scan more
+ * srcLen bytes at srcStart than can possibly transform to dstLen bytes.
+ * This keeps the scan for eof char below from being pointlessly long.
*/
switch (statePtr->inputTranslation) {
case TCL_TRANSLATE_LF:
case TCL_TRANSLATE_CR:
if (srcLen > dstLen) {
- /* In these modes, each src byte become a dst byte. */
+ /*
+ * In these modes, each src byte become a dst byte.
+ */
+
srcLen = dstLen;
}
break;
default:
- /* In other modes, at most 2 src bytes become a dst byte. */
+ /*
+ * In other modes, at most 2 src bytes become a dst byte.
+ */
+
if (srcLen/2 > dstLen) {
srcLen = 2 * dstLen;
}
@@ -6759,7 +6819,7 @@ GetInput(
* eofchar.
*/
- assert( !GotFlag(statePtr, CHANNEL_STICKY_EOF) );
+ assert(!GotFlag(statePtr, CHANNEL_STICKY_EOF));
/*
* Prevent reading from a dead channel -- a channel that has been closed
@@ -6773,24 +6833,21 @@ GetInput(
}
/*
- * WARNING: There was once a comment here claiming that it was
- * a bad idea to make another call to the inputproc of a channel
- * driver when EOF has already been detected on the channel. Through
- * much of Tcl's history, this warning was then completely negated
- * by having all (most?) read paths clear the EOF setting before
- * reaching here. So we had a guard that was never triggered.
+ * WARNING: There was once a comment here claiming that it was a bad idea
+ * to make another call to the inputproc of a channel driver when EOF has
+ * already been detected on the channel. Through much of Tcl's history,
+ * this warning was then completely negated by having all (most?) read
+ * paths clear the EOF setting before reaching here. So we had a guard
+ * that was never triggered.
+ *
+ * Don't be tempted to restore the guard. Even if EOF is set on the
+ * channel, continue through and call the inputproc again. This is the
+ * way to enable the ability to [read] again beyond the EOF, which seems a
+ * strange thing to do, but for which use cases exist [Tcl Bug 5adc350683]
+ * and which may even be essential for channels representing things like
+ * ttys or other devices where the stream might take the logical form of a
+ * series of 'files' separated by an EOF condition.
*
- * Don't be tempted to restore the guard. Even if EOF is set on
- * the channel, continue through and call the inputproc again. This
- * is the way to enable the ability to [read] again beyond the EOF,
- * which seems a strange thing to do, but for which use cases exist
- * [Tcl Bug 5adc350683] and which may even be essential for channels
- * representing things like ttys or other devices where the stream
- * might take the logical form of a series of 'files' separated by
- * an EOF condition.
- */
-
- /*
* First check for more buffers in the pushback area of the topmost
* channel in the stack and use them. They can be the result of a
* transformation which went away without reading all the information
@@ -6798,7 +6855,6 @@ GetInput(
*/
if (chanPtr->inQueueHead != NULL) {
-
/* TODO: Tests to cover this. */
assert(statePtr->inQueueHead == NULL);
@@ -6828,8 +6884,9 @@ GetInput(
/*
* Check the actual buffersize against the requested buffersize.
- * Saved buffers of the wrong size are squashed. This is done
- * to honor dynamic changes of the buffersize made by the user.
+ * Saved buffers of the wrong size are squashed. This is done to honor
+ * dynamic changes of the buffersize made by the user.
+ *
* TODO: Tests to cover this.
*/
@@ -6908,7 +6965,7 @@ Tcl_Seek(
* non-blocking mode after the seek. */
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -6919,7 +6976,7 @@ Tcl_Seek(
*/
if (CheckForDeadChannel(NULL, statePtr)) {
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -6935,7 +6992,7 @@ Tcl_Seek(
if (chanPtr->typePtr->seekProc == NULL) {
Tcl_SetErrno(EINVAL);
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -6948,7 +7005,7 @@ Tcl_Seek(
if ((inputBuffered != 0) && (outputBuffered != 0)) {
Tcl_SetErrno(EFAULT);
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -6991,7 +7048,7 @@ Tcl_Seek(
wasAsync = 1;
result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
if (result != 0) {
- return Tcl_LongAsWide(-1);
+ return -1;
}
ResetFlag(statePtr, CHANNEL_NONBLOCKING);
if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
@@ -7016,7 +7073,7 @@ Tcl_Seek(
*/
curPos = ChanSeek(chanPtr, offset, mode, &result);
- if (curPos == Tcl_LongAsWide(-1)) {
+ if (curPos == -1) {
Tcl_SetErrno(result);
}
}
@@ -7032,7 +7089,7 @@ Tcl_Seek(
SetFlag(statePtr, CHANNEL_NONBLOCKING);
result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
if (result != 0) {
- return Tcl_LongAsWide(-1);
+ return -1;
}
}
@@ -7072,7 +7129,7 @@ Tcl_Tell(
Tcl_WideInt curPos; /* Position on device. */
if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -7083,7 +7140,7 @@ Tcl_Tell(
*/
if (CheckForDeadChannel(NULL, statePtr)) {
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -7099,7 +7156,7 @@ Tcl_Tell(
if (chanPtr->typePtr->seekProc == NULL) {
Tcl_SetErrno(EINVAL);
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -7116,10 +7173,10 @@ Tcl_Tell(
* wideSeekProc if that is available and non-NULL...
*/
- curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
- if (curPos == Tcl_LongAsWide(-1)) {
+ curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result);
+ if (curPos == -1) {
Tcl_SetErrno(result);
- return Tcl_LongAsWide(-1);
+ return -1;
}
if (inputBuffered != 0) {
@@ -7131,53 +7188,12 @@ Tcl_Tell(
/*
*---------------------------------------------------------------------------
*
- * Tcl_SeekOld, Tcl_TellOld --
- *
- * Backward-compatibility 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(
- 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(
- Tcl_Channel chan) /* The channel to return pos for. */
-{
- Tcl_WideInt wResult = Tcl_Tell(chan);
-
- return (int) Tcl_WideAsLong(wResult);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* Tcl_TruncateChannel --
*
* Truncate a channel to the given length.
*
* Results:
- * TCL_OK on success, TCL_ERROR if the operation failed (e.g. is not
+ * TCL_OK on success, TCL_ERROR if the operation failed (e.g., is not
* supported by the type of channel, or the underlying OS operation
* failed in some way).
*
@@ -9032,6 +9048,7 @@ ZeroTransferTimerProc(
*----------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED)
int
TclCopyChannelOld(
Tcl_Interp *interp, /* Current interpreter. */
@@ -9043,6 +9060,7 @@ TclCopyChannelOld(
return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead,
cmdPtr);
}
+#endif
int
TclCopyChannel(
@@ -9537,7 +9555,10 @@ CopyData(
}
if (size == 0) {
if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
- /* We allowed a short read. Keep trying. */
+ /*
+ * We allowed a short read. Keep trying.
+ */
+
continue;
}
if (bufObj != NULL) {
@@ -9751,7 +9772,7 @@ DoRead(
ChannelState *statePtr = chanPtr->state;
char *p = dst;
- assert (bytesToRead >= 0);
+ assert(bytesToRead >= 0);
/*
* Early out when we know a read will get the eofchar.
@@ -9767,15 +9788,18 @@ DoRead(
if (GotFlag(statePtr, CHANNEL_STICKY_EOF)) {
SetFlag(statePtr, CHANNEL_EOF);
- assert( statePtr->inputEncodingFlags & TCL_ENCODING_END );
- assert( !GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR) );
+ assert(statePtr->inputEncodingFlags & TCL_ENCODING_END);
+ assert(!GotFlag(statePtr, CHANNEL_BLOCKED|INPUT_SAW_CR));
/* TODO: Don't need this call */
UpdateInterest(chanPtr);
return 0;
}
- /* Special handling for zero-char read request. */
+ /*
+ * Special handling for zero-char read request.
+ */
+
if (bytesToRead == 0) {
if (GotFlag(statePtr, CHANNEL_EOF)) {
statePtr->inputEncodingFlags |= TCL_ENCODING_START;
@@ -9790,8 +9814,8 @@ DoRead(
TclChannelPreserve((Tcl_Channel)chanPtr);
while (bytesToRead) {
/*
- * Each pass through the loop is intended to process up to
- * one channel buffer.
+ * Each pass through the loop is intended to process up to one channel
+ * buffer.
*/
int bytesRead, bytesWritten;
@@ -9803,33 +9827,39 @@ DoRead(
while (!bufPtr || /* We got no buffer! OR */
(!IsBufferFull(bufPtr) && /* Our buffer has room AND */
- (BytesLeft(bufPtr) < bytesToRead) ) ) {
- /* Not enough bytes in it
- * yet to fill the dst */
+ (BytesLeft(bufPtr) < bytesToRead))) {
+ /* Not enough bytes in it yet
+ * to fill the dst */
int code;
moreData:
code = GetInput(chanPtr);
bufPtr = statePtr->inQueueHead;
- assert (bufPtr != NULL);
+ assert(bufPtr != NULL);
if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
- /* Further reads cannot do any more */
+ /*
+ * Further reads cannot do any more.
+ */
+
break;
}
if (code) {
- /* Read error */
+ /*
+ * Read error
+ */
+
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return -1;
}
- assert (IsBufferFull(bufPtr));
+ assert(IsBufferFull(bufPtr));
}
- assert (bufPtr != NULL);
+ assert(bufPtr != NULL);
bytesRead = BytesLeft(bufPtr);
bytesWritten = bytesToRead;
@@ -9844,8 +9874,8 @@ DoRead(
/*
* Buffer is not empty. How can that be?
*
- * 0) We stopped early because we got all the bytes
- * we were seeking. That's fine.
+ * 0) We stopped early because we got all the bytes we were
+ * seeking. That's fine.
*/
if (bytesToRead == 0) {
@@ -9861,8 +9891,8 @@ DoRead(
}
/*
- * 2) The buffer holds a \r while in CRLF translation,
- * followed by the end of the buffer.
+ * 2) The buffer holds a \r while in CRLF translation, followed by
+ * the end of the buffer.
*/
assert(statePtr->inputTranslation == TCL_TRANSLATE_CRLF);
@@ -9870,26 +9900,38 @@ DoRead(
assert(BytesLeft(bufPtr) == 1);
if (bufPtr->nextPtr == NULL) {
- /* There's no more buffered data.... */
+ /*
+ * There's no more buffered data...
+ */
if (statePtr->flags & CHANNEL_EOF) {
- /* ...and there never will be. */
+ /*
+ * ...and there never will be.
+ */
*p++ = '\r';
bytesToRead--;
bufPtr->nextRemoved++;
} else if (statePtr->flags & CHANNEL_BLOCKED) {
- /* ...and we cannot get more now. */
+ /*
+ * ...and we cannot get more now.
+ */
+
SetFlag(statePtr, CHANNEL_NEED_MORE_DATA);
break;
} else {
- /* ... so we need to get some. */
+ /*
+ * ...so we need to get some.
+ */
+
goto moreData;
}
}
if (bufPtr->nextPtr) {
- /* There's a next buffer. Shift orphan \r to it. */
+ /*
+ * There's a next buffer. Shift orphan \r to it.
+ */
ChannelBuffer *nextPtr = bufPtr->nextPtr;
@@ -9914,8 +9956,8 @@ DoRead(
}
/*
- * When there's no buffered data to read, and we're at EOF,
- * escape to the caller.
+ * When there's no buffered data to read, and we're at EOF, escape to
+ * the caller.
*/
if (GotFlag(statePtr, CHANNEL_EOF)
@@ -9927,11 +9969,11 @@ DoRead(
ResetFlag(statePtr, CHANNEL_BLOCKED);
}
- assert(!GotFlag(statePtr, CHANNEL_EOF)
- || GotFlag(statePtr, CHANNEL_STICKY_EOF)
- || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
- assert( !(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
- == (CHANNEL_EOF|CHANNEL_BLOCKED)) );
+ assert(!GotFlag(statePtr, CHANNEL_EOF)
+ || GotFlag(statePtr, CHANNEL_STICKY_EOF)
+ || Tcl_InputBuffered((Tcl_Channel)chanPtr) == 0);
+ assert(!(GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)
+ == (CHANNEL_EOF|CHANNEL_BLOCKED)));
UpdateInterest(chanPtr);
TclChannelRelease((Tcl_Channel)chanPtr);
return (int)(p - dst);
@@ -11168,11 +11210,11 @@ DupChannelIntRep(
register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
- ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedChanName *resPtr;
- resPtr->refCount++;
- copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
- copyPtr->typePtr = srcPtr->typePtr;
+ ChanGetIntRep(srcPtr, resPtr);
+ assert(resPtr);
+ ChanSetIntRep(copyPtr, resPtr);
}
/*
@@ -11195,10 +11237,11 @@ static void
FreeChannelIntRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedChanName *resPtr;
- objPtr->typePtr = NULL;
- if (--resPtr->refCount) {
+ ChanGetIntRep(objPtr, resPtr);
+ assert(resPtr);
+ if (resPtr->refCount-- > 1) {
return;
}
Tcl_Release(resPtr->statePtr);
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ffbfa31..15f0f78 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -96,7 +96,7 @@ typedef struct EventScriptRecord {
typedef struct Channel {
struct ChannelState *state; /* Split out state information */
- ClientData instanceData; /* Instance-specific data provided by creator
+ void *instanceData; /* Instance-specific data provided by creator
* of channel. */
const Tcl_ChannelType *typePtr; /* Pointer to channel type structure. */
struct Channel *downChanPtr;/* Refers to channel this one was stacked
@@ -214,7 +214,7 @@ typedef struct ChannelState {
* because it happened in the background. The
* value is the chanMg, if any. #219's
* companion to 'unreportedError'. */
- int epoch; /* Used to test validity of stored channelname
+ size_t epoch; /* Used to test validity of stored channelname
* lookup results. */
} ChannelState;
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 834f225..1dd8666 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,7 +16,7 @@
*/
typedef struct AcceptCallback {
- char *script; /* Script to invoke. */
+ Tcl_Obj *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
@@ -25,7 +25,7 @@ typedef struct AcceptCallback {
* It must be per-thread because of std channel limitations.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
Tcl_Obj *stdoutObjPtr; /* Cached stdout channel Tcl_Obj */
} ThreadSpecificData;
@@ -37,8 +37,7 @@ static Tcl_ThreadDataKey dataKey;
*/
static void FinalizeIOCmdTSD(ClientData clientData);
-static void AcceptCallbackProc(ClientData callbackData,
- Tcl_Channel chan, char *address, int port);
+static Tcl_TcpAcceptProc AcceptCallbackProc;
static int ChanPendingObjCmd(ClientData unused,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -114,7 +113,6 @@ Tcl_PutsObjCmd(
int newline; /* Add a newline at end? */
int result; /* Result of puts operation. */
int mode; /* Mode in which channel is opened. */
- ThreadSpecificData *tsdPtr;
switch (objc) {
case 2: /* [puts $x] */
@@ -139,7 +137,7 @@ Tcl_PutsObjCmd(
chanObjPtr = objv[2];
string = objv[3];
break;
-#if TCL_MAJOR_VERSION < 9
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
/*
* The code below provides backwards compatibility with an old
@@ -161,7 +159,7 @@ Tcl_PutsObjCmd(
}
if (chanObjPtr == NULL) {
- tsdPtr = TCL_TSD_INIT(&dataKey);
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->initialized) {
tsdPtr->initialized = 1;
@@ -441,7 +439,7 @@ Tcl_ReadObjCmd(
if (i < objc) {
if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
|| (toRead < 0)) {
-#if TCL_MAJOR_VERSION < 9
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
* The code below provides backwards compatibility with an old
* form of the command that is no longer recommended or
@@ -456,7 +454,7 @@ Tcl_ReadObjCmd(
TclGetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
return TCL_ERROR;
-#if TCL_MAJOR_VERSION < 9
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
}
newline = 1;
#endif
@@ -561,7 +559,7 @@ Tcl_SeekObjCmd(
TclChannelPreserve(chan);
result = Tcl_Seek(chan, offset, mode);
- if (result == Tcl_LongAsWide(-1)) {
+ if (result == -1) {
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area and
@@ -993,7 +991,7 @@ Tcl_ExecObjCmd(
resultPtr = Tcl_NewObj();
if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
- if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
+ if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
/*
* TIP #219.
* Capture error messages put by the driver into the bypass area
@@ -1373,15 +1371,22 @@ AcceptCallbackProc(
*/
if (acceptCallbackPtr->interp != NULL) {
- char portBuf[TCL_INTEGER_SPACE];
- char *script = acceptCallbackPtr->script;
Tcl_Interp *interp = acceptCallbackPtr->interp;
- int result;
+ Tcl_Obj *script, *objv[2];
+ int result = TCL_OK;
- Tcl_Preserve(script);
- Tcl_Preserve(interp);
+ objv[0] = acceptCallbackPtr->script;
+ objv[1] = Tcl_NewListObj(3, NULL);
+ Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(
+ Tcl_GetChannelName(chan), -1));
+ Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewStringObj(address, -1));
+ Tcl_ListObjAppendElement(NULL, objv[1], Tcl_NewIntObj(port));
+
+ script = Tcl_ConcatObj(2, objv);
+ Tcl_IncrRefCount(script);
+ Tcl_DecrRefCount(objv[1]);
- TclFormatInt(portBuf, port);
+ Tcl_Preserve(interp);
Tcl_RegisterChannel(interp, chan);
/*
@@ -1391,8 +1396,9 @@ AcceptCallbackProc(
Tcl_RegisterChannel(NULL, chan);
- result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
- " ", address, " ", portBuf, NULL);
+ result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
+ Tcl_DecrRefCount(script);
+
if (result != TCL_OK) {
Tcl_BackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
@@ -1406,7 +1412,6 @@ AcceptCallbackProc(
Tcl_UnregisterChannel(NULL, chan);
Tcl_Release(interp);
- Tcl_Release(script);
} else {
/*
* The interpreter has been deleted, so there is no useful way to use
@@ -1450,7 +1455,7 @@ TcpServerCloseProc(
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
- Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
+ Tcl_DecrRefCount(acceptCallbackPtr->script);
ckfree(acceptCallbackPtr);
}
@@ -1479,13 +1484,18 @@ Tcl_SocketObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const socketOptions[] = {
- "-async", "-myaddr", "-myport", "-server", NULL
+ "-async", "-myaddr", "-myport", "-reuseaddr", "-reuseport", "-server",
+ NULL
};
enum socketOptions {
- SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
+ SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_REUSEADDR, SKT_REUSEPORT,
+ SKT_SERVER
};
- int optionIndex, a, server = 0, port, myport = 0, async = 0;
- const char *host, *script = NULL, *myaddr = NULL;
+ int optionIndex, a, server = 0, myport = 0, async = 0, reusep = -1,
+ reusea = -1;
+ unsigned int flags = 0;
+ const char *host, *port, *myaddr = NULL;
+ Tcl_Obj *script = NULL;
Tcl_Channel chan;
if (TclpHasSockets(interp) != TCL_OK) {
@@ -1548,7 +1558,29 @@ Tcl_SocketObjCmd(
"no argument given for -server option", -1));
return TCL_ERROR;
}
- script = TclGetString(objv[a]);
+ script = objv[a];
+ break;
+ case SKT_REUSEADDR:
+ a++;
+ if (a >= objc) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -reuseaddr option", -1));
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[a], &reusea) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
+ case SKT_REUSEPORT:
+ a++;
+ if (a >= objc) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "no argument given for -reuseport option", -1));
+ return TCL_ERROR;
+ }
+ if (Tcl_GetBooleanFromObj(interp, objv[a], &reusep) != TCL_OK) {
+ return TCL_ERROR;
+ }
break;
default:
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
@@ -1573,32 +1605,63 @@ Tcl_SocketObjCmd(
"?-myaddr addr? ?-myport myport? ?-async? host port");
iPtr->flags |= INTERP_ALTERNATE_WRONG_ARGS;
Tcl_WrongNumArgs(interp, 1, objv,
- "-server command ?-myaddr addr? port");
+ "-server command ?-reuseaddr boolean? ?-reuseport boolean? "
+ "?-myaddr addr? port");
return TCL_ERROR;
}
- if (a == objc-1) {
- if (TclSockGetPort(interp, TclGetString(objv[a]), "tcp",
- &port) != TCL_OK) {
- return TCL_ERROR;
- }
- } else {
+ if (!server && (reusea != -1 || reusep != -1)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "options -reuseaddr and -reuseport are only valid for servers",
+ -1));
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set the options to their default value if the user didn't override
+ * their value.
+ */
+
+ if (reusep == -1) {
+ reusep = 0;
+ }
+ if (reusea == -1) {
+ reusea = 1;
+ }
+
+ /*
+ * Build the bitset with the flags values.
+ */
+
+ if (reusea) {
+ flags |= TCL_TCPSERVER_REUSEADDR;
+ }
+ if (reusep) {
+ flags |= TCL_TCPSERVER_REUSEPORT;
+ }
+
+ /*
+ * All the arguments should have been parsed by now, 'a' points to the
+ * last one, the port number.
+ */
+
+ if (a != objc-1) {
goto wrongNumArgs;
}
+ port = TclGetString(objv[a]);
+
if (server) {
- AcceptCallback *acceptCallbackPtr =
- ckalloc(sizeof(AcceptCallback));
- unsigned len = strlen(script) + 1;
- char *copyScript = ckalloc(len);
+ AcceptCallback *acceptCallbackPtr = ckalloc(sizeof(AcceptCallback));
- memcpy(copyScript, script, len);
- acceptCallbackPtr->script = copyScript;
+ Tcl_IncrRefCount(script);
+ acceptCallbackPtr->script = script;
acceptCallbackPtr->interp = interp;
- chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
- acceptCallbackPtr);
+
+ chan = Tcl_OpenTcpServerEx(interp, port, host, flags,
+ AcceptCallbackProc, acceptCallbackPtr);
if (chan == NULL) {
- ckfree(copyScript);
+ Tcl_DecrRefCount(script);
ckfree(acceptCallbackPtr);
return TCL_ERROR;
}
@@ -1620,7 +1683,13 @@ Tcl_SocketObjCmd(
Tcl_CreateCloseHandler(chan, TcpServerCloseProc, acceptCallbackPtr);
} else {
- chan = Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async);
+ int portNum;
+
+ if (TclSockGetPort(interp, port, "tcp", &portNum) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ chan = Tcl_OpenTcpClient(interp, portNum, host, myaddr, myport, async);
if (chan == NULL) {
return TCL_ERROR;
}
@@ -1844,7 +1913,7 @@ ChanTruncateObjCmd(
*/
length = Tcl_Tell(chan);
- if (length == Tcl_WideAsLong(-1)) {
+ if (length == -1) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"could not determine current location in \"%s\": %s",
TclGetString(objv[1]), Tcl_PosixError(interp)));
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index 7f61def..9949a0e 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -211,7 +211,7 @@ struct TransformChannelData {
* a transformation of incoming data. Also
* serves as buffer of all data not yet
* consumed by the reader. */
- int refCount;
+ size_t refCount;
};
static void
@@ -225,7 +225,7 @@ static void
ReleaseData(
TransformChannelData *dataPtr)
{
- if (--dataPtr->refCount) {
+ if (dataPtr->refCount-- > 1) {
return;
}
ResultClear(&dataPtr->result);
@@ -910,7 +910,7 @@ TransformWideSeekProc(
Tcl_ChannelWideSeekProc(parentType);
ClientData parentData = Tcl_GetChannelInstanceData(parent);
- if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
+ if ((offset == 0) && (mode == SEEK_CUR)) {
/*
* This is no seek but a request to tell the caller the current
* location. Simply pass the request down.
@@ -920,8 +920,7 @@ TransformWideSeekProc(
return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
}
- return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
- errorCodePtr));
+ return parentSeekProc(parentData, 0, mode, errorCodePtr);
}
/*
@@ -961,13 +960,13 @@ TransformWideSeekProc(
* to go out of the representable range.
*/
- if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+ if (offset<LONG_MIN || offset>LONG_MAX) {
*errorCodePtr = EOVERFLOW;
- return Tcl_LongAsWide(-1);
+ return -1;
}
- return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
- mode, errorCodePtr));
+ return parentSeekProc(parentData, offset,
+ mode, errorCodePtr);
}
/*
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index e862761..611ee3f 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -39,7 +39,7 @@ static int ReflectOutput(ClientData clientData, const char *buf,
int toWrite, int *errorCodePtr);
static void ReflectWatch(ClientData clientData, int mask);
static int ReflectBlock(ClientData clientData, int mode);
-#ifdef TCL_THREADS
+#if TCL_THREADS
static void ReflectThread(ClientData clientData, int action);
static int ReflectEventRun(Tcl_Event *ev, int flags);
static int ReflectEventDelete(Tcl_Event *ev, ClientData cd);
@@ -76,7 +76,7 @@ static const Tcl_ChannelType tclRChannelType = {
NULL, /* Flush channel. Not used by core. NULL'able */
NULL, /* Handle events. NULL'able */
ReflectSeekWide, /* Move access point (64 bit). NULL'able */
-#ifdef TCL_THREADS
+#if TCL_THREADS
ReflectThread, /* thread action, tracking owner */
#else
NULL, /* thread action */
@@ -97,7 +97,7 @@ typedef struct {
* interpreter/thread containing its Tcl
* command is gone.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */
Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */
#endif
@@ -201,7 +201,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -236,7 +236,7 @@ typedef enum {
* sharing problems.
*/
-typedef struct ForwardParamBase {
+typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
@@ -311,7 +311,7 @@ typedef struct ForwardingResult ForwardingResult;
* General event structure, with reference to operation specific data.
*/
-typedef struct ForwardingEvent {
+typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
@@ -348,7 +348,7 @@ struct ForwardingResult {
* results. */
};
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* Table of all reflected channels owned by this thread. This is the
* per-thread version of the per-interpreter map.
@@ -451,7 +451,7 @@ static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
-#ifdef TCL_THREADS
+#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost = "{Owner lost}";
@@ -593,7 +593,7 @@ TclChanCreateObjCmd(
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
- Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
+ TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -619,35 +619,35 @@ TclChanCreateObjCmd(
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" does not support all required methods",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" lacks a \"read\" method",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" lacks a \"write\" method",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
@@ -706,7 +706,7 @@ TclChanCreateObjCmd(
Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
}
Tcl_SetHashValue(hPtr, chan);
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
&isNew);
@@ -725,7 +725,7 @@ TclChanCreateObjCmd(
Tcl_DecrRefCount(rcPtr->name);
Tcl_DecrRefCount(rcPtr->methods);
Tcl_DecrRefCount(rcPtr->cmd);
- ckfree((char*) rcPtr);
+ ckfree(rcPtr);
return TCL_ERROR;
#undef MODE
@@ -750,8 +750,8 @@ TclChanCreateObjCmd(
*----------------------------------------------------------------------
*/
-#ifdef TCL_THREADS
-typedef struct ReflectEvent {
+#if TCL_THREADS
+typedef struct {
Tcl_Event header;
ReflectedChannel *rcPtr;
int events;
@@ -855,11 +855,12 @@ TclChanPostEventObjCmd(
}
/*
- * Note that the search above subsumes several of the older checks, namely:
+ * Note that the search above subsumes several of the older checks,
+ * namely:
*
- * (1) Does the channel handle refer to a reflected channel ?
+ * (1) Does the channel handle refer to a reflected channel?
* (2) Is the post event issued from the interpreter holding the handler
- * of the reflected channel ?
+ * of the reflected channel?
*
* A successful search answers yes to both. Because the map holds only
* handles of reflected channels, and only of such whose handler is
@@ -916,11 +917,11 @@ TclChanPostEventObjCmd(
* We have the channel and the events to post.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->owner == rcPtr->thread) {
#endif
Tcl_NotifyChannel(chan, events);
-#ifdef TCL_THREADS
+#if TCL_THREADS
} else {
ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));
@@ -943,7 +944,8 @@ TclChanPostEventObjCmd(
(void) GetThreadReflectedChannelMap();
- /* XXX Race condition !!
+ /*
+ * XXX Race condition !!
* XXX The destination thread may not exist anymore already.
* XXX (Delayed postevent executed after channel got removed).
* XXX Can we detect this ? (check the validity of the owner threadid ?)
@@ -1135,7 +1137,7 @@ ReflectClose(
* if lost?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1156,7 +1158,7 @@ ReflectClose(
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
if (tctPtr && tctPtr != &tclRChannelType) {
- ckfree((char *)tctPtr);
+ ckfree(tctPtr);
((Channel *)rcPtr->chan)->typePtr = NULL;
}
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
@@ -1167,7 +1169,7 @@ ReflectClose(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1214,7 +1216,7 @@ ReflectClose(
Tcl_DeleteHashEntry(hPtr);
}
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcmPtr = GetThreadReflectedChannelMap();
hPtr = Tcl_FindHashEntry(&rcmPtr->map,
Tcl_GetChannelName(rcPtr->chan));
@@ -1225,8 +1227,8 @@ ReflectClose(
#endif
tctPtr = ((Channel *)rcPtr->chan)->typePtr;
if (tctPtr && tctPtr != &tclRChannelType) {
- ckfree((char *)tctPtr);
- ((Channel *)rcPtr->chan)->typePtr = NULL;
+ ckfree(tctPtr);
+ ((Channel *)rcPtr->chan)->typePtr = NULL;
}
Tcl_EventuallyFree(rcPtr, (Tcl_FreeProc *) FreeReflectedChannel);
return (result == TCL_OK) ? EOK : EINVAL;
@@ -1265,7 +1267,7 @@ ReflectInput(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1276,7 +1278,10 @@ ReflectInput(
if (p.base.code != TCL_OK) {
if (p.base.code < 0) {
- /* No error message, this is an errno signal. */
+ /*
+ * No error message, this is an errno signal.
+ */
+
*errorCodePtr = -p.base.code;
} else {
PassReceivedError(rcPtr->chan, &p);
@@ -1368,7 +1373,7 @@ ReflectOutput(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1379,7 +1384,10 @@ ReflectOutput(
if (p.base.code != TCL_OK) {
if (p.base.code < 0) {
- /* No error message, this is an errno signal. */
+ /*
+ * No error message, this is an errno signal.
+ */
+
*errorCodePtr = -p.base.code;
} else {
PassReceivedError(rcPtr->chan, &p);
@@ -1430,8 +1438,8 @@ ReflectOutput(
if ((written == 0) && (toWrite > 0)) {
/*
- * The handler claims to have written nothing of what it was
- * given. That is bad.
+ * The handler claims to have written nothing of what it was given.
+ * That is bad.
*/
SetChannelErrorStr(rcPtr->chan, msg_write_nothing);
@@ -1494,7 +1502,7 @@ ReflectSeekWide(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1536,7 +1544,7 @@ ReflectSeekWide(
goto invalid;
}
- if (newLoc < Tcl_LongAsWide(0)) {
+ if (newLoc < 0) {
SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
goto invalid;
}
@@ -1568,7 +1576,7 @@ ReflectSeek(
* routine.
*/
- return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+ return ReflectSeekWide(clientData, offset, seekMode,
errorCodePtr);
}
@@ -1617,7 +1625,7 @@ ReflectWatch(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1675,7 +1683,7 @@ ReflectBlock(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1711,7 +1719,7 @@ ReflectBlock(
return errorNum;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -1781,7 +1789,7 @@ ReflectSetOption(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1860,7 +1868,7 @@ ReflectGetOption(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rcPtr->thread != Tcl_GetCurrentThread()) {
int opcode;
ForwardParam p;
@@ -1950,7 +1958,7 @@ ReflectGetOption(
goto error;
} else {
int len;
- const char *str = Tcl_GetStringFromObj(resObj, &len);
+ const char *str = TclGetStringFromObj(resObj, &len);
if (len) {
TclDStringAppendLiteral(dsPtr, " ");
@@ -2123,7 +2131,7 @@ NewReflectedChannel(
rcPtr->chan = NULL;
rcPtr->interp = interp;
rcPtr->dead = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
rcPtr->thread = Tcl_GetCurrentThread();
#endif
rcPtr->mode = mode;
@@ -2323,7 +2331,7 @@ InvokeTclMethod(
if (result != TCL_ERROR) {
int cmdLen;
- const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+ const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
Tcl_IncrRefCount(cmd);
Tcl_ResetResult(rcPtr->interp);
@@ -2377,8 +2385,8 @@ InvokeTclMethod(
* None.
*
* Users:
- * ReflectInput/Output(), to enable the signaling of EAGAIN
- * on 0-sized short reads/writes.
+ * ReflectInput/Output(), to enable the signaling of EAGAIN on 0-sized
+ * short reads/writes.
*
*----------------------------------------------------------------------
*/
@@ -2402,7 +2410,7 @@ ErrnoReturn(
if (((Tcl_GetIntFromObj(rcPtr->interp, resObj, &code) != TCL_OK)
|| (code >= 0))) {
- if (strcmp("EAGAIN", Tcl_GetString(resObj)) == 0) {
+ if (strcmp("EAGAIN", TclGetString(resObj)) == 0) {
code = -EAGAIN;
} else {
code = 0;
@@ -2498,7 +2506,7 @@ DeleteReflectedChannelMap(
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedChannel *rcPtr;
Tcl_Channel chan;
-#ifdef TCL_THREADS
+#if TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2528,7 +2536,7 @@ DeleteReflectedChannelMap(
Tcl_DeleteHashTable(&rcmPtr->map);
ckfree(&rcmPtr->map);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2564,7 +2572,10 @@ DeleteReflectedChannelMap(
evPtr = resultPtr->evPtr;
- /* Basic crash safety until this routine can get revised [3411310] */
+ /*
+ * Basic crash safety until this routine can get revised [3411310]
+ */
+
if (evPtr == NULL) {
continue;
}
@@ -2611,7 +2622,7 @@ DeleteReflectedChannelMap(
#endif
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -2679,8 +2690,8 @@ DeleteThreadReflectedChannelMap(
/*
* Go through the list of pending results and cancel all whose events were
- * destined for this thread. While this is in progress we block any
- * other access to the list of pending results.
+ * destined for this thread. While this is in progress we block any other
+ * access to the list of pending results.
*/
Tcl_MutexLock(&rcForwardMutex);
@@ -2711,7 +2722,10 @@ DeleteThreadReflectedChannelMap(
evPtr = resultPtr->evPtr;
- /* Basic crash safety until this routine can get revised [3411310] */
+ /*
+ * Basic crash safety until this routine can get revised [3411310]
+ */
+
if (evPtr == NULL ) {
continue;
}
@@ -2765,8 +2779,8 @@ ForwardOpToHandlerThread(
const void *param) /* Arguments */
{
/*
- * Core of the communication from OWNER to HANDLER thread.
- * The receiver is ForwardProc() below.
+ * Core of the communication from OWNER to HANDLER thread. The receiver is
+ * ForwardProc() below.
*/
Tcl_ThreadId dst = rcPtr->thread;
@@ -2816,7 +2830,10 @@ ForwardOpToHandlerThread(
*/
TclSpliceIn(resultPtr, forwardList);
- /* Do not unlock here. That is done by the ConditionWait */
+
+ /*
+ * Do not unlock here. That is done by the ConditionWait.
+ */
/*
* Ensure cleanup of the event if the origin thread exits while this event
@@ -2892,7 +2909,7 @@ ForwardProc(
* Notes regarding access to the referenced data.
*
* In principle the data belongs to the originating thread (see
- * evPtr->src), however this thread is currently blocked at (*), i.e.
+ * evPtr->src), however this thread is currently blocked at (*), i.e.,
* quiescent. Because of this we can treat the data as belonging to us,
* without fear of race conditions. I.e. we can read and write as we like.
*
@@ -3062,7 +3079,7 @@ ForwardProc(
Tcl_WideInt newLoc;
if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
- if (newLoc < Tcl_LongAsWide(0)) {
+ if (newLoc < 0) {
ForwardSetStaticError(paramPtr, msg_seek_beforestart);
paramPtr->seek.offset = -1;
} else {
@@ -3178,7 +3195,7 @@ ForwardProc(
ForwardSetDynamicError(paramPtr, buf);
} else {
int len;
- const char *str = Tcl_GetStringFromObj(resObj, &len);
+ const char *str = TclGetStringFromObj(resObj, &len);
if (len) {
TclDStringAppendLiteral(paramPtr->getOpt.value, " ");
@@ -3277,7 +3294,7 @@ ForwardSetObjError(
Tcl_Obj *obj)
{
int len;
- const char *msgStr = Tcl_GetStringFromObj(obj, &len);
+ const char *msgStr = TclGetStringFromObj(obj, &len);
len++;
ForwardSetDynamicError(paramPtr, ckalloc(len));
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index af86ba5..4841e39 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -87,7 +87,7 @@ static const Tcl_ChannelType tclRTransformType = {
* layers upon reading from the channel, plus the functions to manage such.
*/
-typedef struct _ResultBuffer_ {
+typedef struct {
unsigned char *buf; /* Reference to the buffer area. */
int allocated; /* Allocated size of the buffer area. */
int used; /* Number of bytes in the buffer,
@@ -127,7 +127,7 @@ typedef struct {
* in the argv, see below. The separate field
* gives us direct access, needed when working
* with the reflection maps. */
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_ThreadId thread; /* Thread the 'interp' belongs to. */
#endif
@@ -220,7 +220,7 @@ typedef enum {
#define NEGIMPL(a,b)
#define HAS(x,f) (x & FLAG(f))
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Thread specific types and structures.
*
@@ -253,7 +253,7 @@ typedef enum {
* sharing problems.
*/
-typedef struct ForwardParamBase {
+typedef struct {
int code; /* O: Ok/Fail of the cmd handler */
char *msgStr; /* O: Error message for handler failure */
int mustFree; /* O: True if msgStr is allocated, false if
@@ -298,7 +298,7 @@ typedef struct ForwardingResult ForwardingResult;
* General event structure, with reference to operation specific data.
*/
-typedef struct ForwardingEvent {
+typedef struct {
Tcl_Event event; /* Basic event data, has to be first item */
ForwardingResult *resultPtr;
ForwardedOperation op; /* Forwarded driver operation */
@@ -329,7 +329,7 @@ struct ForwardingResult {
* results. */
};
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* Table of all reflected transformations owned by this thread.
*/
@@ -438,7 +438,7 @@ static void DeleteReflectedTransformMap(ClientData clientData,
static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
-#ifdef TCL_THREADS
+#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
@@ -554,7 +554,7 @@ TclChanPushObjCmd(
*/
chanObj = objv[CHAN];
- parentChan = Tcl_GetChannel(interp, Tcl_GetString(chanObj), &mode);
+ parentChan = Tcl_GetChannel(interp, TclGetString(chanObj), &mode);
if (parentChan == NULL) {
return TCL_ERROR;
}
@@ -608,7 +608,7 @@ TclChanPushObjCmd(
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned non-list: %s",
- Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
+ TclGetString(cmdObj), TclGetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -619,7 +619,7 @@ TclChanPushObjCmd(
"method", TCL_EXACT, &methIndex) != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s initialize\" returned %s",
- Tcl_GetString(cmdObj),
+ TclGetString(cmdObj),
Tcl_GetString(Tcl_GetObjResult(interp))));
Tcl_DecrRefCount(resObj);
goto error;
@@ -633,7 +633,7 @@ TclChanPushObjCmd(
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" does not support all required methods",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
@@ -655,7 +655,7 @@ TclChanPushObjCmd(
if (!mode) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" makes the channel inaccessible",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
@@ -666,14 +666,14 @@ TclChanPushObjCmd(
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"drain\" but not \"read\"",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"chan handler \"%s\" supports \"flush\" but not \"write\"",
- Tcl_GetString(cmdObj)));
+ TclGetString(cmdObj)));
goto error;
}
@@ -694,14 +694,14 @@ TclChanPushObjCmd(
*/
rtmPtr = GetReflectedTransformMap(interp);
- hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
+ hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
}
Tcl_SetHashValue(hPtr, rtPtr);
-#ifdef TCL_THREADS
+#if TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
- hPtr = Tcl_CreateHashEntry(&rtmPtr->map, Tcl_GetString(rtId), &isNew);
+ hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */
@@ -911,7 +911,7 @@ ReflectClose(
* if lost?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -938,7 +938,7 @@ ReflectClose(
if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
if (!TransformDrain(rtPtr, &errorCode)) {
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
@@ -952,7 +952,7 @@ ReflectClose(
if (HAS(rtPtr->methods, METH_FLUSH)) {
if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
Tcl_EventuallyFree(rtPtr,
(Tcl_FreeProc *) FreeReflectedTransform);
@@ -968,7 +968,7 @@ ReflectClose(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -1025,9 +1025,9 @@ ReflectClose(
* under a channel by deleting the owning thread.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
rtmPtr = GetThreadReflectedTransformMap();
- hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
if (hPtr) {
Tcl_DeleteHashEntry(hPtr);
}
@@ -1340,7 +1340,7 @@ ReflectSeekWide(
if (seekProc == NULL) {
Tcl_SetErrno(EINVAL);
- return Tcl_LongAsWide(-1);
+ return -1;
}
/*
@@ -1390,16 +1390,15 @@ ReflectSeekWide(
parent->typePtr->wideSeekProc != NULL) {
curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
seekMode, errorCodePtr);
- } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
- offset > Tcl_LongAsWide(LONG_MAX)) {
+ } else if (offset < LONG_MIN || offset > LONG_MAX) {
*errorCodePtr = EOVERFLOW;
- curPos = Tcl_LongAsWide(-1);
+ curPos = -1;
} else {
- curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
- parent->instanceData, Tcl_WideAsLong(offset), seekMode,
- errorCodePtr));
+ curPos = parent->typePtr->seekProc(
+ parent->instanceData, offset, seekMode,
+ errorCodePtr);
}
- if (curPos == Tcl_LongAsWide(-1)) {
+ if (curPos == -1) {
Tcl_SetErrno(*errorCodePtr);
}
@@ -1422,7 +1421,7 @@ ReflectSeek(
* routine.
*/
- return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+ return ReflectSeekWide(clientData, offset, seekMode,
errorCodePtr);
}
@@ -1767,7 +1766,7 @@ NewReflectedTransform(
rtPtr->chan = NULL;
rtPtr->methods = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
rtPtr->thread = Tcl_GetCurrentThread();
#endif
rtPtr->parent = parentChan;
@@ -2043,7 +2042,7 @@ InvokeTclMethod(
if (result != TCL_ERROR) {
Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
int cmdLen;
- const char *cmdString = Tcl_GetStringFromObj(cmd, &cmdLen);
+ const char *cmdString = TclGetStringFromObj(cmd, &cmdLen);
Tcl_IncrRefCount(cmd);
Tcl_ResetResult(rtPtr->interp);
@@ -2152,7 +2151,7 @@ DeleteReflectedTransformMap(
Tcl_HashSearch hSearch; /* Search variable. */
Tcl_HashEntry *hPtr; /* Search variable. */
ReflectedTransform *rtPtr;
-#ifdef TCL_THREADS
+#if TCL_THREADS
ForwardingResult *resultPtr;
ForwardingEvent *evPtr;
ForwardParam *paramPtr;
@@ -2182,7 +2181,7 @@ DeleteReflectedTransformMap(
Tcl_DeleteHashTable(&rtmPtr->map);
ckfree(&rtmPtr->map);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* The origin interpreter for one or more reflected channels is gone.
*/
@@ -2254,7 +2253,7 @@ DeleteReflectedTransformMap(
#endif /* TCL_THREADS */
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -2568,7 +2567,7 @@ ForwardProc(
*/
rtmPtr = GetReflectedTransformMap(interp);
- hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
Tcl_DeleteHashEntry(hPtr);
/*
@@ -2578,7 +2577,7 @@ ForwardProc(
*/
rtmPtr = GetThreadReflectedTransformMap();
- hPtr = Tcl_FindHashEntry(&rtmPtr->map, Tcl_GetString(rtPtr->handle));
+ hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
Tcl_DeleteHashEntry(hPtr);
FreeReflectedTransformArgs(rtPtr);
@@ -2807,7 +2806,7 @@ ForwardSetObjError(
Tcl_Obj *obj)
{
int len;
- const char *msgStr = Tcl_GetStringFromObj(obj, &len);
+ const char *msgStr = TclGetStringFromObj(obj, &len);
len++;
ForwardSetDynamicError(paramPtr, ckalloc(len));
@@ -2955,7 +2954,7 @@ ResultClear(
return;
}
- ckfree((char *) rPtr->buf);
+ ckfree(rPtr->buf);
rPtr->buf = NULL;
rPtr->allocated = 0;
}
@@ -3088,7 +3087,7 @@ TransformRead(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3144,7 +3143,7 @@ TransformWrite(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3210,7 +3209,7 @@ TransformDrain(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3260,7 +3259,7 @@ TransformFlush(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3315,7 +3314,7 @@ TransformClear(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
@@ -3347,7 +3346,7 @@ TransformLimit(
* Are we in the correct thread?
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (rtPtr->thread != Tcl_GetCurrentThread()) {
ForwardParam p;
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index c5b7d28..12e2900 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -11,17 +11,22 @@
#include "tclInt.h"
-#if defined(_WIN32) && defined(UNICODE)
-/* On Windows, we need to do proper Unicode->UTF-8 conversion. */
+#if defined(_WIN32)
+/*
+ * On Windows, we need to do proper Unicode->UTF-8 conversion.
+ */
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized;
Tcl_DString errorMsg; /* UTF-8 encoded error-message */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
#undef gai_strerror
-static const char *gai_strerror(int code) {
+static const char *
+gai_strerror(
+ int code)
+{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
if (tsdPtr->initialized) {
@@ -56,8 +61,8 @@ static const char *gai_strerror(int code) {
int
TclSockGetPort(
Tcl_Interp *interp,
- const char *string, /* Integer or service name */
- const char *proto, /* "tcp" or "udp", typically */
+ const char *string, /* Integer or service name */
+ const char *proto, /* "tcp" or "udp", typically */
int *portPtr) /* Return port number */
{
struct servent *sp; /* Protocol info for named services */
@@ -126,7 +131,7 @@ TclSockMinimumBuffers(
}
len = sizeof(int);
getsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
- (char *) &current, &len);
+ (char *) &current, &len);
if (current < size) {
len = sizeof(int);
setsockopt((SOCKET)(size_t) sock, SOL_SOCKET, SO_RCVBUF,
@@ -154,15 +159,15 @@ TclSockMinimumBuffers(
int
TclCreateSocketAddress(
- Tcl_Interp *interp, /* Interpreter for querying
- * the desired socket family */
- struct addrinfo **addrlist, /* Socket address list */
- const char *host, /* Host. NULL implies INADDR_ANY */
- int port, /* Port number */
- int willBind, /* Is this an address to bind() to or
- * to connect() to? */
- const char **errorMsgPtr) /* Place to store the error message
- * detail, if available. */
+ Tcl_Interp *interp, /* Interpreter for querying the desired socket
+ * family */
+ struct addrinfo **addrlist, /* Socket address list */
+ const char *host, /* Host. NULL implies INADDR_ANY */
+ int port, /* Port number */
+ int willBind, /* Is this an address to bind() to or to
+ * connect() to? */
+ const char **errorMsgPtr) /* Place to store the error message detail, if
+ * available. */
{
struct addrinfo hints;
struct addrinfo *p;
@@ -181,30 +186,31 @@ TclCreateSocketAddress(
* Workaround for OSX's apparent inability to resolve "localhost", "0"
* when the loopback device is the only available network interface.
*/
+
if (host != NULL && port == 0) {
- portstring = NULL;
+ portstring = NULL;
} else {
- TclFormatInt(portbuf, port);
- portstring = portbuf;
+ TclFormatInt(portbuf, port);
+ portstring = portbuf;
}
(void) memset(&hints, 0, sizeof(hints));
hints.ai_family = AF_UNSPEC;
/*
- * Magic variable to enforce a certain address family - to be superseded
- * by a TIP that adds explicit switches to [socket]
+ * Magic variable to enforce a certain address family; to be superseded
+ * by a TIP that adds explicit switches to [socket].
*/
if (interp != NULL) {
- family = Tcl_GetVar(interp, "::tcl::unsupported::socketAF", 0);
- if (family != NULL) {
- if (strcmp(family, "inet") == 0) {
- hints.ai_family = AF_INET;
- } else if (strcmp(family, "inet6") == 0) {
- hints.ai_family = AF_INET6;
- }
- }
+ family = Tcl_GetVar2(interp, "::tcl::unsupported::socketAF", NULL, 0);
+ if (family != NULL) {
+ if (strcmp(family, "inet") == 0) {
+ hints.ai_family = AF_INET;
+ } else if (strcmp(family, "inet6") == 0) {
+ hints.ai_family = AF_INET6;
+ }
+ }
}
hints.ai_socktype = SOCK_STREAM;
@@ -214,7 +220,7 @@ TclCreateSocketAddress(
* We found some problems when using AI_ADDRCONFIG, e.g. on systems that
* have no networking besides the loopback interface and want to resolve
* localhost. See [Bugs 3385024, 3382419, 3382431]. As the advantage of
- * using AI_ADDRCONFIG in situations where it works, is probably low,
+ * using AI_ADDRCONFIG is probably low even in situations where it works,
* we'll leave it out for now. After all, it is just an optimisation.
*
* Missing on: OpenBSD, NetBSD.
@@ -251,6 +257,7 @@ TclCreateSocketAddress(
*
* There might be more elegant/efficient ways to do this.
*/
+
if (willBind) {
for (p = *addrlist; p != NULL; p = p->ai_next) {
if (p->ai_family == AF_INET) {
@@ -283,6 +290,38 @@ TclCreateSocketAddress(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_OpenTcpServer --
+ *
+ * Opens a TCP server socket and creates a channel around it.
+ *
+ * Results:
+ * The channel or NULL if failed. If an error occurred, an error message
+ * is left in the interp's result if interp is not NULL.
+ *
+ * Side effects:
+ * Opens a server socket and creates a new channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Channel
+Tcl_OpenTcpServer(
+ Tcl_Interp *interp,
+ int port,
+ const char *host,
+ Tcl_TcpAcceptProc *acceptProc,
+ ClientData callbackData)
+{
+ char portbuf[TCL_INTEGER_SPACE];
+
+ TclFormatInt(portbuf, port);
+ return Tcl_OpenTcpServerEx(interp, portbuf, host, TCL_TCPSERVER_REUSEADDR,
+ acceptProc, callbackData);
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 27acbbc..63d16be 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -57,7 +57,7 @@ typedef struct FilesystemRecord {
* this information each time the corresponding epoch counter changes.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized;
size_t cwdPathEpoch;
size_t filesystemEpoch;
@@ -244,7 +244,7 @@ static Tcl_ThreadDataKey fsDataKey;
* code.
*/
-typedef struct FsDivertLoad {
+typedef struct {
Tcl_LoadHandle loadHandle;
Tcl_FSUnloadFileProc *unloadProcPtr;
Tcl_Obj *divertedFile;
@@ -275,8 +275,8 @@ Tcl_Stat(
Tcl_WideInt tmp1, tmp2, tmp3 = 0;
# define OUT_OF_RANGE(x) \
- (((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
- ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
+ (((Tcl_WideInt)(x)) < LONG_MIN || \
+ ((Tcl_WideInt)(x)) > LONG_MAX)
# define OUT_OF_URANGE(x) \
(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
@@ -542,8 +542,8 @@ TclFSCwdPointerEquals(
int len1, len2;
const char *str1, *str2;
- str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
- str2 = Tcl_GetStringFromObj(*pathPtrPtr, &len2);
+ str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+ str2 = TclGetStringFromObj(*pathPtrPtr, &len2);
if ((len1 == len2) && !memcmp(str1, str2, len1)) {
/*
* They are equal, but different objects. Update so they will be
@@ -609,6 +609,7 @@ FsRecacheFilesystemList(void)
while (toFree) {
FilesystemRecord *next = toFree->nextPtr;
+
toFree->fsPtr = NULL;
ckfree(toFree);
toFree = next;
@@ -670,7 +671,6 @@ TclFSEpoch(void)
return tsdPtr->filesystemEpoch;
}
-
/*
* If non-NULL, clientData is owned by us and must be freed later.
@@ -686,7 +686,7 @@ FsUpdateCwd(
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&fsDataKey);
if (cwdObj != NULL) {
- str = Tcl_GetStringFromObj(cwdObj, &len);
+ str = TclGetStringFromObj(cwdObj, &len);
}
Tcl_MutexLock(&cwdMutex);
@@ -782,7 +782,9 @@ TclFinalizeFilesystem(void)
while (fsRecPtr != NULL) {
FilesystemRecord *tmpFsRecPtr = fsRecPtr->nextPtr;
- /* The native filesystem is static, so we don't free it. */
+ /*
+ * The native filesystem is static, so we don't free it.
+ */
if (fsRecPtr != &nativeFilesystemRecord) {
ckfree(fsRecPtr);
@@ -827,15 +829,6 @@ TclResetFilesystem(void)
if (++theFilesystemEpoch == 0) {
++theFilesystemEpoch;
}
-
-#ifdef _WIN32
- /*
- * Cleans up the win32 API filesystem proc lookup table. This must happen
- * very late in finalization so that deleting of copied dlls can occur.
- */
-
- TclWinResetInterfaces();
-#endif
}
/*
@@ -945,7 +938,7 @@ Tcl_FSRegister(
int
Tcl_FSUnregister(
- const Tcl_Filesystem *fsPtr) /* The filesystem record to remove. */
+ const Tcl_Filesystem *fsPtr)/* The filesystem record to remove. */
{
int retVal = TCL_ERROR;
FilesystemRecord *fsRecPtr;
@@ -1222,8 +1215,8 @@ FsAddMountsToGlobResult(
if (norm != NULL) {
const char *path, *mount;
- mount = Tcl_GetStringFromObj(mElt, &mlen);
- path = Tcl_GetStringFromObj(norm, &len);
+ mount = TclGetStringFromObj(mElt, &mlen);
+ path = TclGetStringFromObj(norm, &len);
if (path[len-1] == '/') {
/*
* Deal with the root of the volume.
@@ -1231,7 +1224,7 @@ FsAddMountsToGlobResult(
len--;
}
- len++; /* account for '/' in the mElt [Bug 1602539] */
+ len++; /* account for '/' in the mElt [Bug 1602539] */
mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len);
Tcl_ListObjAppendElement(NULL, resultPtr, mElt);
}
@@ -1397,31 +1390,62 @@ TclFSNormalizeToUniquePath(
{
FilesystemRecord *fsRecPtr, *firstFsRecPtr;
+ int i;
+ int isVfsPath = 0;
+ char *path;
+
/*
- * 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).
+ * Paths starting with a UNC prefix whose final character is a colon
+ * are reserved for VFS use. These names can not conflict with real
+ * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx
+ * and rfc3986's definition of reg-name.
+ *
+ * We check these first to avoid useless calls to the native filesystem's
+ * normalizePathProc.
*/
+ path = Tcl_GetStringFromObj(pathPtr, &i);
+
+ if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/')
+ || (path[0] == '\\' && path[1] == '\\') ) ) {
+ for ( i = 2; ; i++) {
+ if (path[i] == '\0') break;
+ if (path[i] == path[0]) break;
+ }
+ --i;
+ if (path[i] == ':') isVfsPath = 1;
+ }
+ /*
+ * Call each of the "normalise path" functions in succession.
+ */
firstFsRecPtr = FsGetFirstFilesystem();
Claim();
- for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
- if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
- continue;
- }
+
+ if (!isVfsPath) {
/*
- * TODO: Assume that we always find the native file system; it should
- * always be there...
+ * 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).
*/
- if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
- startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
- startAt);
+ for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
+ if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
+ continue;
+ }
+
+ /*
+ * TODO: Assume that we always find the native file system; it should
+ * always be there...
+ */
+
+ if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+ startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+ startAt);
+ }
+ break;
}
- break;
}
for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
@@ -1523,7 +1547,7 @@ TclGetOpenModeEx(
#define RW_MODES (O_RDONLY|O_WRONLY|O_RDWR)
/*
- * Check for the simpler fopen-like access modes (e.g. "r"). They are
+ * Check for the simpler fopen-like access modes (e.g., "r"). They are
* distinguished from the POSIX access modes by the presence of a
* lower-case first letter.
*/
@@ -1783,7 +1807,7 @@ Tcl_FSEvalFileEx(
* be handled especially.
*/
- if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
+ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1798,7 +1822,7 @@ Tcl_FSEvalFileEx(
*/
if (Tcl_ReadChars(chan, objPtr, -1,
- memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
+ memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1814,7 +1838,7 @@ Tcl_FSEvalFileEx(
oldScriptFile = iPtr->scriptFile;
iPtr->scriptFile = pathPtr;
Tcl_IncrRefCount(iPtr->scriptFile);
- string = Tcl_GetStringFromObj(objPtr, &length);
+ string = TclGetStringFromObj(objPtr, &length);
/*
* TIP #280 Force the evaluator to open a frame for a sourced file.
@@ -1841,7 +1865,7 @@ Tcl_FSEvalFileEx(
* Record information telling where the error occurred.
*/
- const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
+ const char *pathString = TclGetStringFromObj(pathPtr, &length);
int limit = 150;
int overflow = (length > limit);
@@ -1888,6 +1912,7 @@ TclNREvalFile(
Tcl_GetString(pathPtr), Tcl_PosixError(interp)));
return TCL_ERROR;
}
+ TclPkgFileSeen(interp, Tcl_GetString(pathPtr));
/*
* The eofchar is \32 (^Z). This is the usual on Windows, but we effect
@@ -1917,7 +1942,7 @@ TclNREvalFile(
* be handled especially.
*/
- if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
+ if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1933,7 +1958,7 @@ TclNREvalFile(
*/
if (Tcl_ReadChars(chan, objPtr, -1,
- memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
+ memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
Tcl_Close(interp, chan);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't read file \"%s\": %s",
@@ -1992,7 +2017,7 @@ EvalFileCallback(
*/
int length;
- const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
+ const char *pathString = TclGetStringFromObj(pathPtr, &length);
const int limit = 150;
int overflow = (length > limit);
@@ -2668,6 +2693,7 @@ Tcl_FSGetCwd(
fsRecPtr = fsRecPtr->nextPtr) {
ClientData retCd;
TclFSGetCwdProc2 *proc2;
+
if (fsRecPtr->fsPtr->getCwdProc == NULL) {
continue;
}
@@ -2844,8 +2870,8 @@ Tcl_FSGetCwd(
int len1, len2;
const char *str1, *str2;
- str1 = Tcl_GetStringFromObj(tsdPtr->cwdPathPtr, &len1);
- str2 = Tcl_GetStringFromObj(norm, &len2);
+ str1 = TclGetStringFromObj(tsdPtr->cwdPathPtr, &len1);
+ str2 = TclGetStringFromObj(norm, &len2);
if ((len1 == len2) && (strcmp(str1, str2) == 0)) {
/*
* If the paths were equal, we can be more efficient and
@@ -3140,8 +3166,8 @@ Tcl_FSLoadFile(
* Workaround for issue with modern HPUX which do allow the unlink (no ETXTBSY
* error) yet somehow trash some internal data structures which prevents the
* second and further shared libraries from getting properly loaded. Only the
- * first is ok. We try to get around the issue by not unlinking,
- * i.e. emulating the behaviour of the older HPUX which denied removal.
+ * first is ok. We try to get around the issue by not unlinking, i.e.,
+ * emulating the behaviour of the older HPUX which denied removal.
*
* Doing the unlink is also an issue within docker containers, whose AUFS
* bungles this as well, see
@@ -3159,28 +3185,30 @@ Tcl_FSLoadFile(
*/
static int
-skipUnlink (Tcl_Obj* shlibFile)
+skipUnlink(
+ Tcl_Obj *shlibFile)
{
- /* Order of testing:
+ /*
+ * Order of testing:
* 1. On hpux we generally want to skip unlink in general
*
* Outside of hpux then:
- * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present, non-empty, => int)
+ * 2. For a general user request (TCL_TEMPLOAD_NO_UNLINK present,
+ * non-empty, => int)
* 3. For general AUFS environment (statfs, if available).
*
* Ad 2: This variable can disable/override the AUFS detection, i.e. for
- * testing if a newer AUFS does not have the bug any more.
+ * testing if a newer AUFS does not have the bug any more.
*
- * Ad 3: This is conditionally compiled in. Condition currently must be set manually.
- * This part needs proper tests in the configure(.in).
+ * Ad 3: This is conditionally compiled in. Condition currently must be
+ * set manually. This part needs proper tests in the configure(.in).
*/
#ifdef hpux
return 1;
#else
- char* skipstr;
+ char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
- skipstr = getenv ("TCL_TEMPLOAD_NO_UNLINK");
if (skipstr && (skipstr[0] != '\0')) {
return atoi(skipstr);
}
@@ -3189,7 +3217,8 @@ skipUnlink (Tcl_Obj* shlibFile)
#ifndef NO_FSTATFS
{
struct statfs fs;
- /* Have fstatfs. May not have the AUFS super magic ... Indeed our build
+ /*
+ * Have fstatfs. May not have the AUFS super magic ... Indeed our build
* box is too old to have it directly in the headers. Define taken from
* http://mooon.googlecode.com/svn/trunk/linux_include/linux/aufs_type.h
* http://aufs.sourceforge.net/
@@ -3198,16 +3227,18 @@ skipUnlink (Tcl_Obj* shlibFile)
#ifndef AUFS_SUPER_MAGIC
#define AUFS_SUPER_MAGIC ('a' << 24 | 'u' << 16 | 'f' << 8 | 's')
#endif /* AUFS_SUPER_MAGIC */
- if ((statfs(Tcl_GetString (shlibFile), &fs) == 0) &&
- (fs.f_type == AUFS_SUPER_MAGIC)) {
+ if ((statfs(Tcl_GetString(shlibFile), &fs) == 0)
+ && (fs.f_type == AUFS_SUPER_MAGIC)) {
return 1;
}
}
#endif /* ... NO_FSTATFS */
#endif /* ... TCL_TEMPLOAD_NO_UNLINK */
- /* Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
- * Don't skip */
+ /*
+ * Fallback: !hpux, no EV override, no AUFS (detection, nor detected):
+ * Don't skip
+ */
return 0;
#endif /* hpux */
}
@@ -3412,9 +3443,8 @@ Tcl_LoadFile(
* avoids any worries about leaving the copy laying around on exit.
*/
- if (
- !skipUnlink (copyToPtr) &&
- (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
+ if (!skipUnlink(copyToPtr) &&
+ (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
Tcl_DecrRefCount(copyToPtr);
/*
@@ -4093,7 +4123,7 @@ TclGetPathType(
* caller. */
{
int pathLen;
- const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ const char *path = TclGetStringFromObj(pathPtr, &pathLen);
Tcl_PathType type;
type = TclFSNonnativePathType(path, pathLen, filesystemPtrPtr,
@@ -4205,7 +4235,7 @@ TclFSNonnativePathType(
numVolumes--;
Tcl_ListObjIndex(NULL, thisFsVolumes, numVolumes, &vol);
- strVol = Tcl_GetStringFromObj(vol,&len);
+ strVol = TclGetStringFromObj(vol,&len);
if (pathLen < len) {
continue;
}
@@ -4552,8 +4582,8 @@ Tcl_FSRemoveDirectory(
Tcl_Obj *normPath = Tcl_FSGetNormalizedPath(NULL, pathPtr);
if (normPath != NULL) {
- normPathStr = Tcl_GetStringFromObj(normPath, &normLen);
- cwdStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+ normPathStr = TclGetStringFromObj(normPath, &normLen);
+ cwdStr = TclGetStringFromObj(cwdPtr, &cwdLen);
if ((cwdLen >= normLen) && (strncmp(normPathStr, cwdStr,
(size_t) normLen) == 0)) {
/*
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 30c33f1..965ec24 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -101,6 +101,7 @@ typedef struct {
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetIndexFromObj
int
Tcl_GetIndexFromObj(
@@ -114,6 +115,7 @@ Tcl_GetIndexFromObj(
int flags, /* 0 or TCL_EXACT */
int *indexPtr) /* Place to store resulting integer index. */
{
+ if (!(flags & INDEX_TEMP_TABLE)) {
/*
* See if there is a valid cached result from a previous lookup (doing the
@@ -121,8 +123,10 @@ Tcl_GetIndexFromObj(
* the common case where the result is cached).
*/
- if (objPtr->typePtr == &indexType) {
- IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ const Tcl_ObjIntRep *irPtr = TclFetchIntRep(objPtr, &indexType);
+
+ if (irPtr) {
+ IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
/*
* Here's hoping we don't get hit by unfortunate packing constraints
@@ -135,9 +139,11 @@ Tcl_GetIndexFromObj(
return TCL_OK;
}
}
+ }
return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
msg, flags, indexPtr);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -211,13 +217,8 @@ GetIndexFromObjList(
tablePtr[objc] = NULL;
result = Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr,
- sizeof(char *), msg, flags, indexPtr);
-
- /*
- * The internal rep must be cleared since tablePtr will go away.
- */
+ sizeof(char *), msg, flags | INDEX_TEMP_TABLE, indexPtr);
- TclFreeIntRep(objPtr);
ckfree(tablePtr);
return result;
@@ -270,6 +271,7 @@ Tcl_GetIndexFromObjStruct(
const char *const *entryPtr;
Tcl_Obj *resultPtr;
IndexRep *indexRep;
+ const Tcl_ObjIntRep *irPtr;
/* Protect against invalid values, like -1 or 0. */
if (offset < (int)sizeof(char *)) {
@@ -279,13 +281,16 @@ Tcl_GetIndexFromObjStruct(
* See if there is a valid cached result from a previous lookup.
*/
- if (objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ if (!(flags & INDEX_TEMP_TABLE)) {
+ irPtr = TclFetchIntRep(objPtr, &indexType);
+ if (irPtr) {
+ indexRep = irPtr->twoPtrValue.ptr1;
if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
*indexPtr = indexRep->index;
return TCL_OK;
}
}
+ }
/*
* Lookup the value of the object in the table. Accept unique
@@ -340,17 +345,21 @@ Tcl_GetIndexFromObjStruct(
* operation.
*/
- if (objPtr->typePtr == &indexType) {
- indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+ if (!(flags & INDEX_TEMP_TABLE)) {
+ irPtr = TclFetchIntRep(objPtr, &indexType);
+ if (irPtr) {
+ indexRep = irPtr->twoPtrValue.ptr1;
} else {
- TclFreeIntRep(objPtr);
+ Tcl_ObjIntRep ir;
+
indexRep = ckalloc(sizeof(IndexRep));
- objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
- objPtr->typePtr = &indexType;
+ ir.twoPtrValue.ptr1 = indexRep;
+ Tcl_StoreIntRep(objPtr, &indexType, &ir);
}
indexRep->tablePtr = (void *) tablePtr;
indexRep->offset = offset;
indexRep->index = index;
+ }
*indexPtr = index;
return TCL_OK;
@@ -448,16 +457,10 @@ static void
UpdateStringOfIndex(
Tcl_Obj *objPtr)
{
- IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
- register char *buf;
- register unsigned len;
+ IndexRep *indexRep = TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
register const char *indexStr = EXPAND_OF(indexRep);
- len = strlen(indexStr);
- buf = ckalloc(len + 1);
- memcpy(buf, indexStr, len+1);
- objPtr->bytes = buf;
- objPtr->length = len;
+ Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
}
/*
@@ -483,12 +486,14 @@ DupIndex(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_ObjIntRep ir;
IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
- memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
- dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
- dupPtr->typePtr = &indexType;
+ memcpy(dupIndexRep, TclFetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
+ sizeof(IndexRep));
+
+ ir.twoPtrValue.ptr1 = dupIndexRep;
+ Tcl_StoreIntRep(dupPtr, &indexType, &ir);
}
/*
@@ -512,7 +517,7 @@ static void
FreeIndex(
Tcl_Obj *objPtr)
{
- ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+ ckfree(TclFetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
objPtr->typePtr = NULL;
}
@@ -712,10 +717,10 @@ PrefixAllObjCmd(
return result;
}
resultPtr = Tcl_NewListObj(0, NULL);
- string = Tcl_GetStringFromObj(objv[2], &length);
+ string = TclGetStringFromObj(objv[2], &length);
for (t = 0; t < tableObjc; t++) {
- elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
+ elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
/*
* A prefix cannot match if it is longest.
@@ -768,13 +773,13 @@ PrefixLongestObjCmd(
if (result != TCL_OK) {
return result;
}
- string = Tcl_GetStringFromObj(objv[2], &length);
+ string = TclGetStringFromObj(objv[2], &length);
resultString = NULL;
resultLength = 0;
for (t = 0; t < tableObjc; t++) {
- elemString = Tcl_GetStringFromObj(tableObjv[t], &elemLength);
+ elemString = TclGetStringFromObj(tableObjv[t], &elemLength);
/*
* First check if the prefix string matches the element. A prefix
@@ -959,10 +964,10 @@ Tcl_WrongNumArgs(
/*
* Add the element, quoting it if necessary.
*/
+ const Tcl_ObjIntRep *irPtr;
- if (origObjv[i]->typePtr == &indexType) {
- register IndexRep *indexRep =
- origObjv[i]->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = TclFetchIntRep(origObjv[i], &indexType))) {
+ register IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
@@ -1009,9 +1014,10 @@ Tcl_WrongNumArgs(
* the correct error message even if the subcommand was abbreviated.
* Otherwise, just use the string rep.
*/
+ const Tcl_ObjIntRep *irPtr;
- if (objv[i]->typePtr == &indexType) {
- register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = TclFetchIntRep(objv[i], &indexType))) {
+ register IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
} else {
@@ -1149,7 +1155,7 @@ Tcl_ParseArgsObjv(
curArg = objv[srcIndex];
srcIndex++;
objc--;
- str = Tcl_GetStringFromObj(curArg, &length);
+ str = TclGetStringFromObj(curArg, &length);
if (length > 0) {
c = str[1];
} else {
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index e9af34a..106b4e9 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -50,7 +50,7 @@ declare 6 {
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
-declare 8 {
+declare 8 {deprecated {}} {
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}
@@ -73,7 +73,7 @@ declare 11 {
declare 12 {
void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}
-# Removed in 8.5
+# Removed in 8.5:
#declare 13 {
# int TclDoGlob(Tcl_Interp *interp, char *separators,
# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
@@ -88,7 +88,7 @@ declare 14 {
declare 16 {
void TclExprFloatError(Tcl_Interp *interp, double value)
}
-# Removed in 8.4
+# Removed in 8.4:
#declare 17 {
# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
@@ -114,7 +114,7 @@ declare 23 {
}
# Replaced with macro (see tclInt.h) in Tcl 8.5.0, restored in 8.5.10
declare 24 {
- int TclFormatInt(char *buffer, long n)
+ int TclFormatInt(char *buffer, Tcl_WideInt n)
}
declare 25 {
void TclFreePackageInfo(Interp *iPtr)
@@ -123,7 +123,7 @@ declare 25 {
# declare 26 {
# char *TclGetCwd(Tcl_Interp *interp)
# }
-# Removed in 8.5
+# Removed in 8.5:
#declare 27 {
# int TclGetDate(char *p, unsigned long now, long zone,
# unsigned long *timePtr)
@@ -147,7 +147,7 @@ declare 32 {
int TclGetFrame(Tcl_Interp *interp, const char *str,
CallFrame **framePtrPtr)
}
-# Removed in Tcl 8.5
+# Removed in 8.5:
#declare 33 {
# TclCmdProcType TclGetInterpProc(void)
#}
@@ -160,7 +160,7 @@ declare 34 {
# Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
# int flags)
#}
-# Removed in 8.6a2
+# Removed in 8.6a2:
#declare 36 {
# int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
@@ -185,9 +185,9 @@ declare 41 {
declare 42 {
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
-# Removed in Tcl 8.5a2
+# Removed in 8.5a2:
#declare 43 {
-# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
+# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 44 {
@@ -220,14 +220,14 @@ declare 50 {
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
-# Removed in Tcl 8.5a2
+# Removed in 8.5a2:
#declare 52 {
-# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
+# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv,
# int flags)
#}
declare 53 {
int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp,
- int argc, CONST84 char **argv)
+ int argc, const char **argv)
}
declare 54 {
int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp,
@@ -273,7 +273,7 @@ declare 64 {
int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int flags)
}
-# Removed in Tcl 8.5a2
+# Removed in 8.5a2:
#declare 65 {
# int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
# Tcl_Obj *const objv[], int flags)
@@ -313,9 +313,7 @@ declare 75 {
declare 76 {
unsigned long TclpGetSeconds(void)
}
-
-# deprecated
-declare 77 {
+declare 77 {deprecated {}} {
void TclpGetTime(Tcl_Time *time)
}
# Removed in 8.6:
@@ -357,7 +355,7 @@ declare 81 {
# declare 87 {
# void TclPlatformInit(Tcl_Interp *interp)
# }
-declare 88 {
+declare 88 {deprecated {}} {
char *TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp,
const char *name1, const char *name2, int flags)
}
@@ -380,7 +378,7 @@ declare 92 {
declare 93 {
void TclProcDeleteProc(ClientData clientData)
}
-# Removed in Tcl 8.5:
+# Removed in 8.5:
#declare 94 {
# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
# int argc, const char **argv)
@@ -419,7 +417,7 @@ declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
-declare 104 {
+declare 104 {deprecated {}} {
int TclSockMinimumBuffersOld(int sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
@@ -455,26 +453,26 @@ declare 111 {
Tcl_ResolveCompiledVarProc *compiledVarProc)
}
declare 112 {
- int Tcl_AppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ int TclAppendExportList(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
Tcl_Obj *objPtr)
}
declare 113 {
- Tcl_Namespace *Tcl_CreateNamespace(Tcl_Interp *interp, const char *name,
+ Tcl_Namespace *TclCreateNamespace(Tcl_Interp *interp, const char *name,
ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc)
}
declare 114 {
- void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr)
+ void TclDeleteNamespace(Tcl_Namespace *nsPtr)
}
declare 115 {
- int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst)
}
declare 116 {
- Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+ Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 117 {
- Tcl_Namespace *Tcl_FindNamespace(Tcl_Interp *interp, const char *name,
+ Tcl_Namespace *TclFindNamespace(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags)
}
declare 118 {
@@ -490,28 +488,28 @@ declare 120 {
Tcl_Namespace *contextNsPtr, int flags)
}
declare 121 {
- int Tcl_ForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ int TclForgetImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern)
}
declare 122 {
- Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
+ Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 123 {
- void Tcl_GetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
+ void TclGetCommandFullName(Tcl_Interp *interp, Tcl_Command command,
Tcl_Obj *objPtr)
}
declare 124 {
- Tcl_Namespace *Tcl_GetCurrentNamespace(Tcl_Interp *interp)
+ Tcl_Namespace *TclGetCurrentNamespace_(Tcl_Interp *interp)
}
declare 125 {
- Tcl_Namespace *Tcl_GetGlobalNamespace(Tcl_Interp *interp)
+ Tcl_Namespace *TclGetGlobalNamespace_(Tcl_Interp *interp)
}
declare 126 {
void Tcl_GetVariableFullName(Tcl_Interp *interp, Tcl_Var variable,
Tcl_Obj *objPtr)
}
declare 127 {
- int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+ int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite)
}
declare 128 {
@@ -532,7 +530,7 @@ declare 131 {
declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
-declare 133 {
+declare 133 {deprecated {}} {
struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 8.5
@@ -550,7 +548,7 @@ declare 133 {
# int TclpChdir(const char *dirName)
#}
declare 138 {
- CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
+ const char *TclGetEnv(const char *name, Tcl_DString *valuePtr)
}
#declare 139 {
# int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
@@ -562,7 +560,7 @@ declare 138 {
#}
# This is used by TclX, but should otherwise be considered private
declare 141 {
- CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
+ const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr)
}
declare 142 {
int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -625,12 +623,10 @@ declare 156 {
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
-# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
-declare 158 {
+declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptFileName(const char *filename)
}
-# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
-declare 159 {
+declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
const char *TclGetStartupScriptFileName(void)
}
#declare 160 {
@@ -676,13 +672,10 @@ declare 166 {
int index, Tcl_Obj *valuePtr)
}
-# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
-# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
-declare 167 {
+declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
-# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
-declare 168 {
+declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
Tcl_Obj *TclGetStartupScriptPath(void)
}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
@@ -730,12 +723,11 @@ declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
-# TIP 338 made these public - now declared in tcl.h too
declare 178 {
- void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
+ void TclSetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
declare 179 {
- Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
+ Tcl_Obj *TclGetStartupScript(const char **encodingNamePtr)
}
# REMOVED
@@ -748,12 +740,10 @@ declare 179 {
# const char *file, int line)
#}
-# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
-
-declare 182 {
+declare 182 {deprecated {}} {
struct tm *TclpLocaltime(const time_t *clock)
}
-declare 183 {
+declare 183 {deprecated {}} {
struct tm *TclpGmtime(const time_t *clock)
}
@@ -937,10 +927,7 @@ declare 234 {
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
-
-
-# TIP 337 made this one public
-declare 236 {
+declare 236 {deprecated {use Tcl_BackgroundException}} {
void TclBackgroundException(Tcl_Interp *interp, int code)
}
@@ -1009,7 +996,7 @@ declare 250 {
# Allow extensions for optimization
declare 251 {
int TclRegisterLiteral(void *envPtr,
- char *bytes, int length, int flags)
+ const char *bytes, int length, int flags)
}
# Exporting of the internal API to variables.
@@ -1037,6 +1024,10 @@ declare 256 {
int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr,
Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
}
+declare 257 {
+ void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
+ Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
+}
##############################################################################
@@ -1090,7 +1081,7 @@ declare 9 win {
declare 10 win {
Tcl_DirEntry *TclpReaddir(TclDIR *dir)
}
-# Removed in 8.3.1 (for Win32s only)
+# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}
@@ -1140,7 +1131,6 @@ declare 19 win {
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
-# new for 8.4.20+/8.5.12+
declare 21 win {
char *TclpInetNtoa(struct in_addr addr)
}
@@ -1272,7 +1262,7 @@ declare 19 macosx {
}
declare 29 {win unix} {
- int TclWinCPUID(unsigned int index, unsigned int *regs)
+ int TclWinCPUID(int index, int *regs)
}
# Added in 8.6; core of TclpOpenTemporaryFile
declare 30 {win unix} {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b5f9f76..b8bcbac 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -26,6 +26,36 @@
#undef ACCEPT_NAN
/*
+ * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3.
+ * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them
+ * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+
+ * releases. Perhaps Tcl 8.7 will add even better public interfaces
+ * supporting all the re-invocation mechanisms extensions like Itcl 3
+ * need. As an absolute last resort, folks who must make Itcl 3 work
+ * unchanged with Tcl 8.7 can remove this line to regain the migration
+ * support. Tcl 9 will no longer offer even that option.
+ */
+
+#define AVOID_HACKS_FOR_ITCL 1
+
+
+/*
+ * Used to tag functions that are only to be visible within the module being
+ * built and not outside it (where this is supported by the linker).
+ * Also used in the platform-specific *Port.h files.
+ */
+
+#ifndef MODULE_SCOPE
+# ifdef __cplusplus
+# define MODULE_SCOPE extern "C"
+# else
+# define MODULE_SCOPE extern
+# endif
+#endif
+
+
+
+/*
* Common include files needed by most of the Tcl source files are included
* here, so that system-dependent personalizations for the include files only
* have to be made in once place. This results in a few extra includes, but
@@ -82,19 +112,6 @@ typedef int ptrdiff_t;
#endif
/*
- * Used to tag functions that are only to be visible within the module being
- * built and not outside it (where this is supported by the linker).
- */
-
-#ifndef MODULE_SCOPE
-# ifdef __cplusplus
-# define MODULE_SCOPE extern "C"
-# else
-# define MODULE_SCOPE extern
-# endif
-#endif
-
-/*
* Macros used to cast between pointers and integers (e.g. when storing an int
* in ClientData), on 64-bit architectures they avoid gcc warning about "cast
* to/from pointer from/to integer of different size".
@@ -103,19 +120,19 @@ typedef int ptrdiff_t;
#if !defined(INT2PTR) && !defined(PTR2INT)
# if defined(HAVE_INTPTR_T) || defined(intptr_t)
# define INT2PTR(p) ((void *)(intptr_t)(p))
-# define PTR2INT(p) ((int)(intptr_t)(p))
+# define PTR2INT(p) ((intptr_t)(p))
# else
# define INT2PTR(p) ((void *)(p))
-# define PTR2INT(p) ((int)(p))
+# define PTR2INT(p) ((long)(p))
# endif
#endif
#if !defined(UINT2PTR) && !defined(PTR2UINT)
# if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
# define UINT2PTR(p) ((void *)(uintptr_t)(p))
-# define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
+# define PTR2UINT(p) ((uintptr_t)(p))
# else
# define UINT2PTR(p) ((void *)(p))
-# define PTR2UINT(p) ((unsigned int)(p))
+# define PTR2UINT(p) ((unsigned long)(p))
# endif
#endif
@@ -123,6 +140,26 @@ typedef int ptrdiff_t;
# define vsnprintf _vsnprintf
#endif
+#if !defined(TCL_THREADS)
+# define TCL_THREADS 1
+#endif
+#if !TCL_THREADS
+# undef TCL_DECLARE_MUTEX
+# define TCL_DECLARE_MUTEX(name)
+# undef Tcl_MutexLock
+# define Tcl_MutexLock(mutexPtr)
+# undef Tcl_MutexUnlock
+# define Tcl_MutexUnlock(mutexPtr)
+# undef Tcl_MutexFinalize
+# define Tcl_MutexFinalize(mutexPtr)
+# undef Tcl_ConditionNotify
+# define Tcl_ConditionNotify(condPtr)
+# undef Tcl_ConditionWait
+# define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
+# undef Tcl_ConditionFinalize
+# define Tcl_ConditionFinalize(condPtr)
+#endif
+
/*
* The following procedures allow namespaces to be customized to support
* special name resolution rules for commands/variables.
@@ -147,13 +184,13 @@ typedef struct Tcl_ResolvedVarInfo {
} Tcl_ResolvedVarInfo;
typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp,
- CONST84 char *name, int length, Tcl_Namespace *context,
+ const char *name, int length, Tcl_Namespace *context,
Tcl_ResolvedVarInfo **rPtr);
-typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name,
+typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Var *rPtr);
-typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name,
+typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name,
Tcl_Namespace *context, int flags, Tcl_Command *rPtr);
typedef struct Tcl_ResolverInfo {
@@ -235,7 +272,7 @@ typedef struct Namespace {
* synonym. */
char *fullName; /* The namespace's fully qualified name. This
* starts with ::. */
- ClientData clientData; /* An arbitrary value associated with this
+ void *clientData; /* An arbitrary value associated with this
* namespace. */
Tcl_NamespaceDeleteProc *deleteProc;
/* Procedure invoked when deleting the
@@ -252,7 +289,7 @@ typedef struct Namespace {
* strings; values have type (Namespace *). If
* NULL, there are no children. */
#endif
- long nsId; /* Unique id for the namespace. */
+ unsigned long nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
int flags; /* OR-ed combination of the namespace status
@@ -261,7 +298,7 @@ typedef struct Namespace {
* frames for this namespace that are on the
* Tcl call stack. The namespace won't be
* freed until activationCount becomes zero. */
- int refCount; /* Count of references by namespaceName
+ unsigned int refCount; /* Count of references by namespaceName
* objects. The namespace can't be freed until
* refCount becomes zero. */
Tcl_HashTable cmdTable; /* Contains all the commands currently
@@ -286,12 +323,12 @@ typedef struct Namespace {
* registered using "namespace export". */
int maxExportPatterns; /* Mumber of export patterns for which space
* is currently allocated. */
- int cmdRefEpoch; /* Incremented if a newly added command
+ unsigned int cmdRefEpoch; /* Incremented if a newly added command
* shadows a command for which this namespace
* has already cached a Command* pointer; this
* causes all its cached Command* pointers to
* be invalidated. */
- int resolverEpoch; /* Incremented whenever (a) the name
+ unsigned 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
@@ -318,7 +355,7 @@ typedef struct Namespace {
* LookupCompiledLocal to resolve variable
* references within the namespace at compile
* time. */
- int exportLookupEpoch; /* Incremented whenever a command is added to
+ unsigned int exportLookupEpoch; /* Incremented whenever a command is added to
* a namespace, removed from a namespace or
* the exports of a namespace are changed.
* Allows TIP#112-driven command lists to be
@@ -419,7 +456,7 @@ typedef struct EnsembleConfig {
* if the command has been deleted (or never
* existed; the global namespace never has an
* ensemble command.) */
- int epoch; /* The epoch at which this ensemble's table of
+ unsigned int epoch; /* The epoch at which this ensemble's table of
* exported commands is valid. */
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
* consistent points, this will have the same
@@ -506,7 +543,7 @@ typedef struct EnsembleConfig {
typedef struct VarTrace {
Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by
* flags are performed on variable. */
- ClientData clientData; /* Argument to pass to proc. */
+ void *clientData; /* Argument to pass to proc. */
int flags; /* What events the trace procedure is
* interested in: OR-ed combination of
* TCL_TRACE_READS, TCL_TRACE_WRITES,
@@ -525,14 +562,14 @@ 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. */
+ void *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. */
- int refCount; /* Used to ensure this structure is not
+ size_t refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
@@ -605,7 +642,7 @@ typedef struct Var {
typedef struct VarInHash {
Var var;
- int refCount; /* Counts number of active uses of this
+ unsigned int refCount; /* Counts number of active uses of this
* variable: 1 for the entry in the hash
* table, 1 for each additional variable whose
* linkPtr points here, 1 for each nested
@@ -917,7 +954,7 @@ typedef struct CompiledLocal {
/* Customized variable resolution info
* supplied by the Tcl_ResolveCompiledVarProc
* associated with a namespace. Each variable
- * is marked by a unique ClientData tag during
+ * is marked by a unique tag during
* compilation, and that same tag is used to
* find the variable at runtime. */
char name[1]; /* Name of the local variable starts here. If
@@ -936,7 +973,7 @@ typedef struct CompiledLocal {
typedef struct Proc {
struct Interp *iPtr; /* Interpreter for which this command is
* defined. */
- int refCount; /* Reference count: 1 if still present in
+ unsigned int refCount; /* Reference count: 1 if still present in
* command table plus 1 for each call to the
* procedure that is currently active. This
* structure can be freed when refCount
@@ -978,7 +1015,7 @@ typedef struct Trace {
int level; /* Only trace commands at nesting level less
* than or equal to this. */
Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */
- ClientData clientData; /* Arbitrary value to pass to proc. */
+ void *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. */
@@ -1030,7 +1067,7 @@ typedef struct ActiveInterpTrace {
typedef struct AssocData {
Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */
- ClientData clientData; /* Value to pass to proc. */
+ void *clientData; /* Value to pass to proc. */
} AssocData;
/*
@@ -1053,7 +1090,7 @@ typedef struct AssocData {
*/
typedef struct LocalCache {
- int refCount;
+ unsigned int refCount;
int numVars;
Tcl_Obj *varName0;
} LocalCache;
@@ -1108,7 +1145,7 @@ typedef struct CallFrame {
* recognized by the compiler. The compiler
* emits code that refers to these variables
* using an index into this array. */
- ClientData clientData; /* Pointer to some context that is used by
+ void *clientData; /* Pointer to some context that is used by
* object systems. The meaning of the contents
* of this field is defined by the code that
* sets it, and it should only ever be set by
@@ -1132,6 +1169,10 @@ typedef struct CallFrame {
* field contains an Object reference that has
* been confirmed to refer to a class. Part of
* TIP#257. */
+#define FRAME_IS_PRIVATE_DEFINE 0x10
+ /* Marks this frame as being used for private
+ * declarations with [oo::define]. Usually
+ * OR'd with FRAME_IS_OO_DEFINE. TIP#500. */
/*
* TIP #280
@@ -1215,7 +1256,7 @@ typedef struct CmdFrame {
typedef struct CFWord {
CmdFrame *framePtr; /* CmdFrame to access. */
int word; /* Index of the word in the command. */
- int refCount; /* Number of times the word is on the
+ unsigned int refCount; /* Number of times the word is on the
* stack. */
} CFWord;
@@ -1292,13 +1333,13 @@ typedef struct ContLineLoc {
* by [info frame]. Contains a sub-structure for each extra field.
*/
-typedef Tcl_Obj * (GetFrameInfoValueProc)(ClientData clientData);
+typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData);
typedef struct {
const char *name; /* Name of this field. */
GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the
* clientData, or just use the clientData
* directly (after casting) if NULL. */
- ClientData clientData; /* Context for above function, or Tcl_Obj* if
+ void *clientData; /* Context for above function, or Tcl_Obj* if
* proc field is NULL. */
} ExtraFrameInfoField;
typedef struct {
@@ -1343,7 +1384,7 @@ MODULE_SCOPE void TclThreadDataKeySet(Tcl_ThreadDataKey *keyPtr,
*/
#define TCL_TSD_INIT(keyPtr) \
- (ThreadSpecificData *)Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
+ Tcl_GetThreadData((keyPtr), sizeof(ThreadSpecificData))
/*
*----------------------------------------------------------------
@@ -1478,11 +1519,11 @@ typedef struct LiteralEntry {
* NULL if end of chain. */
Tcl_Obj *objPtr; /* Points to Tcl object that holds the
* literal's bytes and length. */
- int refCount; /* If in an interpreter's global literal
+ size_t refCount; /* If in an interpreter's global literal
* table, the number of ByteCode structures
* that share the literal object; the literal
* entry can be freed when refCount drops to
- * 0. If in a local literal table, -1. */
+ * 0. If in a local literal table, (size_t)-1. */
Namespace *nsPtr; /* Namespace in which this literal is used. We
* try to avoid sharing literal non-FQ command
* names among different namespaces to reduce
@@ -1502,7 +1543,7 @@ typedef struct LiteralTable {
* table. */
int rebuildSize; /* Enlarge table when numEntries gets to be
* this large. */
- int mask; /* Mask value used in hashing function. */
+ unsigned int mask; /* Mask value used in hashing function. */
} LiteralTable;
/*
@@ -1554,7 +1595,7 @@ typedef struct {
Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */
CompileProc *compileProc; /* The compiler for the subcommand. */
Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */
- ClientData clientData; /* Any clientData to give the command. */
+ void *clientData; /* Any clientData to give the command. */
int unsafe; /* Whether this command is to be hidden by
* default in a safe interpreter. */
} EnsembleImplMap;
@@ -1620,24 +1661,24 @@ typedef struct Command {
* recreated). */
Namespace *nsPtr; /* Points to the namespace containing this
* command. */
- int refCount; /* 1 if in command hashtable plus 1 for each
+ unsigned int refCount; /* 1 if in command hashtable plus 1 for each
* reference from a CmdName Tcl object
* representing a command's name in a ByteCode
* instruction sequence. This structure can be
* freed when refCount becomes zero. */
- int cmdEpoch; /* Incremented to invalidate any references
+ unsigned int cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
* if no compile proc exists for command. */
Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */
- ClientData objClientData; /* Arbitrary value passed to object proc. */
+ void *objClientData; /* Arbitrary value passed to object proc. */
Tcl_CmdProc *proc; /* String-based command procedure. */
- ClientData clientData; /* Arbitrary value passed to string proc. */
+ void *clientData; /* Arbitrary value passed to string proc. */
Tcl_CmdDeleteProc *deleteProc;
/* Procedure invoked when deleting command to,
* e.g., free all client data. */
- ClientData deleteData; /* Arbitrary value passed to deleteProc. */
+ void *deleteData; /* Arbitrary value passed to deleteProc. */
int flags; /* Miscellaneous bits of information about
* command. See below for definitions. */
ImportRef *importRefPtr; /* List of each imported Command created in
@@ -1803,7 +1844,7 @@ typedef struct Interp {
/* Hash table used by tclBasic.c to keep track
* of hidden commands on a per-interp
* basis. */
- ClientData interpInfo; /* Information used by tclInterp.c to keep
+ void *interpInfo; /* Information used by tclInterp.c to keep
* track of master/slave interps on a
* per-interp basis. */
union {
@@ -1848,6 +1889,7 @@ typedef struct Interp {
* See Tcl_AppendResult code for details.
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
char *appendResult; /* Storage space for results generated by
* Tcl_AppendResult. Ckalloc-ed. NULL means
* not yet allocated. */
@@ -1855,6 +1897,11 @@ typedef struct Interp {
* partialResult. */
int appendUsed; /* Number of non-null bytes currently stored
* at partialResult. */
+#else
+ char *appendResultDontUse;
+ int appendAvlDontUse;
+ int appendUsedDontUse;
+#endif
/*
* Information about packages. Used only in tclPkg.c.
@@ -1884,7 +1931,7 @@ typedef struct Interp {
* compiled by the interpreter. Indexed by the
* string representations of literals. Used to
* avoid creating duplicate objects. */
- int compileEpoch; /* Holds the current "compilation epoch" for
+ unsigned int compileEpoch; /* Holds the current "compilation epoch" for
* this interpreter. This is incremented to
* invalidate existing ByteCodes when, e.g., a
* command with a compile procedure is
@@ -1916,8 +1963,14 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
- char resultSpace[TCL_RESULT_SIZE+1];
+#if TCL_MAJOR_VERSION < 9
+# if !defined(TCL_NO_DEPRECATED)
+ char resultSpace[TCL_DSTRING_STATIC_SIZE+1];
/* Static space holding small results. */
+# else
+ char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
+# endif
+#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
@@ -2310,6 +2363,13 @@ typedef struct Interp {
#define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
/*
+ * A common panic alert when memory allocation fails.
+ */
+
+#define TclOOM(ptr, size) \
+ ((size) && ((ptr)||(Tcl_Panic("unable to alloc %u bytes", (size)),1)))
+
+/*
* The following enum values are used to specify the runtime platform setting
* of the tclPlatform variable.
*/
@@ -2360,7 +2420,7 @@ typedef enum TclEolTranslation {
*/
typedef struct List {
- int refCount;
+ unsigned int refCount;
int maxElemCount; /* Total number of element array slots. */
int elemCount; /* Current number of list elements. */
int canonicalFlag; /* Set if the string representation was
@@ -2383,12 +2443,6 @@ typedef struct List {
#define ListRepPtr(listPtr) \
((List *) (listPtr)->internalRep.twoPtrValue.ptr1)
-#define ListSetIntRep(objPtr, listRepPtr) \
- (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
- (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
- (listRepPtr)->refCount++, \
- (objPtr)->typePtr = &tclListType
-
#define ListObjGetElements(listPtr, objc, objv) \
((objv) = &(ListRepPtr(listPtr)->elements), \
(objc) = ListRepPtr(listPtr)->elemCount)
@@ -2421,40 +2475,46 @@ typedef struct List {
#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */
/*
- * Macros providing a faster path to integers: Tcl_GetLongFromObj,
- * Tcl_GetIntFromObj and TclGetIntForIndex.
+ * Macros providing a faster path to booleans and integers:
+ * Tcl_GetBooleanFromObj, Tcl_GetLongFromObj, Tcl_GetIntFromObj
+ * and TclGetIntForIndex.
*
* WARNING: these macros eval their args more than once.
*/
+#define TclGetBooleanFromObj(interp, objPtr, boolPtr) \
+ (((objPtr)->typePtr == &tclIntType) \
+ ? (*(boolPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \
+ : ((objPtr)->typePtr == &tclBooleanType) \
+ ? (*(boolPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \
+ : Tcl_GetBooleanFromObj((interp), (objPtr), (boolPtr)))
+
+#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetLongFromObj(interp, objPtr, longPtr) \
(((objPtr)->typePtr == &tclIntType) \
- ? ((*(longPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+ ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
-
-#if (LONG_MAX == INT_MAX)
-#define TclGetIntFromObj(interp, objPtr, intPtr) \
- (((objPtr)->typePtr == &tclIntType) \
- ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
- : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
-#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
- (((objPtr)->typePtr == &tclIntType) \
- ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
- : TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
#else
+#define TclGetLongFromObj(interp, objPtr, longPtr) \
+ (((objPtr)->typePtr == &tclIntType \
+ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
+ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
+ ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
+ : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
+#endif
+
#define TclGetIntFromObj(interp, objPtr, intPtr) \
(((objPtr)->typePtr == &tclIntType \
- && (objPtr)->internalRep.longValue >= -(Tcl_WideInt)(UINT_MAX) \
- && (objPtr)->internalRep.longValue <= (Tcl_WideInt)(UINT_MAX)) \
- ? ((*(intPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
+ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
+ ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
: Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
#define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
(((objPtr)->typePtr == &tclIntType \
- && (objPtr)->internalRep.longValue >= INT_MIN \
- && (objPtr)->internalRep.longValue <= INT_MAX) \
- ? ((*(idxPtr) = (objPtr)->internalRep.longValue), TCL_OK) \
+ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
+ ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \
+ ? (int)(objPtr)->internalRep.wideValue : -1), TCL_OK) \
: TclGetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
-#endif
/*
* Macro used to save a function call for common uses of
@@ -2464,21 +2524,11 @@ typedef struct List {
* Tcl_WideInt *wideIntPtr);
*/
-#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclIntType) \
- ? (*(wideIntPtr) = (Tcl_WideInt) \
- ((objPtr)->internalRep.longValue), TCL_OK) : \
- Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#else /* !TCL_WIDE_INT_IS_LONG */
-#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
- (((objPtr)->typePtr == &tclWideIntType) \
- ? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
- ((objPtr)->typePtr == &tclIntType) \
- ? (*(wideIntPtr) = (Tcl_WideInt) \
- ((objPtr)->internalRep.longValue), TCL_OK) : \
+ ? (*(wideIntPtr) = \
+ ((objPtr)->internalRep.wideValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#endif /* TCL_WIDE_INT_IS_LONG */
/*
* Flag values for TclTraceDictPath().
@@ -2544,6 +2594,15 @@ typedef struct TclFileAttrProcs {
} TclFileAttrProcs;
/*
+ * Private flag value which controls Tcl_GetIndexFromObj*() routines
+ * to instruct them not to cache lookups because the table will not
+ * live long enough to make it worthwhile. Must not clash with public
+ * flag value TCL_EXACT.
+ */
+
+#define INDEX_TEMP_TABLE 2
+
+/*
* Opaque handle used in pipeline routines to encapsulate platform-dependent
* state.
*/
@@ -2593,7 +2652,7 @@ typedef Tcl_ObjCmdProc *TclObjCmdProcType;
*----------------------------------------------------------------
*/
-typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
+typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr);
/*
@@ -2605,9 +2664,9 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, int *lengthPtr,
*/
typedef struct ProcessGlobalValue {
- int epoch; /* Epoch counter to detect changes in the
+ unsigned int epoch; /* Epoch counter to detect changes in the
* master value. */
- int numBytes; /* Length of the master string. */
+ unsigned int numBytes; /* Length of the master string. */
char *value; /* The master string value. */
Tcl_Encoding encoding; /* system encoding when master string was
* initialized. */
@@ -2650,8 +2709,11 @@ typedef struct ProcessGlobalValue {
*----------------------------------------------------------------------
*/
-#define TCL_NUMBER_LONG 1
-#define TCL_NUMBER_WIDE 2
+#define TCL_NUMBER_INT 2
+#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
+# define TCL_NUMBER_LONG 1 /* deprecated, not used any more */
+# define TCL_NUMBER_WIDE TCL_NUMBER_INT /* deprecated */
+#endif
#define TCL_NUMBER_BIG 3
#define TCL_NUMBER_DOUBLE 4
#define TCL_NUMBER_NAN 5
@@ -2688,17 +2750,12 @@ MODULE_SCOPE const Tcl_ObjType tclBooleanType;
MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
MODULE_SCOPE const Tcl_ObjType tclDoubleType;
-MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
MODULE_SCOPE const Tcl_ObjType tclIntType;
MODULE_SCOPE const Tcl_ObjType tclListType;
MODULE_SCOPE const Tcl_ObjType tclDictType;
MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
-MODULE_SCOPE const Tcl_ObjType tclArraySearchType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
-#ifndef TCL_WIDE_INT_IS_LONG
-MODULE_SCOPE const Tcl_ObjType tclWideIntType;
-#endif
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
MODULE_SCOPE Tcl_ObjType tclCmdNameType;
@@ -2731,7 +2788,6 @@ MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS];
* shared by all new objects allocated by Tcl_NewObj.
*/
-MODULE_SCOPE char * tclEmptyStringRep;
MODULE_SCOPE char tclEmptyString;
enum CheckEmptyStringResult {
@@ -2804,7 +2860,7 @@ typedef struct ForIterData {
typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
const char* symbol);
struct Tcl_LoadHandle_ {
- ClientData clientData; /* Client data is the load handle in the
+ void *clientData; /* Client data is the load handle in the
* native filesystem if a module was loaded
* there, or an opaque pointer to a structure
* for further bookkeeping on load-from-VFS
@@ -2883,6 +2939,8 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
+MODULE_SCOPE int TclCompareTwoNumbers(Tcl_Obj *valuePtr,
+ Tcl_Obj *value2Ptr);
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
@@ -2892,25 +2950,19 @@ MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj *objPtr,
Tcl_Obj *originObjPtr);
MODULE_SCOPE int TclConvertElement(const char *src, int length,
char *dst, int flags);
-MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs (
- Tcl_Interp *interp,
- const char *cmdName,
- Tcl_Namespace *nsPtr,
- Tcl_ObjCmdProc *proc,
- ClientData clientData,
+MODULE_SCOPE Tcl_Command TclCreateObjCommandInNs(Tcl_Interp *interp,
+ const char *cmdName, Tcl_Namespace *nsPtr,
+ Tcl_ObjCmdProc *proc, ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
-MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(
- Tcl_Interp *interp,
- const char *name,
- Tcl_Namespace *nameNamespacePtr,
- Tcl_Namespace *ensembleNamespacePtr,
- int flags);
+MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
+ const char *name, Tcl_Namespace *nameNamespacePtr,
+ Tcl_Namespace *ensembleNamespacePtr, int flags);
MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr);
MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
int *sizePtr, int *literalPtr);
-/* TIP #280 - Modified token based evulation, with line information. */
+/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
int *clNextOuter, const char *outerScript);
@@ -2931,12 +2983,10 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr,
MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr,
Tcl_DString *toAppendPtr);
MODULE_SCOPE Tcl_Obj * TclDStringToObj(Tcl_DString *dsPtr);
-MODULE_SCOPE Tcl_Obj *const * TclFetchEnsembleRoot(Tcl_Interp *interp,
+MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp,
Tcl_Obj *const *objv, int objc, int *objcPtr);
-MODULE_SCOPE Tcl_Namespace * TclEnsureNamespace(
- Tcl_Interp *interp,
+MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp,
Tcl_Namespace *namespacePtr);
-
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
@@ -2954,6 +3004,7 @@ MODULE_SCOPE void TclFinalizeNotifier(void);
MODULE_SCOPE void TclFinalizeObjects(void);
MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
+MODULE_SCOPE void TclInitThreadAlloc(void);
MODULE_SCOPE void TclFinalizeThreadAlloc(void);
MODULE_SCOPE void TclFinalizeThreadAllocThread(void);
MODULE_SCOPE void TclFinalizeThreadData(int quick);
@@ -2962,15 +3013,11 @@ MODULE_SCOPE double TclFloor(const mp_int *a);
MODULE_SCOPE void TclFormatNaN(double value, char *buffer);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
const char *attributeName, int *indexPtr);
-MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs (
- Tcl_Interp *interp,
- const char *cmdName,
- Tcl_Namespace *nsPtr,
- Tcl_ObjCmdProc *proc,
- Tcl_ObjCmdProc *nreProc,
+MODULE_SCOPE Tcl_Command TclNRCreateCommandInNs(Tcl_Interp *interp,
+ const char *cmdName, Tcl_Namespace *nsPtr,
+ Tcl_ObjCmdProc *proc, Tcl_ObjCmdProc *nreProc,
ClientData clientData,
Tcl_CmdDeleteProc *deleteProc);
-
MODULE_SCOPE int TclNREvalFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
const char *encodingName);
MODULE_SCOPE void TclFSUnloadTempFile(Tcl_LoadHandle loadHandle);
@@ -2982,6 +3029,8 @@ MODULE_SCOPE int TclGetChannelFromObj(Tcl_Interp *interp,
MODULE_SCOPE CmdFrame * TclGetCmdFrameForProcedure(Proc *procPtr);
MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp,
Tcl_Obj *value, int *code);
+MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp,
+ Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
MODULE_SCOPE int TclGetNumberFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, ClientData *clientDataPtr,
int *typePtr);
@@ -2993,6 +3042,11 @@ MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr,
unsigned int *sizePtr);
+MODULE_SCOPE int TclGetLoadedPackagesEx(Tcl_Interp *interp,
+ const char *targetName,
+ const char *packageName);
+MODULE_SCOPE int TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
+ Tcl_WideInt *);
MODULE_SCOPE int TclGlob(Tcl_Interp *interp, char *pattern,
Tcl_Obj *unquotedPrefix, int globFlags,
Tcl_GlobTypeData *types);
@@ -3012,6 +3066,9 @@ MODULE_SCOPE int TclInfoLocalsCmd(ClientData dummy, Tcl_Interp *interp,
MODULE_SCOPE int TclInfoVarsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void TclInitAlloc(void);
+MODULE_SCOPE void TclInitBignumFromLong(mp_int *, long);
+MODULE_SCOPE void TclInitBignumFromWideInt(mp_int *, Tcl_WideInt);
+MODULE_SCOPE void TclInitBignumFromWideUInt(mp_int *, Tcl_WideUInt);
MODULE_SCOPE void TclInitDbCkalloc(void);
MODULE_SCOPE void TclInitDoubleConversion(void);
MODULE_SCOPE void TclInitEmbeddedConfigurationInformation(
@@ -3038,6 +3095,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n,
int *lines, Tcl_Obj *const *elems);
MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
+MODULE_SCOPE Tcl_Obj * TclListObjRange(Tcl_Obj *listPtr, int fromIdx,
+ int toIdx);
MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
@@ -3092,7 +3151,7 @@ MODULE_SCOPE int TclpThreadCreate(Tcl_ThreadId *idPtr,
int stackSize, int flags);
MODULE_SCOPE int TclpFindVariable(const char *name, int *lengthPtr);
MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr,
- int *lengthPtr, Tcl_Encoding *encodingPtr);
+ unsigned int *lengthPtr, Tcl_Encoding *encodingPtr);
MODULE_SCOPE void TclpInitLock(void);
MODULE_SCOPE void TclpInitPlatform(void);
MODULE_SCOPE void TclpInitUnlock(void);
@@ -3120,16 +3179,17 @@ MODULE_SCOPE int TclpObjChdir(Tcl_Obj *pathPtr);
MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
Tcl_Obj *resultingNameObj);
+MODULE_SCOPE void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName);
+MODULE_SCOPE void *TclInitPkgFiles(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj * TclPathPart(Tcl_Interp *interp, Tcl_Obj *pathPtr,
Tcl_PathPart portion);
MODULE_SCOPE char * TclpReadlink(const char *fileName,
Tcl_DString *linkPtr);
-MODULE_SCOPE void TclpSetInterfaces(void);
MODULE_SCOPE void TclpSetVariables(Tcl_Interp *interp);
MODULE_SCOPE void * TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
void *data);
-MODULE_SCOPE void TclpThreadExit(int status);
+MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void TclRememberMutex(Tcl_Mutex *mutex);
@@ -3143,7 +3203,8 @@ MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
mp_int *bignumValue);
-MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+MODULE_SCOPE int TclSetBooleanFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
Command *cmdPtr);
MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
@@ -3155,17 +3216,16 @@ MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
-
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
-MODULE_SCOPE int TclStringCmp (Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
+MODULE_SCOPE int TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
int checkEq, int nocase, int reqlength);
-MODULE_SCOPE int TclStringCmpOpts (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
- int *nocase, int *reqlength);
+MODULE_SCOPE int TclStringCmpOpts(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int *nocase,
+ int *reqlength);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
const char *pattern, int ptnLen, int flags);
MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj,
Tcl_Obj *patternObj, int flags);
-MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr);
MODULE_SCOPE void TclSubstCompile(Tcl_Interp *interp, const char *bytes,
int numBytes, int flags, int line,
struct CompileEnv *envPtr);
@@ -3183,7 +3243,13 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
const char *trim, int numTrim);
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
const char *trim, int numTrim);
+MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
+MODULE_SCOPE void TclRegisterCommandTypeName(
+ Tcl_ObjCmdProc *implementationProc,
+ const char *nameStr);
+MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
+MODULE_SCOPE int TclUtfCount(int ch);
MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData);
MODULE_SCOPE Tcl_Obj * TclpFilesystemPathType(Tcl_Obj *pathPtr);
MODULE_SCOPE int TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -3208,8 +3274,11 @@ MODULE_SCOPE void * TclpThreadCreateKey(void);
MODULE_SCOPE void TclpThreadDeleteKey(void *keyPtr);
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp,
+ const char *msg, int length);
+/* Tip 430 */
+MODULE_SCOPE int TclZipfs_Init(Tcl_Interp *interp);
-MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
/*
*----------------------------------------------------------------
@@ -3231,9 +3300,11 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_BreakObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
MODULE_SCOPE int Tcl_CaseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+#endif
MODULE_SCOPE int Tcl_CatchObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3253,7 +3324,7 @@ MODULE_SCOPE int TclChanPushObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE void TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int TclClockOldscanObjCmd(
- ClientData clientData, Tcl_Interp *interp,
+ void *clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -3289,7 +3360,6 @@ MODULE_SCOPE int TclNRAssembleObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
-MODULE_SCOPE int TclMakeEncodingCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_EofObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3318,7 +3388,6 @@ MODULE_SCOPE int Tcl_FcopyObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
-MODULE_SCOPE int TclMakeFileCommandSafe(Tcl_Interp *interp);
MODULE_SCOPE int Tcl_FileEventObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3380,6 +3449,9 @@ MODULE_SCOPE int Tcl_LmapObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_LoadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
+MODULE_SCOPE int Tcl_LpopObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_LrangeObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -3969,6 +4041,29 @@ MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp,
struct CompileEnv *envPtr);
/*
+ * Routines that provide the [string] ensemble functionality. Possible
+ * candidates for public interface.
+ */
+
+MODULE_SCOPE Tcl_Obj * TclStringCat(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags);
+MODULE_SCOPE int TclStringFirst(Tcl_Obj *needle, Tcl_Obj *haystack,
+ int start);
+MODULE_SCOPE int TclStringLast(Tcl_Obj *needle, Tcl_Obj *haystack,
+ int last);
+MODULE_SCOPE Tcl_Obj * TclStringRepeat(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int count, int flags);
+MODULE_SCOPE Tcl_Obj * TclStringReplace(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ int first, int count, Tcl_Obj *insertPtr,
+ int flags);
+MODULE_SCOPE Tcl_Obj * TclStringReverse(Tcl_Obj *objPtr, int flags);
+
+/* Flag values for the [string] ensemble functions. */
+
+#define TCL_STRING_MATCH_NOCASE TCL_MATCH_NOCASE /* (1<<0) in tcl.h */
+#define TCL_STRING_IN_PLACE (1<<1)
+
+/*
* Functions defined in generic/tclVar.c and currently exported only for use
* by the bytecode compiler and engine. Some of these could later be placed in
* the public interface.
@@ -4018,12 +4113,57 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
*/
MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+MODULE_SCOPE void TclFreeObj(Tcl_Obj *objPtr);
MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr);
-MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
+MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
MODULE_SCOPE int TclFullFinalizationRequested(void);
/*
+ * Just for the purposes of command-type registration.
+ */
+
+MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclOOMyClassObjCmd;
+
+/*
+ * TIP #462.
+ */
+
+/*
+ * The following enum values give the status of a spawned process.
+ */
+
+typedef enum TclProcessWaitStatus {
+ TCL_PROCESS_ERROR = -1, /* Error waiting for process to exit */
+ TCL_PROCESS_UNCHANGED = 0, /* No change since the last call. */
+ TCL_PROCESS_EXITED = 1, /* Process has exited. */
+ TCL_PROCESS_SIGNALED = 2, /* Child killed because of a signal. */
+ TCL_PROCESS_STOPPED = 3, /* Child suspended because of a signal. */
+ TCL_PROCESS_UNKNOWN_STATUS = 4
+ /* Child wait status didn't make sense. */
+} TclProcessWaitStatus;
+
+MODULE_SCOPE Tcl_Command TclInitProcessCmd(Tcl_Interp *interp);
+MODULE_SCOPE void TclProcessCreated(Tcl_Pid pid);
+MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
+ int *codePtr, Tcl_Obj **msgObjPtr,
+ Tcl_Obj **errorObjPtr);
+
+/*
+ * TIP #508: [array default]
+ */
+
+MODULE_SCOPE void TclInitArrayVar(Var *arrayPtr);
+MODULE_SCOPE Tcl_Obj * TclGetArrayDefault(Var *arrayPtr);
+
+/*
* Utility routines for encoding index values as integers. Used by both
* some of the command compilers and by [lsort] and [lsearch].
*/
@@ -4034,9 +4174,8 @@ MODULE_SCOPE int TclIndexDecode(int encoded, int endValue);
/* Constants used in index value encoding routines. */
#define TCL_INDEX_END (-2)
-#define TCL_INDEX_BEFORE (-1)
+#define TCL_INDEX_NONE (-1) /* Index out of range or END+1 */
#define TCL_INDEX_START (0)
-#define TCL_INDEX_AFTER (INT_MAX)
/*
*----------------------------------------------------------------
@@ -4096,7 +4235,7 @@ typedef const char *TclDTraceStr;
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
- (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
(objPtr)->typePtr = NULL; \
TCL_DTRACE_OBJ_CREATE(objPtr)
@@ -4113,8 +4252,8 @@ typedef const char *TclDTraceStr;
if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \
TCL_DTRACE_OBJ_FREE(objPtr); \
if ((objPtr)->bytes \
- && ((objPtr)->bytes != tclEmptyStringRep)) { \
- ckfree((char *) (objPtr)->bytes); \
+ && ((objPtr)->bytes != &tclEmptyString)) { \
+ ckfree((objPtr)->bytes); \
} \
(objPtr)->length = -1; \
TclFreeObjStorage(objPtr); \
@@ -4124,6 +4263,10 @@ typedef const char *TclDTraceStr;
} \
}
+#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
+# define USE_THREAD_ALLOC 1
+#endif
+
#if defined(PURIFY)
/*
@@ -4137,11 +4280,11 @@ typedef const char *TclDTraceStr;
(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))
# define TclFreeObjStorageEx(interp, objPtr) \
- ckfree((char *) (objPtr))
+ ckfree(objPtr)
#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
-#elif defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#elif TCL_THREADS && defined(USE_THREAD_ALLOC)
/*
* The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
@@ -4155,6 +4298,7 @@ MODULE_SCOPE void TclFreeAllocCache(void *);
MODULE_SCOPE void * TclpGetAllocCache(void);
MODULE_SCOPE void TclpSetAllocCache(void *);
MODULE_SCOPE void TclpFreeAllocMutex(Tcl_Mutex *mutex);
+MODULE_SCOPE void TclpInitAllocCache(void);
MODULE_SCOPE void TclpFreeAllocCache(void *);
/*
@@ -4205,7 +4349,7 @@ MODULE_SCOPE void TclpFreeAllocCache(void *);
# define USE_TCLALLOC 0
#endif
-#ifdef TCL_THREADS
+#if TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex tclObjMutex;
#endif
@@ -4273,11 +4417,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
#define TclInitStringRep(objPtr, bytePtr, len) \
if ((len) == 0) { \
- (objPtr)->bytes = tclEmptyStringRep; \
+ (objPtr)->bytes = &tclEmptyString; \
(objPtr)->length = 0; \
} else { \
(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
- memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
+ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (unsigned) (len)); \
(objPtr)->bytes[len] = '\0'; \
(objPtr)->length = (len); \
}
@@ -4295,7 +4439,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclGetString(objPtr) \
- ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString((objPtr)))
+ ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr))
#define TclGetStringFromObj(objPtr, lenPtr) \
((objPtr)->bytes \
@@ -4330,15 +4474,27 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclInvalidateStringRep(objPtr) \
- if (objPtr->bytes != NULL) { \
- if (objPtr->bytes != tclEmptyStringRep) { \
- ckfree((char *) objPtr->bytes); \
+ if ((objPtr)->bytes != NULL) { \
+ if ((objPtr)->bytes != &tclEmptyString) { \
+ ckfree((objPtr)->bytes); \
} \
- objPtr->bytes = NULL; \
+ (objPtr)->bytes = NULL; \
}
/*
*----------------------------------------------------------------
+ * Macro used by the Tcl core to test whether an object has a
+ * string representation (or is a 'pure' internal value).
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int TclHasStringRep(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)
+
+/*
+ *----------------------------------------------------------------
* Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
* growth algorithm as used in tclStringObj.c for growing strings. The ANSI C
* "prototype" for this macro is:
@@ -4421,7 +4577,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*/
#define TclUtfToUniChar(str, chPtr) \
- ((((unsigned char) *(str)) < 0xC0) ? \
+ ((((unsigned char) *(str)) < 0x80) ? \
((*(chPtr) = (unsigned char) *(str)), 1) \
: Tcl_UtfToUniChar(str, chPtr))
@@ -4464,13 +4620,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
*----------------------------------------------------------------
*/
-#define TclIsPureByteArray(objPtr) \
- (((objPtr)->typePtr==&tclByteArrayType) && ((objPtr)->bytes==NULL))
+MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr);
#define TclIsPureDict(objPtr) \
(((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclDictType))
+#define TclHasIntRep(objPtr, type) \
+ ((objPtr)->typePtr == (type))
+#define TclFetchIntRep(objPtr, type) \
+ (TclHasIntRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL)
-#define TclIsPureList(objPtr) \
- (((objPtr)->bytes==NULL) && ((objPtr)->typePtr==&tclListType))
/*
*----------------------------------------------------------------
@@ -4552,51 +4709,25 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* core. They should only be called on unshared objects. The ANSI C
* "prototypes" for these macros are:
*
- * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, int intValue);
- * MODULE_SCOPE void TclSetLongObj(Tcl_Obj *objPtr, long longValue);
- * MODULE_SCOPE void TclSetBooleanObj(Tcl_Obj *objPtr, long boolValue);
- * MODULE_SCOPE void TclSetWideIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
+ * MODULE_SCOPE void TclSetIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclSetDoubleObj(Tcl_Obj *objPtr, double d);
*----------------------------------------------------------------
*/
-#define TclSetLongObj(objPtr, i) \
+#define TclSetIntObj(objPtr, i) \
do { \
+ Tcl_ObjIntRep ir; \
+ ir.wideValue = (Tcl_WideInt) i; \
TclInvalidateStringRep(objPtr); \
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.longValue = (long)(i); \
- (objPtr)->typePtr = &tclIntType; \
+ Tcl_StoreIntRep(objPtr, &tclIntType, &ir); \
} while (0)
-#define TclSetIntObj(objPtr, l) \
- TclSetLongObj(objPtr, l)
-
-/*
- * NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
- * programmatically go straight to being "int" Tcl_Obj's, with value 0 or 1.
- * The only "boolean" Tcl_Obj's shall be those holding the cached boolean
- * value of strings like: "yes", "no", "true", "false", "on", "off".
- */
-
-#define TclSetBooleanObj(objPtr, b) \
- TclSetLongObj(objPtr, (b)!=0);
-
-#ifndef TCL_WIDE_INT_IS_LONG
-#define TclSetWideIntObj(objPtr, w) \
- do { \
- TclInvalidateStringRep(objPtr); \
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \
- (objPtr)->typePtr = &tclWideIntType; \
- } while (0)
-#endif
-
#define TclSetDoubleObj(objPtr, d) \
- do { \
- TclInvalidateStringRep(objPtr); \
- TclFreeIntRep(objPtr); \
- (objPtr)->internalRep.doubleValue = (double)(d); \
- (objPtr)->typePtr = &tclDoubleType; \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.doubleValue = (double) d; \
+ TclInvalidateStringRep(objPtr); \
+ Tcl_StoreIntRep(objPtr, &tclDoubleType, &ir); \
} while (0)
/*
@@ -4605,39 +4736,26 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
* types, avoiding the corresponding function calls in time critical parts of
* the core. The ANSI C "prototypes" for these macros are:
*
- * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, int i);
- * MODULE_SCOPE void TclNewLongObj(Tcl_Obj *objPtr, long l);
- * MODULE_SCOPE void TclNewBooleanObj(Tcl_Obj *objPtr, int b);
- * MODULE_SCOPE void TclNewWideObj(Tcl_Obj *objPtr, Tcl_WideInt w);
+ * MODULE_SCOPE void TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
* MODULE_SCOPE void TclNewDoubleObj(Tcl_Obj *objPtr, double d);
- * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, char *s, int len);
- * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, char*sLiteral);
+ * MODULE_SCOPE void TclNewStringObj(Tcl_Obj *objPtr, const char *s, int len);
+ * MODULE_SCOPE void TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
*
*----------------------------------------------------------------
*/
#ifndef TCL_MEM_DEBUG
-#define TclNewLongObj(objPtr, i) \
+#define TclNewIntObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
(objPtr)->refCount = 0; \
(objPtr)->bytes = NULL; \
- (objPtr)->internalRep.longValue = (long)(i); \
+ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(i); \
(objPtr)->typePtr = &tclIntType; \
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
-#define TclNewIntObj(objPtr, l) \
- TclNewLongObj(objPtr, l)
-
-/*
- * NOTE: There is to be no such thing as a "pure" boolean.
- * See comment above TclSetBooleanObj macro above.
- */
-#define TclNewBooleanObj(objPtr, b) \
- TclNewLongObj((objPtr), (b)!=0)
-
#define TclNewDoubleObj(objPtr, d) \
do { \
TclIncrObjsAllocated(); \
@@ -4660,14 +4778,8 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
} while (0)
#else /* TCL_MEM_DEBUG */
-#define TclNewIntObj(objPtr, i) \
- (objPtr) = Tcl_NewIntObj(i)
-
-#define TclNewLongObj(objPtr, l) \
- (objPtr) = Tcl_NewLongObj(l)
-
-#define TclNewBooleanObj(objPtr, b) \
- (objPtr) = Tcl_NewBooleanObj(b)
+#define TclNewIntObj(objPtr, w) \
+ (objPtr) = Tcl_NewWideIntObj(w)
#define TclNewDoubleObj(objPtr, d) \
(objPtr) = Tcl_NewDoubleObj(d)
@@ -4750,7 +4862,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
#define TclCleanupCommandMacro(cmdPtr) \
if ((cmdPtr)->refCount-- <= 1) { \
- ckfree((char *) (cmdPtr));\
+ ckfree(cmdPtr);\
}
/*
@@ -4908,7 +5020,7 @@ typedef struct NRE_callback {
#else
#define TCLNR_ALLOC(interp, ptr) \
(ptr = ((ClientData) ckalloc(sizeof(NRE_callback))))
-#define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr))
+#define TCLNR_FREE(interp, ptr) ckfree(ptr)
#endif
#if NRE_ENABLE_ASSERTS
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 1991c21..eddbcb3 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -27,21 +27,21 @@
# endif
#endif
-/* [Bug #803489] Tcl_FindNamespace problem in the Stubs table */
-#undef Tcl_CreateNamespace
-#undef Tcl_DeleteNamespace
-#undef Tcl_AppendExportList
-#undef Tcl_Export
-#undef Tcl_Import
-#undef Tcl_ForgetImport
-#undef Tcl_GetCurrentNamespace
-#undef Tcl_GetGlobalNamespace
-#undef Tcl_FindNamespace
-#undef Tcl_FindCommand
-#undef Tcl_GetCommandFromObj
-#undef Tcl_GetCommandFullName
-#undef Tcl_SetStartupScript
-#undef Tcl_GetStartupScript
+#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
+/* Those macro's are especially for Itcl 3.4 compatibility */
+# define tclCreateNamespace tcl_CreateNamespace
+# define tclDeleteNamespace tcl_DeleteNamespace
+# define tclAppendExportList tcl_AppendExportList
+# define tclExport tcl_Export
+# define tclImport tcl_Import
+# define tclForgetImport tcl_ForgetImport
+# define tclGetCurrentNamespace_ tcl_GetCurrentNamespace
+# define tclGetGlobalNamespace_ tcl_GetGlobalNamespace
+# define tclFindNamespace tcl_FindNamespace
+# define tclFindCommand tcl_FindCommand
+# define tclGetCommandFromObj tcl_GetCommandFromObj
+# define tclGetCommandFullName tcl_GetCommandFullName
+#endif /* !defined(TCL_NO_DEPRECATED) */
/*
* WARNING: This file is automatically generated by the tools/genStubs.tcl
@@ -74,7 +74,8 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
EXTERN int TclCopyAndCollapse(int count, const char *src,
char *dst);
/* 8 */
-EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
+TCL_DEPRECATED("")
+int TclCopyChannelOld(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
int toRead, Tcl_Obj *cmdPtr);
/* 9 */
@@ -112,7 +113,7 @@ EXTERN int TclFindElement(Tcl_Interp *interp,
/* 23 */
EXTERN Proc * TclFindProc(Interp *iPtr, const char *procName);
/* 24 */
-EXTERN int TclFormatInt(char *buffer, long n);
+EXTERN int TclFormatInt(char *buffer, Tcl_WideInt n);
/* 25 */
EXTERN void TclFreePackageInfo(Interp *iPtr);
/* Slot 26 is reserved */
@@ -172,7 +173,7 @@ EXTERN int TclInterpInit(Tcl_Interp *interp);
/* 53 */
EXTERN int TclInvokeObjectCommand(ClientData clientData,
Tcl_Interp *interp, int argc,
- CONST84 char **argv);
+ const char **argv);
/* 54 */
EXTERN int TclInvokeStringCommand(ClientData clientData,
Tcl_Interp *interp, int objc,
@@ -217,7 +218,8 @@ EXTERN unsigned long TclpGetClicks(void);
/* 76 */
EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
-EXTERN void TclpGetTime(Tcl_Time *time);
+TCL_DEPRECATED("")
+void TclpGetTime(Tcl_Time *time);
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -230,7 +232,8 @@ EXTERN char * TclpRealloc(char *ptr, unsigned int size);
/* Slot 86 is reserved */
/* Slot 87 is reserved */
/* 88 */
-EXTERN char * TclPrecTraceProc(ClientData clientData,
+TCL_DEPRECATED("")
+char * TclPrecTraceProc(ClientData clientData,
Tcl_Interp *interp, const char *name1,
const char *name2, int flags);
/* 89 */
@@ -266,7 +269,8 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp);
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
-EXTERN int TclSockMinimumBuffersOld(int sock, int size);
+TCL_DEPRECATED("")
+int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -283,22 +287,22 @@ EXTERN void Tcl_AddInterpResolvers(Tcl_Interp *interp,
Tcl_ResolveVarProc *varProc,
Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
-EXTERN int Tcl_AppendExportList(Tcl_Interp *interp,
+EXTERN int TclAppendExportList(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, Tcl_Obj *objPtr);
/* 113 */
-EXTERN Tcl_Namespace * Tcl_CreateNamespace(Tcl_Interp *interp,
+EXTERN Tcl_Namespace * TclCreateNamespace(Tcl_Interp *interp,
const char *name, ClientData clientData,
Tcl_NamespaceDeleteProc *deleteProc);
/* 114 */
-EXTERN void Tcl_DeleteNamespace(Tcl_Namespace *nsPtr);
+EXTERN void TclDeleteNamespace(Tcl_Namespace *nsPtr);
/* 115 */
-EXTERN int Tcl_Export(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+EXTERN int TclExport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int resetListFirst);
/* 116 */
-EXTERN Tcl_Command Tcl_FindCommand(Tcl_Interp *interp, const char *name,
+EXTERN Tcl_Command TclFindCommand(Tcl_Interp *interp, const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 117 */
-EXTERN Tcl_Namespace * Tcl_FindNamespace(Tcl_Interp *interp,
+EXTERN Tcl_Namespace * TclFindNamespace(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 118 */
@@ -313,23 +317,23 @@ EXTERN Tcl_Var Tcl_FindNamespaceVar(Tcl_Interp *interp,
const char *name,
Tcl_Namespace *contextNsPtr, int flags);
/* 121 */
-EXTERN int Tcl_ForgetImport(Tcl_Interp *interp,
+EXTERN int TclForgetImport(Tcl_Interp *interp,
Tcl_Namespace *nsPtr, const char *pattern);
/* 122 */
-EXTERN Tcl_Command Tcl_GetCommandFromObj(Tcl_Interp *interp,
+EXTERN Tcl_Command TclGetCommandFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr);
/* 123 */
-EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp,
+EXTERN void TclGetCommandFullName(Tcl_Interp *interp,
Tcl_Command command, Tcl_Obj *objPtr);
/* 124 */
-EXTERN Tcl_Namespace * Tcl_GetCurrentNamespace(Tcl_Interp *interp);
+EXTERN Tcl_Namespace * TclGetCurrentNamespace_(Tcl_Interp *interp);
/* 125 */
-EXTERN Tcl_Namespace * Tcl_GetGlobalNamespace(Tcl_Interp *interp);
+EXTERN Tcl_Namespace * TclGetGlobalNamespace_(Tcl_Interp *interp);
/* 126 */
EXTERN void Tcl_GetVariableFullName(Tcl_Interp *interp,
Tcl_Var variable, Tcl_Obj *objPtr);
/* 127 */
-EXTERN int Tcl_Import(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
+EXTERN int TclImport(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
const char *pattern, int allowOverwrite);
/* 128 */
EXTERN void Tcl_PopCallFrame(Tcl_Interp *interp);
@@ -349,19 +353,18 @@ EXTERN void Tcl_SetNamespaceResolvers(
/* 132 */
EXTERN int TclpHasSockets(Tcl_Interp *interp);
/* 133 */
-EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
+TCL_DEPRECATED("")
+struct tm * TclpGetDate(const time_t *time, int useGMT);
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
/* Slot 137 is reserved */
/* 138 */
-EXTERN CONST84_RETURN char * TclGetEnv(const char *name,
- Tcl_DString *valuePtr);
+EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr);
/* Slot 139 is reserved */
/* Slot 140 is reserved */
/* 141 */
-EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp,
- Tcl_DString *cwdPtr);
+EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr);
/* 142 */
EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp,
Tcl_Obj *objPtr, CompileHookProc *hookProc,
@@ -400,9 +403,11 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
const char *varName);
/* 158 */
-EXTERN void TclSetStartupScriptFileName(const char *filename);
+TCL_DEPRECATED("use public Tcl_SetStartupScript()")
+void TclSetStartupScriptFileName(const char *filename);
/* 159 */
-EXTERN const char * TclGetStartupScriptFileName(void);
+TCL_DEPRECATED("use public Tcl_GetStartupScript()")
+const char * TclGetStartupScriptFileName(void);
/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform(Tcl_Interp *interp,
@@ -421,9 +426,11 @@ EXTERN int TclListObjSetElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj *valuePtr);
/* 167 */
-EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
+TCL_DEPRECATED("use public Tcl_SetStartupScript()")
+void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
-EXTERN Tcl_Obj * TclGetStartupScriptPath(void);
+TCL_DEPRECATED("use public Tcl_GetStartupScript()")
+Tcl_Obj * TclGetStartupScriptPath(void);
/* 169 */
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
unsigned long n);
@@ -456,16 +463,18 @@ EXTERN void TclVarErrMsg(Tcl_Interp *interp, const char *part1,
const char *part2, const char *operation,
const char *reason);
/* 178 */
-EXTERN void Tcl_SetStartupScript(Tcl_Obj *pathPtr,
+EXTERN void TclSetStartupScript(Tcl_Obj *pathPtr,
const char *encodingName);
/* 179 */
-EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
+EXTERN Tcl_Obj * TclGetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
-EXTERN struct tm * TclpLocaltime(const time_t *clock);
+TCL_DEPRECATED("")
+struct tm * TclpLocaltime(const time_t *clock);
/* 183 */
-EXTERN struct tm * TclpGmtime(const time_t *clock);
+TCL_DEPRECATED("")
+struct tm * TclpGmtime(const time_t *clock);
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -569,7 +578,8 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
/* 236 */
-EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
+TCL_DEPRECATED("use Tcl_BackgroundException")
+void TclBackgroundException(Tcl_Interp *interp, int code);
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -614,7 +624,7 @@ EXTERN char * TclDoubleDigits(double dv, int ndigits, int flags,
EXTERN void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
int force);
/* 251 */
-EXTERN int TclRegisterLiteral(void *envPtr, char *bytes,
+EXTERN int TclRegisterLiteral(void *envPtr, const char *bytes,
int length, int flags);
/* 252 */
EXTERN Tcl_Obj * TclPtrGetVar(Tcl_Interp *interp, Tcl_Var varPtr,
@@ -638,6 +648,11 @@ EXTERN int TclPtrObjMakeUpvar(Tcl_Interp *interp,
EXTERN int TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, const int flags);
+/* 257 */
+EXTERN void TclStaticPackage(Tcl_Interp *interp,
+ const char *pkgName,
+ Tcl_PackageInitProc *initProc,
+ Tcl_PackageInitProc *safeInitProc);
typedef struct TclIntStubs {
int magic;
@@ -651,7 +666,7 @@ typedef struct TclIntStubs {
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
- int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
+ TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
@@ -667,7 +682,7 @@ typedef struct TclIntStubs {
void (*reserved21)(void);
int (*tclFindElement) (Tcl_Interp *interp, const char *listStr, int listLength, const char **elementPtr, const char **nextPtr, int *sizePtr, int *bracePtr); /* 22 */
Proc * (*tclFindProc) (Interp *iPtr, const char *procName); /* 23 */
- int (*tclFormatInt) (char *buffer, long n); /* 24 */
+ int (*tclFormatInt) (char *buffer, Tcl_WideInt n); /* 24 */
void (*tclFreePackageInfo) (Interp *iPtr); /* 25 */
void (*reserved26)(void);
void (*reserved27)(void);
@@ -696,7 +711,7 @@ typedef struct TclIntStubs {
void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */
int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */
void (*reserved52)(void);
- int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */
+ int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */
int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */
Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */
void (*reserved56)(void);
@@ -720,7 +735,7 @@ typedef struct TclIntStubs {
void (*tclpFree) (char *ptr); /* 74 */
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
- void (*tclpGetTime) (Tcl_Time *time); /* 77 */
+ TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
@@ -731,7 +746,7 @@ typedef struct TclIntStubs {
void (*reserved85)(void);
void (*reserved86)(void);
void (*reserved87)(void);
- char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
+ TCL_DEPRECATED_API("") char * (*tclPrecTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *name1, const char *name2, int flags); /* 88 */
int (*tclPreventAliasLoop) (Tcl_Interp *interp, Tcl_Interp *cmdInterp, Tcl_Command cmd); /* 89 */
void (*reserved90)(void);
void (*tclProcCleanupProc) (Proc *procPtr); /* 91 */
@@ -747,7 +762,7 @@ typedef struct TclIntStubs {
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
- int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
+ TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
@@ -755,36 +770,36 @@ typedef struct TclIntStubs {
int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
- int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
- Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
- void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
- int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
- Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
- Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
+ int (*tclAppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
+ Tcl_Namespace * (*tclCreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
+ void (*tclDeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
+ int (*tclExport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
+ Tcl_Command (*tclFindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
+ Tcl_Namespace * (*tclFindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
int (*tcl_GetInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolverInfo *resInfo); /* 118 */
int (*tcl_GetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolverInfo *resInfo); /* 119 */
Tcl_Var (*tcl_FindNamespaceVar) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 120 */
- int (*tcl_ForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
- Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
- void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
- Tcl_Namespace * (*tcl_GetCurrentNamespace) (Tcl_Interp *interp); /* 124 */
- Tcl_Namespace * (*tcl_GetGlobalNamespace) (Tcl_Interp *interp); /* 125 */
+ int (*tclForgetImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern); /* 121 */
+ Tcl_Command (*tclGetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 122 */
+ void (*tclGetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 123 */
+ Tcl_Namespace * (*tclGetCurrentNamespace_) (Tcl_Interp *interp); /* 124 */
+ Tcl_Namespace * (*tclGetGlobalNamespace_) (Tcl_Interp *interp); /* 125 */
void (*tcl_GetVariableFullName) (Tcl_Interp *interp, Tcl_Var variable, Tcl_Obj *objPtr); /* 126 */
- int (*tcl_Import) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
+ int (*tclImport) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int allowOverwrite); /* 127 */
void (*tcl_PopCallFrame) (Tcl_Interp *interp); /* 128 */
int (*tcl_PushCallFrame) (Tcl_Interp *interp, Tcl_CallFrame *framePtr, Tcl_Namespace *nsPtr, int isProcCallFrame); /* 129 */
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
- struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
+ TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
void (*reserved134)(void);
void (*reserved135)(void);
void (*reserved136)(void);
void (*reserved137)(void);
- CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
+ const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */
void (*reserved139)(void);
void (*reserved140)(void);
- CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
+ const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */
int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */
int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */
void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */
@@ -801,8 +816,8 @@ typedef struct TclIntStubs {
void (*reserved155)(void);
void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
- void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
- const char * (*tclGetStartupScriptFileName) (void); /* 159 */
+ TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
+ TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
void (*reserved160)(void);
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
@@ -810,8 +825,8 @@ typedef struct TclIntStubs {
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
void (*tclpSetInitialEncodings) (void); /* 165 */
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
- void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
- Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
+ TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
+ TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
@@ -821,12 +836,12 @@ typedef struct TclIntStubs {
int (*tclCallVarTraces) (Interp *iPtr, Var *arrayPtr, Var *varPtr, const char *part1, const char *part2, int flags, int leaveErrMsg); /* 175 */
void (*tclCleanupVar) (Var *varPtr, Var *arrayPtr); /* 176 */
void (*tclVarErrMsg) (Tcl_Interp *interp, const char *part1, const char *part2, const char *operation, const char *reason); /* 177 */
- void (*tcl_SetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
- Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
+ void (*tclSetStartupScript) (Tcl_Obj *pathPtr, const char *encodingName); /* 178 */
+ Tcl_Obj * (*tclGetStartupScript) (const char **encodingNamePtr); /* 179 */
void (*reserved180)(void);
void (*reserved181)(void);
- struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
- struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
+ TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
+ TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
void (*reserved184)(void);
void (*reserved185)(void);
void (*reserved186)(void);
@@ -879,7 +894,7 @@ typedef struct TclIntStubs {
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
- void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
+ TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
@@ -894,12 +909,13 @@ typedef struct TclIntStubs {
int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
- int (*tclRegisterLiteral) (void *envPtr, char *bytes, int length, int flags); /* 251 */
+ int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
Tcl_Obj * (*tclPtrGetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 252 */
Tcl_Obj * (*tclPtrSetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, const int flags); /* 253 */
Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
+ void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
} TclIntStubs;
extern const TclIntStubs *tclIntStubsPtr;
@@ -1087,38 +1103,38 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
-#define Tcl_AppendExportList \
- (tclIntStubsPtr->tcl_AppendExportList) /* 112 */
-#define Tcl_CreateNamespace \
- (tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
-#define Tcl_DeleteNamespace \
- (tclIntStubsPtr->tcl_DeleteNamespace) /* 114 */
-#define Tcl_Export \
- (tclIntStubsPtr->tcl_Export) /* 115 */
-#define Tcl_FindCommand \
- (tclIntStubsPtr->tcl_FindCommand) /* 116 */
-#define Tcl_FindNamespace \
- (tclIntStubsPtr->tcl_FindNamespace) /* 117 */
+#define TclAppendExportList \
+ (tclIntStubsPtr->tclAppendExportList) /* 112 */
+#define TclCreateNamespace \
+ (tclIntStubsPtr->tclCreateNamespace) /* 113 */
+#define TclDeleteNamespace \
+ (tclIntStubsPtr->tclDeleteNamespace) /* 114 */
+#define TclExport \
+ (tclIntStubsPtr->tclExport) /* 115 */
+#define TclFindCommand \
+ (tclIntStubsPtr->tclFindCommand) /* 116 */
+#define TclFindNamespace \
+ (tclIntStubsPtr->tclFindNamespace) /* 117 */
#define Tcl_GetInterpResolvers \
(tclIntStubsPtr->tcl_GetInterpResolvers) /* 118 */
#define Tcl_GetNamespaceResolvers \
(tclIntStubsPtr->tcl_GetNamespaceResolvers) /* 119 */
#define Tcl_FindNamespaceVar \
(tclIntStubsPtr->tcl_FindNamespaceVar) /* 120 */
-#define Tcl_ForgetImport \
- (tclIntStubsPtr->tcl_ForgetImport) /* 121 */
-#define Tcl_GetCommandFromObj \
- (tclIntStubsPtr->tcl_GetCommandFromObj) /* 122 */
-#define Tcl_GetCommandFullName \
- (tclIntStubsPtr->tcl_GetCommandFullName) /* 123 */
-#define Tcl_GetCurrentNamespace \
- (tclIntStubsPtr->tcl_GetCurrentNamespace) /* 124 */
-#define Tcl_GetGlobalNamespace \
- (tclIntStubsPtr->tcl_GetGlobalNamespace) /* 125 */
+#define TclForgetImport \
+ (tclIntStubsPtr->tclForgetImport) /* 121 */
+#define TclGetCommandFromObj \
+ (tclIntStubsPtr->tclGetCommandFromObj) /* 122 */
+#define TclGetCommandFullName \
+ (tclIntStubsPtr->tclGetCommandFullName) /* 123 */
+#define TclGetCurrentNamespace_ \
+ (tclIntStubsPtr->tclGetCurrentNamespace_) /* 124 */
+#define TclGetGlobalNamespace_ \
+ (tclIntStubsPtr->tclGetGlobalNamespace_) /* 125 */
#define Tcl_GetVariableFullName \
(tclIntStubsPtr->tcl_GetVariableFullName) /* 126 */
-#define Tcl_Import \
- (tclIntStubsPtr->tcl_Import) /* 127 */
+#define TclImport \
+ (tclIntStubsPtr->tclImport) /* 127 */
#define Tcl_PopCallFrame \
(tclIntStubsPtr->tcl_PopCallFrame) /* 128 */
#define Tcl_PushCallFrame \
@@ -1209,10 +1225,10 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclCleanupVar) /* 176 */
#define TclVarErrMsg \
(tclIntStubsPtr->tclVarErrMsg) /* 177 */
-#define Tcl_SetStartupScript \
- (tclIntStubsPtr->tcl_SetStartupScript) /* 178 */
-#define Tcl_GetStartupScript \
- (tclIntStubsPtr->tcl_GetStartupScript) /* 179 */
+#define TclSetStartupScript \
+ (tclIntStubsPtr->tclSetStartupScript) /* 178 */
+#define TclGetStartupScript \
+ (tclIntStubsPtr->tclGetStartupScript) /* 179 */
/* Slot 180 is reserved */
/* Slot 181 is reserved */
#define TclpLocaltime \
@@ -1341,6 +1357,8 @@ extern const TclIntStubs *tclIntStubsPtr;
(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
#define TclPtrUnsetVar \
(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
+#define TclStaticPackage \
+ (tclIntStubsPtr->tclStaticPackage) /* 257 */
#endif /* defined(USE_TCL_STUBS) */
@@ -1349,58 +1367,30 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
-#undef TclGetStartupScriptFileName
-#undef TclSetStartupScriptFileName
-#undef TclGetStartupScriptPath
-#undef TclSetStartupScriptPath
-#undef TclBackgroundException
-
-#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
-# undef Tcl_SetStartupScript
-# define Tcl_SetStartupScript \
- (tclStubsPtr->tcl_SetStartupScript) /* 622 */
-# undef Tcl_GetStartupScript
-# define Tcl_GetStartupScript \
- (tclStubsPtr->tcl_GetStartupScript) /* 623 */
-# undef Tcl_CreateNamespace
-# define Tcl_CreateNamespace \
- (tclStubsPtr->tcl_CreateNamespace) /* 506 */
-# undef Tcl_DeleteNamespace
-# define Tcl_DeleteNamespace \
- (tclStubsPtr->tcl_DeleteNamespace) /* 507 */
-# undef Tcl_AppendExportList
-# define Tcl_AppendExportList \
- (tclStubsPtr->tcl_AppendExportList) /* 508 */
-# undef Tcl_Export
-# define Tcl_Export \
- (tclStubsPtr->tcl_Export) /* 509 */
-# undef Tcl_Import
-# define Tcl_Import \
- (tclStubsPtr->tcl_Import) /* 510 */
-# undef Tcl_ForgetImport
-# define Tcl_ForgetImport \
- (tclStubsPtr->tcl_ForgetImport) /* 511 */
-# undef Tcl_GetCurrentNamespace
-# define Tcl_GetCurrentNamespace \
- (tclStubsPtr->tcl_GetCurrentNamespace) /* 512 */
-# undef Tcl_GetGlobalNamespace
-# define Tcl_GetGlobalNamespace \
- (tclStubsPtr->tcl_GetGlobalNamespace) /* 513 */
-# undef Tcl_FindNamespace
-# define Tcl_FindNamespace \
- (tclStubsPtr->tcl_FindNamespace) /* 514 */
-# undef Tcl_FindCommand
-# define Tcl_FindCommand \
- (tclStubsPtr->tcl_FindCommand) /* 515 */
-# undef Tcl_GetCommandFromObj
-# define Tcl_GetCommandFromObj \
- (tclStubsPtr->tcl_GetCommandFromObj) /* 516 */
-# undef Tcl_GetCommandFullName
-# define Tcl_GetCommandFullName \
- (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
+#if defined(USE_TCL_STUBS)
+# undef TclGetStartupScriptFileName
+# undef TclSetStartupScriptFileName
+# undef TclGetStartupScriptPath
+# undef TclSetStartupScriptPath
+# undef TclBackgroundException
+# undef TclSetStartupScript
+# undef TclGetStartupScript
+# undef TclCreateNamespace
+# undef TclDeleteNamespace
+# undef TclAppendExportList
+# undef TclExport
+# undef TclImport
+# undef TclForgetImport
+# undef TclGetCurrentNamespace_
+# undef TclGetGlobalNamespace_
+# undef TclFindNamespace
+# undef TclFindCommand
+# undef TclGetCommandFromObj
+# undef TclGetCommandFullName
+# undef TclCopyChannelOld
+# undef TclSockMinimumBuffersOld
+# undef Tcl_StaticPackage
+# define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage)
#endif
-#undef TclCopyChannelOld
-#undef TclSockMinimumBuffersOld
-
#endif /* _TCLINTDECLS */
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index 903327f..51d2f65 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -93,7 +93,7 @@ EXTERN int TclUnixCopyFile(const char *src, const char *dst,
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
-EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
+EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
@@ -168,7 +168,7 @@ EXTERN void TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void TclWinResetInterfaces(void);
/* 29 */
-EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
+EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
@@ -242,7 +242,7 @@ EXTERN void TclMacOSXNotifierAddRunLoopMode(
/* Slot 27 is reserved */
/* Slot 28 is reserved */
/* 29 */
-EXTERN int TclWinCPUID(unsigned int index, unsigned int *regs);
+EXTERN int TclWinCPUID(int index, int *regs);
/* 30 */
EXTERN int TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
@@ -283,7 +283,7 @@ typedef struct TclIntPlatStubs {
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
- int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+ int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* UNIX */
#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
@@ -316,7 +316,7 @@ typedef struct TclIntPlatStubs {
void (*tclWinSetInterfaces) (int wide); /* 26 */
void (*tclWinFlushDirtyChannels) (void); /* 27 */
void (*tclWinResetInterfaces) (void); /* 28 */
- int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+ int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
@@ -349,7 +349,7 @@ typedef struct TclIntPlatStubs {
void (*reserved26)(void);
void (*reserved27)(void);
void (*reserved28)(void);
- int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
+ int (*tclWinCPUID) (int index, int *regs); /* 29 */
int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
#endif /* MACOSX */
} TclIntPlatStubs;
@@ -550,10 +550,18 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
# undef TclWinGetServByName
# undef TclWinGetSockOpt
# undef TclWinSetSockOpt
-# define TclWinNToHS ntohs
-# define TclWinGetServByName getservbyname
-# define TclWinGetSockOpt getsockopt
-# define TclWinSetSockOpt setsockopt
+# undef TclWinGetPlatformId
+# undef TclWinResetInterfaces
+# undef TclWinSetInterfaces
+# if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+# define TclWinNToHS ntohs
+# define TclWinGetServByName getservbyname
+# define TclWinGetSockOpt getsockopt
+# define TclWinSetSockOpt setsockopt
+# define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
+# define TclWinResetInterfaces() /* nop */
+# define TclWinSetInterfaces(dummy) /* nop */
+# endif /* TCL_NO_DEPRECATED */
#else
# undef TclpGetPid
# define TclpGetPid(pid) ((unsigned long) (pid))
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 8a0d653..1863ea5 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -222,9 +222,6 @@ static int AliasDelete(Tcl_Interp *interp,
static int AliasDescribe(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
static int AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
-static int AliasObjCmd(ClientData dummy,
- Tcl_Interp *currentInterp, int objc,
- Tcl_Obj *const objv[]);
static int AliasNRCmd(ClientData dummy,
Tcl_Interp *currentInterp, int objc,
Tcl_Obj *const objv[]);
@@ -257,8 +254,6 @@ static int SlaveInvokeHidden(Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int SlaveMarkTrusted(Tcl_Interp *interp,
Tcl_Interp *slaveInterp);
-static int SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
static void SlaveObjCmdDeleteProc(ClientData clientData);
static int SlaveRecursionLimit(Tcl_Interp *interp,
Tcl_Interp *slaveInterp, int objc,
@@ -331,13 +326,24 @@ TclSetPreInitScript(
*----------------------------------------------------------------------
*/
+typedef struct PkgName {
+ struct PkgName *nextPtr; /* Next in list of package names being initialized. */
+ char name[4];
+} PkgName;
+
int
Tcl_Init(
Tcl_Interp *interp) /* Interpreter to initialize. */
{
+ PkgName pkgName = {NULL, "Tcl"};
+ PkgName **names = TclInitPkgFiles(interp);
+ int result = TCL_ERROR;
+
+ pkgName.nextPtr = *names;
+ *names = &pkgName;
if (tclPreInitScript != NULL) {
- if (Tcl_Eval(interp, tclPreInitScript) == TCL_ERROR) {
- return TCL_ERROR;
+ if (Tcl_EvalEx(interp, tclPreInitScript, -1, 0) == TCL_ERROR) {
+ goto end;
}
}
@@ -382,7 +388,7 @@ Tcl_Init(
* alternate tclInit command before calling Tcl_Init().
*/
- return Tcl_Eval(interp,
+ result = Tcl_EvalEx(interp,
"if {[namespace which -command tclInit] eq \"\"} {\n"
" proc tclInit {} {\n"
" global tcl_libPath tcl_library env tclDefaultLibrary\n"
@@ -403,6 +409,7 @@ Tcl_Init(
" } else {\n"
" lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
" }\n"
+" lappend scripts {::tcl::zipfs::tcl_library_init}\n"
" lappend scripts {\n"
"set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
"set grandParentDir [file dirname $parentDir]\n"
@@ -410,6 +417,7 @@ Tcl_Init(
" {file join $grandParentDir lib tcl[info tclversion]} \\\n"
" {file join $parentDir library} \\\n"
" {file join $grandParentDir library} \\\n"
+" {file join $grandParentDir tcl[info tclversion] library} \\\n"
" {file join $grandParentDir tcl[info patchlevel] library} \\\n"
" {\n"
"file join [file dirname $grandParentDir] tcl[info patchlevel] library}\n"
@@ -444,7 +452,11 @@ Tcl_Init(
" error $msg\n"
" }\n"
"}\n"
-"tclInit");
+"tclInit", -1, 0);
+
+end:
+ *names = (*names)->nextPtr;
+ return result;
}
/*
@@ -1176,7 +1188,7 @@ Tcl_CreateAlias(
int i;
int result;
- objv = TclStackAlloc(slaveInterp, (unsigned) sizeof(Tcl_Obj *) * argc);
+ objv = TclStackAlloc(slaveInterp, sizeof(Tcl_Obj *) * argc);
for (i = 0; i < argc; i++) {
objv[i] = Tcl_NewStringObj(argv[i], -1);
Tcl_IncrRefCount(objv[i]);
@@ -1402,7 +1414,8 @@ TclPreventAliasLoop(
* create or rename the command.
*/
- if (cmdPtr->objProc != AliasObjCmd) {
+ if (cmdPtr->objProc != TclAliasObjCmd
+ && cmdPtr->objProc != TclLocalAliasObjCmd) {
return TCL_OK;
}
@@ -1457,7 +1470,8 @@ TclPreventAliasLoop(
* Otherwise we do not have a loop.
*/
- if (aliasCmdPtr->objProc != AliasObjCmd) {
+ if (aliasCmdPtr->objProc != TclAliasObjCmd
+ && aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
return TCL_OK;
}
nextAliasPtr = aliasCmdPtr->objClientData;
@@ -1523,12 +1537,12 @@ AliasCreate(
if (slaveInterp == masterInterp) {
aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
- TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
- AliasObjCmdDeleteProc);
+ TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
+ aliasPtr, AliasObjCmdDeleteProc);
} else {
- aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
- TclGetString(namePtr), AliasObjCmd, aliasPtr,
- AliasObjCmdDeleteProc);
+ aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
+ TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
+ AliasObjCmdDeleteProc);
}
if (TclPreventAliasLoop(interp, slaveInterp,
@@ -1764,7 +1778,7 @@ AliasList(
/*
*----------------------------------------------------------------------
*
- * AliasObjCmd --
+ * TclAliasObjCmd, TclLocalAliasObjCmd --
*
* This is the function that services invocations of aliases in a slave
* interpreter. One such command exists for each alias. When invoked,
@@ -1772,6 +1786,11 @@ AliasList(
* master interpreter as designated by the Alias record associated with
* this command.
*
+ * TclLocalAliasObjCmd is a stripped down version used when the source
+ * and target interpreters of the alias are the same. That lets a number
+ * of safety precautions be avoided: the state is much more precisely
+ * known.
+ *
* Results:
* A standard Tcl result.
*
@@ -1807,7 +1826,7 @@ AliasNRCmd(
cmdc = prefc + objc - 1;
listPtr = Tcl_NewListObj(cmdc, NULL);
- listRep = listPtr->internalRep.twoPtrValue.ptr1;
+ listRep = ListRepPtr(listPtr);
listRep->elemCount = cmdc;
cmdv = &listRep->elements;
@@ -1831,8 +1850,8 @@ AliasNRCmd(
return Tcl_NREvalObj(interp, listPtr, flags);
}
-static int
-AliasObjCmd(
+int
+TclAliasObjCmd(
ClientData clientData, /* Alias record. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -1921,6 +1940,73 @@ AliasObjCmd(
return result;
#undef ALIAS_CMDV_PREALLOC
}
+
+int
+TclLocalAliasObjCmd(
+ ClientData clientData, /* Alias record. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument vector. */
+{
+#define ALIAS_CMDV_PREALLOC 10
+ Alias *aliasPtr = clientData;
+ int result, prefc, cmdc, i;
+ Tcl_Obj **prefv, **cmdv;
+ Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
+ Interp *iPtr = (Interp *) interp;
+ int isRootEnsemble;
+
+ /*
+ * Append the arguments to the command prefix and invoke the command in
+ * the global namespace.
+ */
+
+ prefc = aliasPtr->objc;
+ prefv = &aliasPtr->objPtr;
+ cmdc = prefc + objc - 1;
+ if (cmdc <= ALIAS_CMDV_PREALLOC) {
+ cmdv = cmdArr;
+ } else {
+ cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
+ }
+
+ memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+ memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+
+ for (i=0; i<cmdc; i++) {
+ Tcl_IncrRefCount(cmdv[i]);
+ }
+
+ /*
+ * Use the ensemble rewriting machinery to ensure correct error messages:
+ * only the source command should show, not the full target prefix.
+ */
+
+ isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)iPtr, 1, prefc, objv);
+
+ /*
+ * Execute the target command in the target interpreter.
+ */
+
+ result = Tcl_EvalObjv(interp, cmdc, cmdv, TCL_EVAL_INVOKE);
+
+ /*
+ * Clean up the ensemble rewrite info if we set it in the first place.
+ */
+
+ if (isRootEnsemble) {
+ TclResetRewriteEnsemble((Tcl_Interp *)iPtr, 1);
+ }
+
+ for (i=0; i<cmdc; i++) {
+ Tcl_DecrRefCount(cmdv[i]);
+ }
+ if (cmdv != cmdArr) {
+ TclStackFree(interp, cmdv);
+ }
+ return result;
+#undef ALIAS_CMDV_PREALLOC
+}
/*
*----------------------------------------------------------------------
@@ -2360,10 +2446,10 @@ SlaveCreate(
slavePtr->slaveEntryPtr = hPtr;
slavePtr->slaveInterp = slaveInterp;
slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
- SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
+ TclSlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
Tcl_SetHashValue(hPtr, slavePtr);
- Tcl_SetVar(slaveInterp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
/*
* Inherit the recursion limit.
@@ -2428,7 +2514,7 @@ SlaveCreate(
/*
*----------------------------------------------------------------------
*
- * SlaveObjCmd --
+ * TclSlaveObjCmd --
*
* Command to manipulate an interpreter, e.g. to send commands to it to
* be evaluated. One such command exists for each slave interpreter.
@@ -2442,8 +2528,8 @@ SlaveCreate(
*----------------------------------------------------------------------
*/
-static int
-SlaveObjCmd(
+int
+TclSlaveObjCmd(
ClientData clientData, /* Slave interpreter. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -2475,7 +2561,7 @@ NRSlaveCmd(
};
if (slaveInterp == NULL) {
- Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
+ Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted");
}
if (objc < 2) {
@@ -2921,7 +3007,7 @@ SlaveRecursionLimit(
return TCL_OK;
} else {
limit = Tcl_SetRecursionLimit(slaveInterp, 0);
- Tcl_SetObjResult(interp, Tcl_NewIntObj(limit));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limit));
return TCL_OK;
}
}
@@ -3190,12 +3276,8 @@ Tcl_MakeSafe(
* Assume these functions all work. [Bug 2895741]
*/
- (void) Tcl_Eval(interp,
- "namespace eval ::tcl {namespace eval mathfunc {}}");
- (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::min", master,
- "::tcl::mathfunc::min", 0, NULL);
- (void) Tcl_CreateAlias(interp, "::tcl::mathfunc::max", master,
- "::tcl::mathfunc::max", 0, NULL);
+ (void) Tcl_EvalEx(interp,
+ "namespace eval ::tcl {namespace eval mathfunc {}}", -1, 0);
}
iPtr->flags |= SAFE_INTERP;
@@ -3517,9 +3599,6 @@ Tcl_LimitAddHandler(
if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_DYNAMIC) {
deleteProc = (Tcl_LimitHandlerDeleteProc *) Tcl_Free;
}
- if (deleteProc == (Tcl_LimitHandlerDeleteProc *) TCL_STATIC) {
- deleteProc = NULL;
- }
/*
* Allocate a handler record.
@@ -4437,12 +4516,12 @@ SlaveCommandLimitCmd(
Tcl_NewStringObj(options[0], -1), empty);
}
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
+ Tcl_NewWideIntObj(Tcl_LimitGetGranularity(slaveInterp,
TCL_LIMIT_COMMANDS)));
if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
+ Tcl_NewWideIntObj(Tcl_LimitGetCommands(slaveInterp)));
} else {
Tcl_Obj *empty;
@@ -4470,13 +4549,13 @@ SlaveCommandLimitCmd(
}
break;
case OPT_GRAN:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_COMMANDS)));
break;
case OPT_VAL:
if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_COMMANDS)) {
Tcl_SetObjResult(interp,
- Tcl_NewIntObj(Tcl_LimitGetCommands(slaveInterp)));
+ Tcl_NewWideIntObj(Tcl_LimitGetCommands(slaveInterp)));
}
break;
}
@@ -4497,7 +4576,7 @@ SlaveCommandLimitCmd(
switch ((enum Options) index) {
case OPT_CMD:
scriptObj = objv[i+1];
- (void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
+ (void) TclGetStringFromObj(scriptObj, &scriptLen);
break;
case OPT_GRAN:
granObj = objv[i+1];
@@ -4514,7 +4593,7 @@ SlaveCommandLimitCmd(
break;
case OPT_VAL:
limitObj = objv[i+1];
- (void) Tcl_GetStringFromObj(objv[i+1], &limitLen);
+ (void) TclGetStringFromObj(objv[i+1], &limitLen);
if (limitLen == 0) {
break;
}
@@ -4624,7 +4703,7 @@ SlaveTimeLimitCmd(
Tcl_NewStringObj(options[0], -1), empty);
}
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[1], -1),
- Tcl_NewIntObj(Tcl_LimitGetGranularity(slaveInterp,
+ Tcl_NewWideIntObj(Tcl_LimitGetGranularity(slaveInterp,
TCL_LIMIT_TIME)));
if (Tcl_LimitTypeEnabled(slaveInterp, TCL_LIMIT_TIME)) {
@@ -4632,9 +4711,9 @@ SlaveTimeLimitCmd(
Tcl_LimitGetTime(slaveInterp, &limitMoment);
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[2], -1),
- Tcl_NewLongObj(limitMoment.usec/1000));
+ Tcl_NewWideIntObj(limitMoment.usec/1000));
Tcl_DictObjPut(NULL, dictPtr, Tcl_NewStringObj(options[3], -1),
- Tcl_NewLongObj(limitMoment.sec));
+ Tcl_NewWideIntObj(limitMoment.sec));
} else {
Tcl_Obj *empty;
@@ -4664,7 +4743,7 @@ SlaveTimeLimitCmd(
}
break;
case OPT_GRAN:
- Tcl_SetObjResult(interp, Tcl_NewIntObj(
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
Tcl_LimitGetGranularity(slaveInterp, TCL_LIMIT_TIME)));
break;
case OPT_MILLI:
@@ -4673,7 +4752,7 @@ SlaveTimeLimitCmd(
Tcl_LimitGetTime(slaveInterp, &limitMoment);
Tcl_SetObjResult(interp,
- Tcl_NewLongObj(limitMoment.usec/1000));
+ Tcl_NewWideIntObj(limitMoment.usec/1000));
}
break;
case OPT_SEC:
@@ -4681,7 +4760,7 @@ SlaveTimeLimitCmd(
Tcl_Time limitMoment;
Tcl_LimitGetTime(slaveInterp, &limitMoment);
- Tcl_SetObjResult(interp, Tcl_NewLongObj(limitMoment.sec));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(limitMoment.sec));
}
break;
}
@@ -4706,7 +4785,7 @@ SlaveTimeLimitCmd(
switch ((enum Options) index) {
case OPT_CMD:
scriptObj = objv[i+1];
- (void) Tcl_GetStringFromObj(objv[i+1], &scriptLen);
+ (void) TclGetStringFromObj(objv[i+1], &scriptLen);
break;
case OPT_GRAN:
granObj = objv[i+1];
@@ -4723,7 +4802,7 @@ SlaveTimeLimitCmd(
break;
case OPT_MILLI:
milliObj = objv[i+1];
- (void) Tcl_GetStringFromObj(objv[i+1], &milliLen);
+ (void) TclGetStringFromObj(objv[i+1], &milliLen);
if (milliLen == 0) {
break;
}
@@ -4741,7 +4820,7 @@ SlaveTimeLimitCmd(
break;
case OPT_SEC:
secObj = objv[i+1];
- (void) Tcl_GetStringFromObj(objv[i+1], &secLen);
+ (void) TclGetStringFromObj(objv[i+1], &secLen);
if (secLen == 0) {
break;
}
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 6f75849..eb4155a 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -36,8 +36,10 @@ typedef struct Link {
unsigned int ui;
short s;
unsigned short us;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
long l;
unsigned long ul;
+#endif
Tcl_WideInt w;
Tcl_WideUInt uw;
float f;
@@ -129,6 +131,14 @@ Tcl_LinkVar(
Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
+ || defined(_WIN32) || defined(__CYGWIN__))
+ if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
+ linkPtr->type = TCL_LINK_LONG;
+ } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
+ linkPtr->type = TCL_LINK_ULONG;
+ }
+#endif
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
} else {
@@ -335,12 +345,14 @@ LinkTraceProc(
case TCL_LINK_UINT:
changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
break;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
case TCL_LINK_LONG:
changed = (LinkedVar(long) != linkPtr->lastValue.l);
break;
case TCL_LINK_ULONG:
changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
break;
+#endif
case TCL_LINK_FLOAT:
changed = (LinkedVar(float) != linkPtr->lastValue.f);
break;
@@ -404,7 +416,8 @@ LinkTraceProc(
case TCL_LINK_DOUBLE:
if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (valueObj->typePtr != &tclDoubleType) {
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(valueObj, &tclDoubleType);
+ if (irPtr == NULL) {
#endif
if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -413,7 +426,7 @@ LinkTraceProc(
}
#ifdef ACCEPT_NAN
}
- linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
+ linkPtr->lastValue.d = irPtr->doubleValue;
#endif
}
LinkedVar(double) = linkPtr->lastValue.d;
@@ -483,6 +496,7 @@ LinkTraceProc(
LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
break;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
case TCL_LINK_LONG:
if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
&& GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
@@ -504,6 +518,7 @@ LinkTraceProc(
}
LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
break;
+#endif
case TCL_LINK_WIDE_UINT:
/*
@@ -581,7 +596,7 @@ ObjValue(
return Tcl_NewDoubleObj(linkPtr->lastValue.d);
case TCL_LINK_BOOLEAN:
linkPtr->lastValue.i = LinkedVar(int);
- return Tcl_NewBooleanObj(linkPtr->lastValue.i != 0);
+ return Tcl_NewBooleanObj(linkPtr->lastValue.i);
case TCL_LINK_CHAR:
linkPtr->lastValue.c = LinkedVar(char);
return Tcl_NewIntObj(linkPtr->lastValue.c);
@@ -597,12 +612,14 @@ ObjValue(
case TCL_LINK_UINT:
linkPtr->lastValue.ui = LinkedVar(unsigned int);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
case TCL_LINK_LONG:
linkPtr->lastValue.l = LinkedVar(long);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
case TCL_LINK_ULONG:
linkPtr->lastValue.ul = LinkedVar(unsigned long);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
+#endif
case TCL_LINK_FLOAT:
linkPtr->lastValue.f = LinkedVar(float);
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
@@ -643,17 +660,16 @@ static Tcl_ObjType invalidRealType = {
static int
SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
- int length;
const char *str;
const char *endPtr;
- str = TclGetStringFromObj(objPtr, &length);
- if ((length == 1) && (str[0] == '.')){
+ str = TclGetString(objPtr);
+ if ((objPtr->length == 1) && (str[0] == '.')){
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = 0.0;
return TCL_OK;
}
- if (TclParseNumber(NULL, objPtr, NULL, str, length, &endPtr,
+ if (TclParseNumber(NULL, objPtr, NULL, str, objPtr->length, &endPtr,
TCL_PARSE_DECIMAL_ONLY) == TCL_OK) {
/* If number is followed by [eE][+-]?, then it is an invalid
* double, but it could be the start of a valid double. */
@@ -663,7 +679,7 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
if (*endPtr == 0) {
double doubleValue = 0.0;
Tcl_GetDoubleFromObj(NULL, objPtr, &doubleValue);
- if (objPtr->typePtr->freeIntRepProc) objPtr->typePtr->freeIntRepProc(objPtr);
+ TclFreeIntRep(objPtr);
objPtr->typePtr = &invalidRealType;
objPtr->internalRep.doubleValue = doubleValue;
return TCL_OK;
@@ -677,17 +693,16 @@ SetInvalidRealFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
/*
* This function checks for integer representations, which are valid
* when linking with C variables, but which are invalid in other
- * contexts in Tcl. Handled are "+", "-", "", "0x", "0b" and "0o"
+ * contexts in Tcl. Handled are "+", "-", "", "0x", "0b", "0d" and "0o"
* (upperand lowercase). See bug [39f6304c2e].
*/
int
-GetInvalidIntFromObj(Tcl_Obj *objPtr,
- int *intPtr)
+GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
{
const char *str = TclGetString(objPtr);
if ((objPtr->length == 0) ||
- ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoO", str[1]))) {
+ ((objPtr->length == 2) && (str[0] == '0') && strchr("xXbBoOdD", str[1]))) {
*intPtr = 0;
return TCL_OK;
} else if ((objPtr->length == 1) && strchr("+-", str[0])) {
@@ -716,8 +731,7 @@ GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
-GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
- double *doublePtr)
+GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr)
{
int intValue;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index e42567e..eb5f32d 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -12,6 +12,7 @@
*/
#include "tclInt.h"
+#include <assert.h>
/*
* Prototypes for functions defined later in this file:
@@ -46,6 +47,27 @@ const Tcl_ObjType tclListType = {
SetListFromAny /* setFromAnyProc */
};
+/* Macros to manipulate the List internal rep */
+
+#define ListSetIntRep(objPtr, listRepPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (listRepPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ (listRepPtr)->refCount++; \
+ Tcl_StoreIntRep((objPtr), &tclListType, &ir); \
+ } while (0)
+
+#define ListGetIntRep(objPtr, listRepPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &tclListType); \
+ (listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
+#define ListResetIntRep(objPtr, listRepPtr) \
+ TclFetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)
+
#ifndef TCL_MIN_ELEMENT_GROWTH
#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
#endif
@@ -55,22 +77,20 @@ const Tcl_ObjType tclListType = {
*
* NewListIntRep --
*
- * Creates a 'List' structure with space for 'objc' elements. 'objc' must
- * be > 0. If 'objv' is not NULL, The list is initialized with first
- * 'objc' values in that array. Otherwise the list is initialized to have
- * 0 elements, with space to add 'objc' more. Flag value 'p' indicates
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more. Flag value "p" indicates
* how to behave on failure.
*
- * Value
- *
- * A new 'List' structure with refCount 0. If some failure
- * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
- * is called if it is not.
- *
- * Effect
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then if p=0, NULL is returned and otherwise the
+ * routine panics.
*
- * The refCount of each value in 'objv' is incremented as it is added
- * to the list.
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
@@ -134,10 +154,22 @@ NewListIntRep(
/*
*----------------------------------------------------------------------
*
- * AttemptNewList --
+ * AttemptNewList --
+ *
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more.
+ *
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then NULL is returned, and an error message is left
+ * in the interp result, unless interp is NULL.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
- * Like NewListIntRep, but additionally sets an error message on failure.
- *
*----------------------------------------------------------------------
*/
@@ -169,20 +201,23 @@ AttemptNewList(
*
* Tcl_NewListObj --
*
- * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
- * defined, 'Tcl_DbNewListObj' is called instead.
+ * This function is normally called when not debugging: i.e., when
+ * TCL_MEM_DEBUG is not defined. It creates a new list object from an
+ * (objc,objv) array: that is, each of the objc elements of the array
+ * referenced by objv is inserted as an element into a new Tcl object.
*
- * Value
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
+ * of calling the debugging version Tcl_DbNewListObj.
*
- * A new list 'Tcl_Obj' to which is appended values from 'objv', or if
- * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
- * elements. The string representation of the new 'Tcl_Obj' is set to
- * NULL. The refCount of the list is 0.
+ * Results:
+ * A new list object is returned that is initialized from the object
+ * pointers in objv. If objc is less than or equal to zero, an empty
+ * object is returned. The new object's string representation is left
+ * NULL. The resulting new list object has ref count 0.
*
- * Effect
- *
- * The refCount of each elements in 'objv' is incremented as it is added
- * to the list.
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
@@ -233,14 +268,28 @@ Tcl_NewListObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_DbNewListObj --
- *
- * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
- * file name and line number from its caller. This simplifies debugging
- * since 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, 'Tcl_NewListObj' is called instead.
+ * Tcl_DbNewListObj --
+ *
+ * This function is normally called when debugging: i.e., when
+ * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
+ * as the Tcl_NewListObj function above except that it calls
+ * Tcl_DbCkalloc directly with the file name and line number from its
+ * caller. This simplifies debugging since then the [memory active]
+ * command will report the correct file name and line number when
+ * reporting objects that haven't been freed.
+ *
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
+ * result of calling Tcl_NewListObj.
+ *
+ * Results:
+ * A new list object is returned that is initialized from the object
+ * pointers in objv. If objc is less than or equal to zero, an empty
+ * object is returned. The new object's string representation is left
+ * NULL. The new list object has ref count 0.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
@@ -301,8 +350,19 @@ Tcl_DbNewListObj(
*
* Tcl_SetListObj --
*
- * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
- * creating a new one.
+ * Modify an object to be a list containing each of the objc elements of
+ * the object array referenced by objv.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object is made a list object and is initialized from the object
+ * pointers in objv. If objc is less than or equal to zero, an empty
+ * object is returned. The new object's string representation is left
+ * NULL. The ref counts of the elements in objv are incremented since the
+ * list now refers to them. The object's old string and internal
+ * representations are freed and its type is set NULL.
*
*----------------------------------------------------------------------
*/
@@ -336,8 +396,7 @@ Tcl_SetListObj(
listRepPtr = NewListIntRep(objc, objv, 1);
ListSetIntRep(objPtr, listRepPtr);
} else {
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
+ Tcl_InitStringRep(objPtr, NULL, 0);
}
}
@@ -346,20 +405,18 @@ Tcl_SetListObj(
*
* TclListObjCopy --
*
- * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
- * provides for the C level a counterpart of the [lrange $list 0 end]
- * command, while using internals details to be as efficient as possible.
- *
- * Value
+ * Makes a "pure list" copy of a list value. This provides for the C
+ * level a counterpart of the [lrange $list 0 end] command, while using
+ * internals details to be as efficient as possible.
*
- * The address of the new 'Tcl_Obj' which shares its internal
- * representation with 'listPtr', and whose refCount is 0. If 'listPtr'
- * is not actually a list, the value is NULL, and an error message is left
- * in 'interp' if it is not NULL.
+ * Results:
+ * Normally returns a pointer to a new Tcl_Obj, that contains the same
+ * list value as *listPtr does. The returned Tcl_Obj has a refCount of
+ * zero. If *listPtr does not hold a list, NULL is returned, and if
+ * interp is non-NULL, an error message is recorded there.
*
- * Effect
- *
- * 'listPtr' is converted to a list if it isn't one already.
+ * Side effects:
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -371,8 +428,10 @@ TclListObjCopy(
* to be returned. */
{
Tcl_Obj *copyPtr;
+ List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
+ ListGetIntRep(listPtr, listRepPtr);
+ if (NULL == listRepPtr) {
if (SetListFromAny(interp, listPtr) != TCL_OK) {
return NULL;
}
@@ -387,32 +446,110 @@ TclListObjCopy(
/*
*----------------------------------------------------------------------
*
- * Tcl_ListObjGetElements --
+ * TclListObjRange --
*
- * Retreive the elements in a list 'Tcl_Obj'.
+ * Makes a slice of a list value.
+ * *listPtr must be known to be a valid list.
*
- * Value
+ * Results:
+ * Returns a pointer to the sliced list.
+ * This may be a new object or the same object if not shared.
*
- * TCL_OK
+ * Side effects:
+ * The possible conversion of the object referenced by listPtr
+ * to a list object.
*
- * A count of list elements is stored, 'objcPtr', And a pointer to the
- * array of elements in the list is stored in 'objvPtr'.
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclListObjRange(
+ Tcl_Obj *listPtr, /* List object to take a range from. */
+ int fromIdx, /* Index of first element to include. */
+ int toIdx) /* Index of last element to include. */
+{
+ Tcl_Obj **elemPtrs;
+ int listLen, i, newLen;
+ List *listRepPtr;
+
+ TclListObjGetElements(NULL, listPtr, &listLen, &elemPtrs);
+
+ if (fromIdx < 0) {
+ fromIdx = 0;
+ }
+ if (toIdx >= listLen) {
+ toIdx = listLen-1;
+ }
+ if (fromIdx > toIdx) {
+ return Tcl_NewObj();
+ }
+
+ newLen = toIdx - fromIdx + 1;
+
+ if (Tcl_IsShared(listPtr) ||
+ ((ListRepPtr(listPtr)->refCount > 1))) {
+ return Tcl_NewListObj(newLen, &elemPtrs[fromIdx]);
+ }
+
+ /*
+ * In-place is possible.
+ */
+
+ /*
+ * Even if nothing below cause any changes, we still want the
+ * string-canonizing effect of [lrange 0 end].
+ */
+
+ TclInvalidateStringRep(listPtr);
+
+ /*
+ * Delete elements that should not be included.
+ */
+
+ for (i = 0; i < fromIdx; i++) {
+ TclDecrRefCount(elemPtrs[i]);
+ }
+ for (i = toIdx + 1; i < listLen; i++) {
+ TclDecrRefCount(elemPtrs[i]);
+ }
+
+ if (fromIdx > 0) {
+ memmove(elemPtrs, &elemPtrs[fromIdx],
+ (size_t) newLen * sizeof(Tcl_Obj*));
+ }
+
+ listRepPtr = ListRepPtr(listPtr);
+ listRepPtr->elemCount = newLen;
+
+ return listPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
*
- * The elements accessible via 'objvPtr' should be treated as readonly
- * and the refCount for each object is _not_ incremented; the caller
- * must do that if it holds on to a reference. Furthermore, the
- * pointer and length returned by this function may change as soon as
- * any function is called on the list object. Be careful about
- * retaining the pointer in a local data structure.
+ * Tcl_ListObjGetElements --
*
- * TCL_ERROR
+ * This function returns an (objc,objv) array of the elements in a list
+ * object.
*
- * 'listPtr' is not a valid list. An error message is left in the
- * interpreter's result if 'interp' is not NULL.
+ * Results:
+ * The return value is normally TCL_OK; in this case *objcPtr is set to
+ * the count of list elements and *objvPtr is set to a pointer to an
+ * array of (*objcPtr) pointers to each list element. If listPtr does not
+ * refer to a list object and the object can not be converted to one,
+ * TCL_ERROR is returned and an error message will be left in the
+ * interpreter's result if interp is not NULL.
*
- * Effect
+ * The objects referenced by the returned array should be treated as
+ * readonly and their ref counts are _not_ incremented; the caller must
+ * do that if it holds on to a reference. Furthermore, the pointer and
+ * length returned by this function may change as soon as any function is
+ * called on the list object; be careful about retaining the pointer in a
+ * local data structure.
*
- * 'listPtr' is converted to a list object if it isn't one already.
+ * Side effects:
+ * The possible conversion of the object referenced by listPtr
+ * to a list object.
*
*----------------------------------------------------------------------
*/
@@ -429,10 +566,13 @@ Tcl_ListObjGetElements(
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
- int result;
+ ListGetIntRep(listPtr, listRepPtr);
- if (listPtr->bytes == tclEmptyStringRep) {
+ if (listRepPtr == NULL) {
+ int result, length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
*objcPtr = 0;
*objvPtr = NULL;
return TCL_OK;
@@ -441,8 +581,8 @@ Tcl_ListObjGetElements(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
*objcPtr = listRepPtr->elemCount;
*objvPtr = &listRepPtr->elements;
return TCL_OK;
@@ -453,27 +593,20 @@ Tcl_ListObjGetElements(
*
* Tcl_ListObjAppendList --
*
- * Appends the elements of elemListPtr to those of listPtr.
- *
- * Value
- *
- * TCL_OK
- *
- * Success.
+ * This function appends the elements in the list value referenced by
+ * elemListPtr to the list value referenced by listPtr.
*
- * TCL_ERROR
+ * Results:
+ * The return value is normally TCL_OK. If listPtr or elemListPtr do not
+ * refer to list values, TCL_ERROR is returned and an error message is
+ * left in the interpreter's result if interp is not NULL.
*
- * 'listPtr' or 'elemListPtr' are not valid lists. An error
- * message is left in the interpreter's result if 'interp' is not NULL.
- *
- * Effect
- *
- * The reference count of each element of 'elemListPtr' as it is added to
- * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
- * if they are not already. Appending the new elements may cause the
- * array of element pointers in 'listObj' to grow. If any objects are
- * appended to 'listPtr'. Any preexisting string representation of
- * 'listPtr' is invalidated.
+ * Side effects:
+ * The reference counts of the elements in elemListPtr are incremented
+ * since the list now refers to them. listPtr and elemListPtr are
+ * converted, if necessary, to list objects. Also, appending the new
+ * elements may cause listObj's array of element pointers to grow.
+ * listPtr's old string representation, if any, is invalidated.
*
*----------------------------------------------------------------------
*/
@@ -512,27 +645,24 @@ Tcl_ListObjAppendList(
*
* Tcl_ListObjAppendElement --
*
- * Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
- *
- * Value
- *
- * TCL_OK
- *
- * 'objPtr' is appended to the elements of 'listPtr'.
- *
- * TCL_ERROR
- *
- * listPtr does not refer to a list object and the object can not be
- * converted to one. An error message will be left in the
- * interpreter's result if interp is not NULL.
- *
- * Effect
- *
- * If 'listPtr' is not already of type 'tclListType', it is converted.
- * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
- * Appending the new element may cause the the array of element pointers
- * in 'listObj' to grow. Any preexisting string representation of
- * 'listPtr' is invalidated.
+ * This function is a special purpose version of Tcl_ListObjAppendList:
+ * it appends a single object referenced by objPtr to the list object
+ * referenced by listPtr. If listPtr is not already a list object, an
+ * attempt will be made to convert it to one.
+ *
+ * Results:
+ * The return value is normally TCL_OK; in this case objPtr is added to
+ * the end of listPtr's list. If listPtr does not refer to a list object
+ * and the object can not be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter's result if interp is
+ * not NULL.
+ *
+ * Side effects:
+ * The ref count of objPtr is incremented since the list now refers to
+ * it. listPtr will be converted, if necessary, to a list object. Also,
+ * appending the new element may cause listObj's array of element
+ * pointers to grow. listPtr's old string representation, if any, is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
@@ -549,10 +679,13 @@ Tcl_ListObjAppendElement(
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
}
- if (listPtr->typePtr != &tclListType) {
- int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
Tcl_SetListObj(listPtr, 1, &objPtr);
return TCL_OK;
}
@@ -560,9 +693,9 @@ Tcl_ListObjAppendElement(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
numElems = listRepPtr->elemCount;
numRequired = numElems + 1 ;
needGrow = (numRequired > listRepPtr->maxElemCount);
@@ -658,7 +791,11 @@ Tcl_ListObjAppendElement(
}
listRepPtr = newPtr;
}
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ ListResetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount++;
+ TclFreeIntRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount--;
/*
* Add objPtr to the end of listPtr's array of element pointers. Increment
@@ -683,27 +820,23 @@ Tcl_ListObjAppendElement(
*
* Tcl_ListObjIndex --
*
- * Retrieve a pointer to the element of 'listPtr' at 'index'. The index
- * of the first element is 0.
- *
- * Value
- *
- * TCL_OK
- *
- * A pointer to the element at 'index' is stored in 'objPtrPtr'. If
- * 'index' is out of range, NULL is stored in 'objPtrPtr'. This
- * object should be treated as readonly and its 'refCount' is _not_
- * incremented. The caller must do that if it holds on to the
- * reference.
- *
- * TCL_ERROR
+ * This function returns a pointer to the index'th object from the list
+ * referenced by listPtr. The first element has index 0. If index is
+ * negative or greater than or equal to the number of elements in the
+ * list, a NULL is returned. If listPtr is not a list object, an attempt
+ * will be made to convert it to a list.
*
- * 'listPtr' is not a valid list. An an error message is left in the
- * interpreter's result if 'interp' is not NULL.
+ * Results:
+ * The return value is normally TCL_OK; in this case objPtrPtr is set to
+ * the Tcl_Obj pointer for the index'th list element or NULL if index is
+ * out of range. This object should be treated as readonly and its ref
+ * count is _not_ incremented; the caller must do that if it holds on to
+ * the reference. If listPtr does not refer to a list and can't be
+ * converted to one, TCL_ERROR is returned and an error message is left
+ * in the interpreter's result if interp is not NULL.
*
- * Effect
- *
- * If 'listPtr' is not already of type 'tclListType', it is converted.
+ * Side effects:
+ * listPtr will be converted, if necessary, to a list object.
*
*----------------------------------------------------------------------
*/
@@ -717,10 +850,12 @@ Tcl_ListObjIndex(
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
- int result;
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
- if (listPtr->bytes == tclEmptyStringRep) {
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
*objPtrPtr = NULL;
return TCL_OK;
}
@@ -728,9 +863,9 @@ Tcl_ListObjIndex(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
if ((index < 0) || (index >= listRepPtr->elemCount)) {
*objPtrPtr = NULL;
} else {
@@ -745,20 +880,19 @@ Tcl_ListObjIndex(
*
* Tcl_ListObjLength --
*
- * Retrieve the number of elements in a list.
- *
- * Value
- *
- * TCL_OK
+ * This function returns the number of elements in a list object. If the
+ * object is not already a list object, an attempt will be made to
+ * convert it to one.
*
- * A count of list elements is stored at the address provided by
- * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
- * converted.
+ * Results:
+ * The return value is normally TCL_OK; in this case *intPtr will be set
+ * to the integer count of list elements. If listPtr does not refer to a
+ * list object and the object can not be converted to one, TCL_ERROR is
+ * returned and an error message will be left in the interpreter's result
+ * if interp is not NULL.
*
- * TCL_ERROR
- *
- * 'listPtr' is not a valid list. An error message will be left in
- * the interpreter's result if 'interp' is not NULL.
+ * Side effects:
+ * The possible conversion of the argument object to a list object.
*
*----------------------------------------------------------------------
*/
@@ -771,10 +905,12 @@ Tcl_ListObjLength(
{
register List *listRepPtr;
- if (listPtr->typePtr != &tclListType) {
- int result;
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
- if (listPtr->bytes == tclEmptyStringRep) {
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
*intPtr = 0;
return TCL_OK;
}
@@ -782,9 +918,9 @@ Tcl_ListObjLength(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
*intPtr = listRepPtr->elemCount;
return TCL_OK;
}
@@ -794,36 +930,35 @@ Tcl_ListObjLength(
*
* Tcl_ListObjReplace --
*
- * Replace values in a list.
- *
- * If 'first' is zero or negative, it refers to the first element. If
- * 'first' outside the range of elements in the list, no elements are
- * deleted.
- *
- * If 'count' is zero or negative no elements are deleted, and any new
- * elements are inserted at the beginning of the list.
- *
- * Value
- *
- * TCL_OK
- *
- * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
- * starting at 'first'. If 'objc' 0, no new elements are added.
- *
- * TCL_ERROR
- *
- * 'listPtr' is not a valid list. An error message is left in the
- * interpreter's result if 'interp' is not NULL.
- *
- * Effect
- *
- * If 'listPtr' is not of type 'tclListType', it is converted if possible.
- *
- * The 'refCount' of each element appended to the list is incremented.
- * Similarly, the 'refCount' for each replaced element is decremented.
- *
- * If 'listPtr' is modified, any previous string representation is
- * invalidated.
+ * This function replaces zero or more elements of the list referenced by
+ * listPtr with the objects from an (objc,objv) array. The objc elements
+ * of the array referenced by objv replace the count elements in listPtr
+ * starting at first.
+ *
+ * If the argument first is zero or negative, it refers to the first
+ * element. If first is greater than or equal to the number of elements
+ * in the list, then no elements are deleted; the new elements are
+ * appended to the list. Count gives the number of elements to replace.
+ * If count is zero or negative then no elements are deleted; the new
+ * elements are simply inserted before first.
+ *
+ * The argument objv refers to an array of objc pointers to the new
+ * elements to be added to listPtr in place of those that were deleted.
+ * If objv is NULL, no new elements are added. If listPtr is not a list
+ * object, an attempt will be made to convert it to one.
+ *
+ * Results:
+ * The return value is normally TCL_OK. If listPtr does not refer to a
+ * list object and can not be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter's result if interp is
+ * not NULL.
+ *
+ * Side effects:
+ * The ref counts of the objc elements in objv are incremented since the
+ * resulting list now refers to them. Similarly, the ref counts for
+ * replaced objects are decremented. listPtr is converted, if necessary,
+ * to a list object. listPtr's old string representation, if any, is
+ * freed.
*
*----------------------------------------------------------------------
*/
@@ -845,9 +980,14 @@ Tcl_ListObjReplace(
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
}
- if (listPtr->typePtr != &tclListType) {
- if (listPtr->bytes == tclEmptyStringRep) {
- if (!objc) {
+
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
+ if (objc == 0) {
return TCL_OK;
}
Tcl_SetListObj(listPtr, objc, NULL);
@@ -858,6 +998,7 @@ Tcl_ListObjReplace(
return result;
}
}
+ ListGetIntRep(listPtr, listRepPtr);
}
/*
@@ -868,7 +1009,6 @@ Tcl_ListObjReplace(
* Resist any temptation to optimize this case.
*/
- listRepPtr = ListRepPtr(listPtr);
elemPtrs = &listRepPtr->elements;
numElems = listRepPtr->elemCount;
@@ -922,7 +1062,7 @@ Tcl_ListObjReplace(
}
if (newPtr) {
listRepPtr = newPtr;
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ ListResetIntRep(listPtr, listRepPtr);
elemPtrs = &listRepPtr->elements;
listRepPtr->maxElemCount = attempt;
needGrow = numRequired > listRepPtr->maxElemCount;
@@ -995,7 +1135,7 @@ Tcl_ListObjReplace(
}
}
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+ ListResetIntRep(listPtr, listRepPtr);
listRepPtr->refCount++;
elemPtrs = &listRepPtr->elements;
@@ -1068,10 +1208,15 @@ Tcl_ListObjReplace(
listRepPtr->elemCount = numRequired;
/*
- * Invalidate and free any old string representation since it no longer
- * reflects the list's internal representation.
+ * Invalidate and free any old representations that may not agree
+ * with the revised list's internal representation.
*/
+ listRepPtr->refCount++;
+ TclFreeIntRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount--;
+
TclInvalidateStringRep(listPtr);
return TCL_OK;
}
@@ -1081,19 +1226,22 @@ Tcl_ListObjReplace(
*
* TclLindexList --
*
- * Implements the 'lindex' command when objc==3.
- *
- * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
- * the argument format into required form while taking care to manage
- * shimmering so as to tend to keep the most useful intreps
- * and/or avoid the most expensive conversions.
+ * This procedure handles the 'lindex' command when objc==3.
*
- * Value
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
*
- * A pointer to the specified element, with its 'refCount' incremented, or
- * NULL if an error occurred.
+ * Side effects:
+ * None.
*
- * Notes
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLindexFlat. All it does is reconfigure the argument format into the
+ * form required by TclLindexFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
*----------------------------------------------------------------------
*/
@@ -1107,6 +1255,7 @@ TclLindexList(
int index; /* Index into the list. */
Tcl_Obj *indexListCopy;
+ List *listRepPtr;
/*
* Determine whether argPtr designates a list or a single index. We have
@@ -1114,7 +1263,8 @@ TclLindexList(
* shimmering; see TIP#22 and TIP#33 for the details.
*/
- if (argPtr->typePtr != &tclListType
+ ListGetIntRep(argPtr, listRepPtr);
+ if ((listRepPtr == NULL)
&& TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
/*
* argPtr designates a single index.
@@ -1145,13 +1295,12 @@ TclLindexList(
return TclLindexFlat(interp, listPtr, 1, &argPtr);
}
- {
- int indexCount = -1; /* Size of the array of list indices. */
- Tcl_Obj **indices = NULL; /* Array of list indices. */
+ ListGetIntRep(indexListCopy, listRepPtr);
- TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
- listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
- }
+ assert(listRepPtr != NULL);
+
+ listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
+ &listRepPtr->elements);
Tcl_DecrRefCount(indexListCopy);
return listPtr;
}
@@ -1159,20 +1308,25 @@ TclLindexList(
/*
*----------------------------------------------------------------------
*
- * TclLindexFlat --
+ * TclLindexFlat --
*
- * The core of the 'lindex' command, with all index
- * arguments presented as a flat list.
+ * This procedure is the core of the 'lindex' command, with all index
+ * arguments presented as a flat list.
*
- * Value
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
*
- * A pointer to the object extracted, with its 'refCount' incremented, or
- * NULL if an error occurred. Thus, the calling code will usually do
- * something like:
- *
- * Tcl_SetObjResult(interp, result);
- * Tcl_DecrRefCount(result);
+ * Side effects:
+ * None.
*
+ * Notes:
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned. Thus, the calling code will
+ * usually do something like:
+ * Tcl_SetObjResult(interp, result);
+ * Tcl_DecrRefCount(result);
*
*----------------------------------------------------------------------
*/
@@ -1248,16 +1402,24 @@ TclLindexFlat(
*
* TclLsetList --
*
- * The core of [lset] when objc == 4. Objv[2] may be either a
+ * Core of the 'lset' command when objc == 4. Objv[2] may be either a
* scalar index or a list of indices.
+ * It also handles 'lpop' when given a NULL value.
*
- * Implemented entirely as a wrapper around 'TclLindexFlat', as described
- * for 'TclLindexList'.
+ * Results:
+ * Returns the new value of the list variable, or NULL if there was an
+ * error. The returned object includes one reference count for the
+ * pointer returned.
*
- * Value
+ * Side effects:
+ * None.
*
- * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
- * there was an error.
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLsetFlat. All it does is reconfigure the argument format into the
+ * form required by TclLsetFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
*----------------------------------------------------------------------
*/
@@ -1267,13 +1429,14 @@ TclLsetList(
Tcl_Interp *interp, /* Tcl interpreter. */
Tcl_Obj *listPtr, /* Pointer to the list being modified. */
Tcl_Obj *indexArgPtr, /* Index or index-list arg to 'lset'. */
- Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
+ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */
{
int indexCount = 0; /* Number of indices in the index list. */
Tcl_Obj **indices = NULL; /* Vector of indices in the index list. */
Tcl_Obj *retValuePtr; /* Pointer to the list to be returned. */
int index; /* Current index in the list - discarded. */
Tcl_Obj *indexListCopy;
+ List *listRepPtr;
/*
* Determine whether the index arg designates a list or a single index.
@@ -1281,7 +1444,8 @@ TclLsetList(
* shimmering; see TIP #22 and #23 for details.
*/
- if (indexArgPtr->typePtr != &tclListType
+ ListGetIntRep(indexArgPtr, listRepPtr);
+ if (listRepPtr == NULL
&& TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
/*
* indexArgPtr designates a single index.
@@ -1318,40 +1482,38 @@ TclLsetList(
* TclLsetFlat --
*
* Core engine of the 'lset' command.
- *
- * Value
- *
- * The resulting list
- *
- * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not
- * duplicated, its 'refCount' is incremented. The reference count of
- * an unduplicated object is therefore 2 (one for the returned pointer
- * and one for the variable that holds it). The reference count of a
- * duplicate object is 1, reflecting that result is the only active
- * reference. The caller is expected to store the result in the
- * variable and decrement its reference count. (INST_STORE_* does
- * exactly this.)
- *
- * NULL
- *
- * An error occurred. If 'listPtr' was duplicated, the reference
- * count on the duplicate is decremented so that it is 0, causing any
- * memory allocated by this function to be freed.
- *
- *
- * Effect
- *
- * On entry, the reference count of 'listPtr' does not reflect any
- * references held on the stack. The first action of this function is to
- * determine whether 'listPtr' is shared and to create a duplicate
- * unshared copy if it is. The reference count of the duplicate is
- * incremented. At this point, the reference count is 1 in either case so
- * that the object is considered unshared.
- *
- * The unshared list is altered directly to produce the result.
- * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
+ * It also handles 'lpop' when given a NULL value.
+ *
+ * Results:
+ * Returns the new value of the list variable, or NULL if an error
+ * occurred. The returned object includes one reference count for the
+ * pointer returned.
+ *
+ * Side effects:
+ * 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 function.
+ *
+ * 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.)
+ *
+ * Surgery is performed on the unshared list value to produce the result.
+ * TclLsetFlat maintains a linked list of Tcl_Obj's whose string
* representations must be spoilt by threading via 'ptr2' of the
- * two-pointer internal representation. On entry to 'TclLsetFlat', the
+ * two-pointer internal representation. On entry to TclLsetFlat, the
* values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
* Tcl_Obj that has been modified is set to NULL.
*
@@ -1365,18 +1527,22 @@ TclLsetFlat(
int indexCount, /* Number of index args. */
Tcl_Obj *const indexArray[],
/* Index args. */
- Tcl_Obj *valuePtr) /* Value arg to 'lset'. */
+ Tcl_Obj *valuePtr) /* Value arg to 'lset' or NULL to 'lpop'. */
{
int index, result, len;
Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
+ Tcl_ObjIntRep *irPtr;
/*
* If there are no indices, simply return the new value. (Without
* indices, [lset] is a synonym for [set].
+ * [lpop] does not use this but protect for NULL valuePtr just in case.
*/
if (indexCount == 0) {
- Tcl_IncrRefCount(valuePtr);
+ if (valuePtr != NULL) {
+ Tcl_IncrRefCount(valuePtr);
+ }
return valuePtr;
}
@@ -1436,12 +1602,14 @@ TclLsetFlat(
}
indexArray++;
- if (index < 0 || index > elemCount) {
+ if (index < 0 || index > elemCount
+ || (valuePtr == NULL && index >= elemCount)) {
/* ...the index points outside the sublist. */
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LSET",
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION",
+ valuePtr == NULL ? "LPOP" : "LSET",
"BADINDEX", NULL);
}
result = TCL_ERROR;
@@ -1499,7 +1667,8 @@ TclLsetFlat(
* them at that time.
*/
- parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
+ irPtr = TclFetchIntRep(parentList, &tclListType);
+ irPtr->twoPtrValue.ptr2 = chainPtr;
chainPtr = parentList;
}
} while (indexCount > 0);
@@ -1513,22 +1682,32 @@ TclLsetFlat(
while (chainPtr) {
Tcl_Obj *objPtr = chainPtr;
+ List *listRepPtr;
+
+ /*
+ * Clear away our intrep surgery mess.
+ */
+
+ irPtr = TclFetchIntRep(objPtr, &tclListType);
+ listRepPtr = irPtr->twoPtrValue.ptr1;
+ chainPtr = irPtr->twoPtrValue.ptr2;
if (result == TCL_OK) {
+
/*
* We're going to store valuePtr, so spoil string reps of all
* containing lists.
*/
+ listRepPtr->refCount++;
+ TclFreeIntRep(objPtr);
+ ListSetIntRep(objPtr, listRepPtr);
+ listRepPtr->refCount--;
+
TclInvalidateStringRep(objPtr);
+ } else {
+ irPtr->twoPtrValue.ptr2 = NULL;
}
-
- /*
- * Clear away our intrep surgery mess.
- */
-
- chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
}
if (result != TCL_OK) {
@@ -1551,12 +1730,14 @@ TclLsetFlat(
len = -1;
TclListObjLength(NULL, subListPtr, &len);
- if (index == len) {
+ if (valuePtr == NULL) {
+ Tcl_ListObjReplace(NULL, subListPtr, index, 1, 0, NULL);
+ } else if (index == len) {
Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
} else {
TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+ TclInvalidateStringRep(subListPtr);
}
- TclInvalidateStringRep(subListPtr);
Tcl_IncrRefCount(retValuePtr);
return retValuePtr;
}
@@ -1566,38 +1747,26 @@ TclLsetFlat(
*
* TclListObjSetElement --
*
- * Set a single element of a list to a specified value.
- *
- * It is the caller's responsibility to invalidate the string
- * representation of the 'listPtr'.
- *
- * Value
- *
- * TCL_OK
- *
- * Success.
+ * Set a single element of a list to a specified value
*
- * TCL_ERROR
+ * 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.
*
- * 'listPtr' does not refer to a list object and cannot be converted
- * to one. An error message will be left in the interpreter result if
- * interp is not NULL.
- *
- * TCL_ERROR
- *
- * An index designates an element outside the range [0..listLength-1],
- * where 'listLength' is the count of elements in the list object
- * designated by 'listPtr'. An error message is left in the
- * interpreter result.
- *
- * Effect
- *
- * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If
- * 'listPtr' is not already of type 'tclListType', it is converted and the
- * internal representation is unshared. The 'refCount' of the element at
- * 'index' is decremented and replaced in the list with the 'valuePtr',
- * whose 'refCount' in turn is incremented.
+ * Side effects:
+ * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
+ * to convert it to a list with a non-shared internal rep. 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.
*
*----------------------------------------------------------------------
*/
@@ -1624,10 +1793,13 @@ TclListObjSetElement(
if (Tcl_IsShared(listPtr)) {
Tcl_Panic("%s called with shared object", "TclListObjSetElement");
}
- if (listPtr->typePtr != &tclListType) {
- int result;
- if (listPtr->bytes == tclEmptyStringRep) {
+ ListGetIntRep(listPtr, listRepPtr);
+ if (listRepPtr == NULL) {
+ int result, length;
+
+ (void) Tcl_GetStringFromObj(listPtr, &length);
+ if (length == 0) {
if (interp != NULL) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("list index out of range", -1));
@@ -1640,9 +1812,9 @@ TclListObjSetElement(
if (result != TCL_OK) {
return result;
}
+ ListGetIntRep(listPtr, listRepPtr);
}
- listRepPtr = ListRepPtr(listPtr);
elemCount = listRepPtr->elemCount;
/*
@@ -1685,7 +1857,8 @@ TclListObjSetElement(
listRepPtr->refCount--;
- listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
+ listRepPtr = newPtr;
+ ListResetIntRep(listPtr, listRepPtr);
}
elemPtrs = &listRepPtr->elements;
@@ -1707,6 +1880,18 @@ TclListObjSetElement(
elemPtrs[index] = valuePtr;
+ /*
+ * Invalidate outdated intreps.
+ */
+
+ ListGetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount++;
+ TclFreeIntRep(listPtr);
+ ListSetIntRep(listPtr, listRepPtr);
+ listRepPtr->refCount--;
+
+ TclInvalidateStringRep(listPtr);
+
return TCL_OK;
}
@@ -1715,14 +1900,15 @@ TclListObjSetElement(
*
* FreeListInternalRep --
*
- * Deallocate the storage associated with the internal representation of a
- * a list object.
+ * Deallocate the storage associated with a list object's internal
+ * representation.
*
- * Effect
+ * Results:
+ * None.
*
- * The storage for the internal 'List' pointer of 'listPtr' is freed, the
- * 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount'
- * of each element of the list is decremented.
+ * Side effects:
+ * Frees listPtr's List* internal representation, if no longer shared.
+ * May decrement the ref counts of element objects, which may free them.
*
*----------------------------------------------------------------------
*/
@@ -1731,7 +1917,10 @@ static void
FreeListInternalRep(
Tcl_Obj *listPtr) /* List object with internal rep to free. */
{
- List *listRepPtr = ListRepPtr(listPtr);
+ List *listRepPtr;
+
+ ListGetIntRep(listPtr, listRepPtr);
+ assert(listRepPtr != NULL);
if (listRepPtr->refCount-- <= 1) {
Tcl_Obj **elemPtrs = &listRepPtr->elements;
@@ -1742,8 +1931,6 @@ FreeListInternalRep(
}
ckfree(listRepPtr);
}
-
- listPtr->typePtr = NULL;
}
/*
@@ -1751,12 +1938,14 @@ FreeListInternalRep(
*
* DupListInternalRep --
*
- * Initialize the internal representation of a list 'Tcl_Obj' to share the
+ * Initialize the internal representation of a list Tcl_Obj to share the
* internal representation of an existing list object.
*
- * Effect
+ * Results:
+ * None.
*
- * The 'refCount' of the List internal rep is incremented.
+ * Side effects:
+ * The reference count of the List internal rep is incremented.
*
*----------------------------------------------------------------------
*/
@@ -1766,8 +1955,10 @@ DupListInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- List *listRepPtr = ListRepPtr(srcPtr);
+ List *listRepPtr;
+ ListGetIntRep(srcPtr, listRepPtr);
+ assert(listRepPtr != NULL);
ListSetIntRep(copyPtr, listRepPtr);
}
@@ -1776,20 +1967,16 @@ DupListInternalRep(
*
* SetListFromAny --
*
- * Convert any object to a list.
- *
- * Value
- *
- * TCL_OK
+ * Attempt to generate a list internal form for the Tcl object "objPtr".
*
- * Success. The internal representation of 'objPtr' is set, and the type
- * of 'objPtr' is 'tclListType'.
- *
- * TCL_ERROR
- *
- * An error occured during conversion. An error message is left in the
- * interpreter's result if 'interp' is not NULL.
+ * Results:
+ * The return value is TCL_OK or TCL_ERROR. 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, a list is stored as "objPtr"s internal
+ * representation.
*
*----------------------------------------------------------------------
*/
@@ -1810,7 +1997,7 @@ SetListFromAny(
* describe duplicate keys).
*/
- if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+ if (!TclHasStringRep(objPtr) && TclHasIntRep(objPtr, &tclDictType)) {
Tcl_Obj *keyPtr, *valuePtr;
Tcl_DictSearch search;
int done, size;
@@ -1868,28 +2055,37 @@ SetListFromAny(
while (nextElem < limit) {
const char *elemStart;
+ char *check;
int elemSize, literal;
if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
&elemStart, &nextElem, &elemSize, &literal)) {
+ fail:
while (--elemPtrs >= &listRepPtr->elements) {
Tcl_DecrRefCount(*elemPtrs);
}
- ckfree((char *) listRepPtr);
+ ckfree(listRepPtr);
return TCL_ERROR;
}
if (elemStart == limit) {
break;
}
- /* TODO: replace panic with error on alloc failure? */
- if (literal) {
- TclNewStringObj(*elemPtrs, elemStart, elemSize);
- } else {
- TclNewObj(*elemPtrs);
- (*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
- (*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
- (*elemPtrs)->bytes);
+ TclNewObj(*elemPtrs);
+ TclInvalidateStringRep(*elemPtrs);
+ check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL,
+ elemSize);
+ if (elemSize && check == NULL) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "cannot construct list, out of memory", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ goto fail;
+ }
+ if (!literal) {
+ Tcl_InitStringRep(*elemPtrs, NULL,
+ TclCopyAndCollapse(elemSize, elemStart, check));
}
Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
@@ -1899,12 +2095,11 @@ SetListFromAny(
}
/*
- * Free the old internalRep before setting the new one. We do this as late
+ * Store the new internalRep. We do this as late
* as possible to allow the conversion code, in particular
- * Tcl_GetStringFromObj, to use that old internalRep.
+ * Tcl_GetStringFromObj, to use the old internalRep.
*/
- TclFreeIntRep(objPtr);
ListSetIntRep(objPtr, listRepPtr);
return TCL_OK;
}
@@ -1914,16 +2109,18 @@ SetListFromAny(
*
* UpdateStringOfList --
*
- * Update the string representation for a list object.
- *
- * Any previously-exising string representation is not invalidated, so
- * storage is lost if this has not been taken care of.
+ * Update the string representation for a list object. Note: This
+ * function does not invalidate an existing old string rep so storage
+ * will be lost if this has not already been done.
*
- * Effect
+ * Results:
+ * None.
*
- * The string representation of 'listPtr' is set to the resulting string.
- * This string will be empty if the list has no elements. It is assumed
- * that the list internal representation is not NULL.
+ * Side effects:
+ * The object's string is set to a valid string that results from the
+ * list-to-string conversion. This string will be empty if the list has
+ * no elements. The list internal representation should not be NULL and
+ * we assume it is not NULL.
*
*----------------------------------------------------------------------
*/
@@ -1934,12 +2131,17 @@ UpdateStringOfList(
{
# define LOCAL_SIZE 64
char localFlags[LOCAL_SIZE], *flagPtr = NULL;
- List *listRepPtr = ListRepPtr(listPtr);
- int numElems = listRepPtr->elemCount;
- int i, length, bytesNeeded = 0;
- const char *elem;
+ int numElems, i, length, bytesNeeded = 0;
+ const char *elem, *start;
char *dst;
Tcl_Obj **elemPtrs;
+ List *listRepPtr;
+
+ ListGetIntRep(listPtr, listRepPtr);
+
+ assert(listRepPtr != NULL);
+
+ numElems = listRepPtr->elemCount;
/*
* Mark the list as being canonical; although it will now have a string
@@ -1954,8 +2156,7 @@ UpdateStringOfList(
*/
if (numElems == 0) {
- listPtr->bytes = tclEmptyStringRep;
- listPtr->length = 0;
+ Tcl_InitStringRep(listPtr, NULL, 0);
return;
}
@@ -1984,39 +2185,23 @@ UpdateStringOfList(
if (bytesNeeded > INT_MAX - numElems + 1) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
}
- bytesNeeded += numElems;
+ bytesNeeded += numElems - 1;
/*
* Pass 2: copy into string rep buffer.
*/
- /*
- * We used to set the string length here, relying on a presumed
- * guarantee that the number of bytes TclScanElement() calls reported
- * to be needed was a precise count and not an over-estimate, so long
- * as the same flag values were passed to TclConvertElement().
- *
- * Then we saw [35a8f1c04a], where a bug in TclScanElement() caused
- * that guarantee to fail. Rather than trust there are no more bugs,
- * we set the length after the loop based on what was actually written,
- * an not on what was predicted.
- *
- listPtr->length = bytesNeeded - 1;
- *
- */
-
- listPtr->bytes = ckalloc(bytesNeeded);
- dst = listPtr->bytes;
+ start = dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
+ TclOOM(dst, bytesNeeded);
for (i = 0; i < numElems; i++) {
flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
elem = TclGetStringFromObj(elemPtrs[i], &length);
dst += TclConvertElement(elem, length, dst, flagPtr[i]);
*dst++ = ' ';
}
- dst[-1] = '\0';
- /* Here is the safe setting of the string length. */
- listPtr->length = dst - 1 - listPtr->bytes;
+ /* Set the string length to what was actually written, the safe choice */
+ (void) Tcl_InitStringRep(listPtr, NULL, dst - 1 - start);
if (flagPtr != localFlags) {
ckfree(flagPtr);
diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c
index 16185e6..577c9e5 100644
--- a/generic/tclLiteral.c
+++ b/generic/tclLiteral.c
@@ -174,7 +174,7 @@ TclDeleteLiteralTable(
Tcl_Obj *
TclCreateLiteral(
Interp *iPtr,
- char *bytes, /* The start of the string. Note that this is
+ const char *bytes, /* The start of the string. Note that this is
* not a NUL-terminated string. */
int length, /* Number of bytes in the string. */
unsigned hash, /* The string's hash. If -1, it will be
@@ -186,7 +186,7 @@ TclCreateLiteral(
{
LiteralTable *globalTablePtr = &iPtr->literalTable;
LiteralEntry *globalPtr;
- int globalHash;
+ unsigned int globalHash;
Tcl_Obj *objPtr;
/*
@@ -240,20 +240,22 @@ TclCreateLiteral(
}
/*
- * The literal is new to the interpreter. Add it to the global literal
- * table.
+ * The literal is new to the interpreter.
*/
TclNewObj(objPtr);
if ((flags & LITERAL_ON_HEAP)) {
- objPtr->bytes = bytes;
+ objPtr->bytes = (char *) bytes;
objPtr->length = length;
} else {
TclInitStringRep(objPtr, bytes, length);
}
+ /* Should the new literal be shared globally? */
+
if ((flags & LITERAL_UNSHARED)) {
/*
+ * No, do *not* add it the global literal table
* Make clear, that no global value is returned
*/
if (globalPtrPtr != NULL) {
@@ -262,6 +264,9 @@ TclCreateLiteral(
return objPtr;
}
+ /*
+ * Yes, add it to the global literal table.
+ */
#ifdef TCL_COMPILE_DEBUG
if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) {
Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be",
@@ -381,7 +386,7 @@ int
TclRegisterLiteral(
void *ePtr, /* Points to the CompileEnv in whose object
* array an object is found or created. */
- register char *bytes, /* Points to string for which to find or
+ register const char *bytes, /* Points to string for which to find or
* create an object in CompileEnv's object
* array. */
int length, /* Number of bytes in the string. If < 0, the
@@ -399,7 +404,8 @@ TclRegisterLiteral(
LiteralEntry *globalPtr, *localPtr;
Tcl_Obj *objPtr;
unsigned hash;
- int localHash, objIndex, new;
+ unsigned int localHash;
+ int objIndex, new;
Namespace *nsPtr;
if (length < 0) {
@@ -543,7 +549,8 @@ TclHideLiteral(
{
LiteralEntry **nextPtrPtr, *entryPtr, *lPtr;
LiteralTable *localTablePtr = &envPtr->localLitTable;
- int localHash, length;
+ unsigned int localHash;
+ int length;
const char *bytes;
Tcl_Obj *newObjPtr;
@@ -562,7 +569,7 @@ TclHideLiteral(
lPtr->objPtr = newObjPtr;
bytes = TclGetStringFromObj(newObjPtr, &length);
- localHash = (HashString(bytes, length) & localTablePtr->mask);
+ localHash = HashString(bytes, length) & localTablePtr->mask;
nextPtrPtr = &localTablePtr->buckets[localHash];
for (entryPtr=*nextPtrPtr ; entryPtr!=NULL ; entryPtr=*nextPtrPtr) {
@@ -618,7 +625,7 @@ TclAddLiteralObj(
lPtr = &envPtr->literalArrayPtr[objIndex];
lPtr->objPtr = objPtr;
Tcl_IncrRefCount(objPtr);
- lPtr->refCount = -1; /* i.e., unused */
+ lPtr->refCount = (size_t)-1; /* i.e., unused */
lPtr->nextPtr = NULL;
if (litPtrPtr) {
@@ -693,7 +700,7 @@ AddLocalLiteralEntry(
}
if (!found) {
- bytes = Tcl_GetStringFromObj(objPtr, &length);
+ bytes = TclGetStringFromObj(objPtr, &length);
Tcl_Panic("%s: literal \"%.*s\" wasn't found locally",
"AddLocalLiteralEntry", (length>60? 60 : length), bytes);
}
@@ -815,7 +822,8 @@ TclReleaseLiteral(
LiteralTable *globalTablePtr;
register LiteralEntry *entryPtr, *prevPtr;
const char *bytes;
- int length, index;
+ int length;
+ unsigned int index;
if (iPtr == NULL) {
goto done;
@@ -834,15 +842,13 @@ TclReleaseLiteral(
for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
- entryPtr->refCount--;
-
/*
* If the literal is no longer being used by any ByteCode, 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) {
+ if (entryPtr->refCount-- <= 1) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
} else {
@@ -960,8 +966,8 @@ RebuildLiteralTable(
register LiteralEntry *entryPtr;
LiteralEntry **bucketPtr;
const char *bytes;
- unsigned int oldSize;
- int count, index, length;
+ unsigned int oldSize, index;
+ int count, length;
oldSize = tablePtr->numBuckets;
oldBuckets = tablePtr->buckets;
@@ -1047,7 +1053,7 @@ TclInvalidateCmdLiteral(
* invalidate a cmd literal. */
{
Interp *iPtr = (Interp *) interp;
- Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, (char *) name,
+ Tcl_Obj *literalObjPtr = TclCreateLiteral(iPtr, name,
strlen(name), -1, NULL, nsPtr, 0, NULL);
if (literalObjPtr != NULL) {
@@ -1169,7 +1175,7 @@ TclVerifyLocalLiteralTable(
localPtr=localPtr->nextPtr) {
count++;
if (localPtr->refCount != -1) {
- bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length);
+ bytes = TclGetStringFromObj(localPtr->objPtr, &length);
Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d",
"TclVerifyLocalLiteralTable",
(length>60? 60 : length), bytes, localPtr->refCount);
@@ -1220,7 +1226,7 @@ TclVerifyGlobalLiteralTable(
globalPtr=globalPtr->nextPtr) {
count++;
if (globalPtr->refCount < 1) {
- bytes = Tcl_GetStringFromObj(globalPtr->objPtr, &length);
+ bytes = TclGetStringFromObj(globalPtr->objPtr, &length);
Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d",
"TclVerifyGlobalLiteralTable",
(length>60? 60 : length), bytes, globalPtr->refCount);
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index f1bd248..77e6425 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -470,6 +470,19 @@ Tcl_LoadObjCmd(
*/
if (code != TCL_OK) {
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
+ Interp *iPtr = (Interp *) target;
+ if (iPtr->result && *(iPtr->result) && !iPtr->freeProc) {
+ /*
+ * A call to Tcl_InitStubs() determined the caller extension and
+ * this interp are incompatible in their stubs mechanisms, and
+ * recorded the error in the oldest legacy place we have to do so.
+ */
+ Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->result, -1));
+ iPtr->result = &tclEmptyString;
+ iPtr->freeProc = NULL;
+ }
+#endif /* defined(TCL_NO_DEPRECATED) */
Tcl_TransferResult(target, code, interp);
goto done;
}
@@ -998,7 +1011,7 @@ Tcl_StaticPackage(
}
/*
- * Package isn't loade in the current interp yet. Mark it as now being
+ * Package isn't loaded in the current interp yet. Mark it as now being
* loaded.
*/
@@ -1012,10 +1025,10 @@ Tcl_StaticPackage(
/*
*----------------------------------------------------------------------
*
- * TclGetLoadedPackages --
+ * TclGetLoadedPackages, TclGetLoadedPackagesEx --
*
* This function returns information about all of the files that are
- * loaded (either in a particular intepreter, or for all interpreters).
+ * loaded (either in a particular interpreter, or for all interpreters).
*
* Results:
* The return value is a standard Tcl completion code. If successful, a
@@ -1039,16 +1052,27 @@ TclGetLoadedPackages(
* otherwise, just return info about this
* interpreter. */
{
+ return TclGetLoadedPackagesEx(interp, targetName, NULL);
+}
+
+int
+TclGetLoadedPackagesEx(
+ Tcl_Interp *interp, /* Interpreter in which to return information
+ * or error message. */
+ const char *targetName, /* Name of target interpreter or NULL. If
+ * NULL, return info about all interps;
+ * otherwise, just return info about this
+ * interpreter. */
+ const char *packageName) /* Package name or NULL. If NULL, return info
+ * for all packages.
+ */
+{
Tcl_Interp *target;
LoadedPackage *pkgPtr;
InterpPackage *ipPtr;
Tcl_Obj *resultObj, *pkgDesc[2];
if (targetName == NULL) {
- /*
- * Return information about all of the available packages.
- */
-
resultObj = Tcl_NewObj();
Tcl_MutexLock(&packageMutex);
for (pkgPtr = firstPackagePtr; pkgPtr != NULL;
@@ -1063,16 +1087,38 @@ TclGetLoadedPackages(
return TCL_OK;
}
- /*
- * Return information about only the packages that are loaded in a given
- * interpreter.
- */
-
target = Tcl_GetSlave(interp, targetName);
if (target == NULL) {
return TCL_ERROR;
}
ipPtr = Tcl_GetAssocData(target, "tclLoad", NULL);
+
+ /*
+ * Return information about all of the available packages.
+ */
+ if (packageName) {
+ resultObj = NULL;
+
+ for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
+ pkgPtr = ipPtr->pkgPtr;
+
+ if (!strcmp(packageName, pkgPtr->packageName)) {
+ resultObj = Tcl_NewStringObj(pkgPtr->fileName, -1);
+ break;
+ }
+ }
+
+ if (resultObj) {
+ Tcl_SetObjResult(interp, resultObj);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Return information about only the packages that are loaded in a given
+ * interpreter.
+ */
+
resultObj = Tcl_NewObj();
for (; ipPtr != NULL; ipPtr = ipPtr->nextPtr) {
pkgPtr = ipPtr->pkgPtr;
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 927de7e..9380fb2 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -112,7 +112,7 @@ typedef enum {
PROMPT_CONTINUE /* Print prompt for command continuation */
} PromptType;
-typedef struct InteractiveState {
+typedef struct {
Tcl_Channel input; /* The standard input channel from which lines
* are read. */
int tty; /* Non-zero means standard input is a
@@ -246,7 +246,7 @@ Tcl_SourceRCFile(
const char *fileName;
Tcl_Channel chan;
- fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY);
+ fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY);
if (fileName != NULL) {
Tcl_Channel c;
const char *fullName;
@@ -283,7 +283,7 @@ Tcl_SourceRCFile(
/*----------------------------------------------------------------------
*
- * Tcl_Main, Tcl_MainEx --
+ * Tcl_MainEx --
*
* Main program for tclsh and most other Tcl-based applications.
*
@@ -532,7 +532,7 @@ Tcl_MainEx(
* error messages troubles deeper in, so lop it back off.
*/
- Tcl_GetStringFromObj(is.commandPtr, &length);
+ TclGetStringFromObj(is.commandPtr, &length);
Tcl_SetObjLength(is.commandPtr, --length);
code = Tcl_RecordAndEvalObj(interp, is.commandPtr,
TCL_EVAL_GLOBAL);
@@ -549,7 +549,7 @@ Tcl_MainEx(
} else if (is.tty) {
resultPtr = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(resultPtr);
- Tcl_GetStringFromObj(resultPtr, &length);
+ TclGetStringFromObj(resultPtr, &length);
chan = Tcl_GetStdChannel(TCL_STDOUT);
if ((length > 0) && chan) {
Tcl_WriteObj(chan, resultPtr);
@@ -634,21 +634,6 @@ Tcl_MainEx(
Tcl_Exit(exitCode);
}
-
-#if (TCL_MAJOR_VERSION == 8) && !defined(UNICODE)
-#undef Tcl_Main
-extern DLLEXPORT void
-Tcl_Main(
- int argc, /* Number of arguments. */
- char **argv, /* Array of argument strings. */
- Tcl_AppInitProc *appInitProc)
- /* Application-specific initialization
- * function to call after most initialization
- * but before starting to execute commands. */
-{
- Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
-}
-#endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */
#ifndef TCL_ASCII_MAIN
@@ -808,7 +793,7 @@ StdinProc(
goto prompt;
}
isPtr->prompt = PROMPT_START;
- Tcl_GetStringFromObj(commandPtr, &length);
+ TclGetStringFromObj(commandPtr, &length);
Tcl_SetObjLength(commandPtr, --length);
/*
@@ -839,7 +824,7 @@ StdinProc(
chan = Tcl_GetStdChannel(TCL_STDOUT);
Tcl_IncrRefCount(resultPtr);
- Tcl_GetStringFromObj(resultPtr, &length);
+ TclGetStringFromObj(resultPtr, &length);
if ((length > 0) && (chan != NULL)) {
Tcl_WriteObj(chan, resultPtr);
Tcl_WriteChars(chan, "\n", 1);
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 2297de4..de2222e 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -25,14 +25,15 @@
#include "tclInt.h"
#include "tclCompile.h" /* for TclLogCommandInfo visibility */
+#include <assert.h>
/*
* Thread-local storage used to avoid having a global lock on data that is not
* limited to a single interpreter.
*/
-typedef struct ThreadSpecificData {
- long numNsCreated; /* Count of the number of namespaces created
+typedef struct {
+ unsigned long numNsCreated; /* Count of the number of namespaces created
* within the thread. This value is used as a
* unique id for each namespace. Cannot be
* per-interp because the nsId is used to
@@ -59,7 +60,7 @@ typedef struct ResolvedNsName {
* the name was resolved. NULL if the name is
* fully qualified and thus the resolution
* does not depend on the context. */
- int refCount; /* Reference count: 1 for each nsName object
+ size_t refCount; /* Reference count: 1 for each nsName object
* that has a pointer to this ResolvedNsName
* structure as its internal rep. This
* structure can be freed when refCount
@@ -89,8 +90,6 @@ static char * EstablishErrorInfoTraces(ClientData clientData,
static void FreeNsNameInternalRep(Tcl_Obj *objPtr);
static int GetNamespaceFromObj(Tcl_Interp *interp,
Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
-static int InvokeImportedCmd(ClientData clientData,
- Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int InvokeImportedNRCmd(ClientData clientData,
Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
static int NamespaceChildrenCmd(ClientData dummy,
@@ -154,6 +153,22 @@ static const Tcl_ObjType nsNameType = {
SetNsNameFromAny /* setFromAnyProc */
};
+#define NsNameSetIntRep(objPtr, nnPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (nnPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (nnPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &nsNameType, &ir); \
+ } while (0)
+
+#define NsNameGetIntRep(objPtr, nnPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &nsNameType); \
+ (nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* Array of values describing how to implement each standard subcommand of the
* "namespace" command.
@@ -402,7 +417,7 @@ Tcl_PopCallFrame(
}
if (framePtr->numCompiledLocals > 0) {
TclDeleteCompiledLocalVars(iPtr, framePtr);
- if (--framePtr->localCachePtr->refCount == 0) {
+ if (framePtr->localCachePtr->refCount-- <= 1) {
TclFreeLocalCache(interp, framePtr->localCachePtr);
}
framePtr->localCachePtr = NULL;
@@ -1323,8 +1338,7 @@ void
TclNsDecrRefCount(
Namespace *nsPtr)
{
- nsPtr->refCount--;
- if ((nsPtr->refCount == 0) && (nsPtr->flags & NS_DEAD)) {
+ if ((nsPtr->refCount-- <= 1) && (nsPtr->flags & NS_DEAD)) {
NamespaceFree(nsPtr);
}
}
@@ -1767,7 +1781,7 @@ DoImport(
dataPtr = ckalloc(sizeof(ImportedCmdData));
importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
- InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
+ TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
DeleteImportedCmd);
dataPtr->realCmdPtr = cmdPtr;
dataPtr->selfPtr = (Command *) importedCmd;
@@ -1988,7 +2002,7 @@ TclGetOriginalCommand(
/*
*----------------------------------------------------------------------
*
- * InvokeImportedCmd --
+ * TclInvokeImportedCmd --
*
* Invoked by Tcl whenever the user calls an imported command that was
* created by Tcl_Import. Finds the "real" command (in another
@@ -2019,8 +2033,8 @@ InvokeImportedNRCmd(
return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
}
-static int
-InvokeImportedCmd(
+int
+TclInvokeImportedCmd(
ClientData clientData, /* Points to the imported command's
* ImportedCmdData structure. */
Tcl_Interp *interp, /* Current interpreter. */
@@ -2901,26 +2915,29 @@ GetNamespaceFromObj(
Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */
{
ResolvedNsName *resNamePtr;
- Namespace *nsPtr, *refNsPtr;
- if (objPtr->typePtr == &nsNameType) {
+ NsNameGetIntRep(objPtr, resNamePtr);
+ if (resNamePtr) {
+ Namespace *nsPtr, *refNsPtr;
+
/*
* Check that the ResolvedNsName is still valid; avoid letting the ref
* cross interps.
*/
- resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
nsPtr = resNamePtr->nsPtr;
refNsPtr = resNamePtr->refNsPtr;
- if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp) &&
- (!refNsPtr || ((interp == refNsPtr->interp) &&
- (refNsPtr== (Namespace *) Tcl_GetCurrentNamespace(interp))))){
+ if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
+ && (!refNsPtr || (refNsPtr ==
+ (Namespace *) TclGetCurrentNamespace(interp)))) {
*nsPtrPtr = (Tcl_Namespace *) nsPtr;
return TCL_OK;
}
+ Tcl_StoreIntRep(objPtr, &nsNameType, NULL);
}
if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
- resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ NsNameGetIntRep(objPtr, resNamePtr);
+ assert(resNamePtr != NULL);
*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
return TCL_OK;
}
@@ -4690,15 +4707,17 @@ FreeNsNameInternalRep(
register Tcl_Obj *objPtr) /* nsName object with internal representation
* to free. */
{
- ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedNsName *resNamePtr;
+
+ NsNameGetIntRep(objPtr, resNamePtr);
+ assert(resNamePtr != NULL);
/*
* Decrement the reference count of the namespace. If there are no more
* references, free it up.
*/
- resNamePtr->refCount--;
- if (resNamePtr->refCount == 0) {
+ if (resNamePtr->refCount-- <= 1) {
/*
* Decrement the reference count for the cached namespace. If the
* namespace is dead, and there are no more references to it, free
@@ -4708,7 +4727,6 @@ FreeNsNameInternalRep(
TclNsDecrRefCount(resNamePtr->nsPtr);
ckfree(resNamePtr);
}
- objPtr->typePtr = NULL;
}
/*
@@ -4735,11 +4753,11 @@ DupNsNameInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ ResolvedNsName *resNamePtr;
- copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- resNamePtr->refCount++;
- copyPtr->typePtr = &nsNameType;
+ NsNameGetIntRep(srcPtr, resNamePtr);
+ assert(resNamePtr != NULL);
+ NsNameSetIntRep(copyPtr, resNamePtr);
}
/*
@@ -4784,36 +4802,25 @@ SetNsNameFromAny(
TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
&nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
+ if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+ return TCL_ERROR;
+ }
+
/*
* If we found a namespace, then create a new ResolvedNsName structure
* that holds a reference to it.
*/
- if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
- /*
- * Our failed lookup proves any previously cached nsName intrep is no
- * longer valid. Get rid of it so we no longer waste memory storing
- * it, nor time determining its invalidity again and again.
- */
-
- if (objPtr->typePtr == &nsNameType) {
- TclFreeIntRep(objPtr);
- }
- return TCL_ERROR;
- }
-
nsPtr->refCount++;
resNamePtr = ckalloc(sizeof(ResolvedNsName));
resNamePtr->nsPtr = nsPtr;
if ((name[0] == ':') && (name[1] == ':')) {
resNamePtr->refNsPtr = NULL;
} else {
- resNamePtr->refNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
+ resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
- resNamePtr->refCount = 1;
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
- objPtr->typePtr = &nsNameType;
+ resNamePtr->refCount = 0;
+ NsNameSetIntRep(objPtr, resNamePtr);
return TCL_OK;
}
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 39d3806..0440395 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -26,11 +26,13 @@ static const struct {
int flag;
} defineCmds[] = {
{"constructor", TclOODefineConstructorObjCmd, 0},
+ {"definitionnamespace", TclOODefineDefnNsObjCmd, 0},
{"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
{"destructor", TclOODefineDestructorObjCmd, 0},
{"export", TclOODefineExportObjCmd, 0},
{"forward", TclOODefineForwardObjCmd, 0},
{"method", TclOODefineMethodObjCmd, 0},
+ {"private", TclOODefinePrivateObjCmd, 0},
{"renamemethod", TclOODefineRenameMethodObjCmd, 0},
{"self", TclOODefineSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 0},
@@ -41,7 +43,9 @@ static const struct {
{"export", TclOODefineExportObjCmd, 1},
{"forward", TclOODefineForwardObjCmd, 1},
{"method", TclOODefineMethodObjCmd, 1},
+ {"private", TclOODefinePrivateObjCmd, 1},
{"renamemethod", TclOODefineRenameMethodObjCmd, 1},
+ {"self", TclOODefineObjSelfObjCmd, 0},
{"unexport", TclOODefineUnexportObjCmd, 1},
{NULL, NULL, 0}
};
@@ -69,7 +73,9 @@ static void DeletedHelpersNamespace(ClientData clientData);
static Tcl_NRPostProc FinalizeAlloc;
static Tcl_NRPostProc FinalizeNext;
static Tcl_NRPostProc FinalizeObjectCall;
-static void initClassPath(Tcl_Interp * interp, Class *clsPtr);
+static inline void InitClassPath(Tcl_Interp * interp, Class *clsPtr);
+static void InitClassSystemRoots(Tcl_Interp *interp,
+ Foundation *fPtr);
static int InitFoundation(Tcl_Interp *interp);
static void KillFoundation(ClientData clientData,
Tcl_Interp *interp);
@@ -78,22 +84,20 @@ static void ObjectNamespaceDeleted(ClientData clientData);
static void ObjectRenamedTrace(ClientData clientData,
Tcl_Interp *interp, const char *oldName,
const char *newName, int flags);
+static inline void RemoveClass(Class **list, int num, int idx);
+static inline void RemoveObject(Object **list, int num, int idx);
static inline void SquelchCachedName(Object *oPtr);
-static int PublicObjectCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const *objv);
static int PublicNRObjectCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-static int PrivateObjectCmd(ClientData clientData,
+static int PrivateNRObjectCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-static int PrivateNRObjectCmd(ClientData clientData,
+static int MyClassNRObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
-static void RemoveClass(Class ** list, int num, int idx);
-static void RemoveObject(Object ** list, int num, int idx);
+static void MyClassDeleted(ClientData clientData);
/*
* Methods in the oo::object and oo::class classes. First, we define a helper
@@ -144,65 +148,10 @@ static const char *initScript =
/* " tcloo.tcl OO_LIBRARY oo::library;"; */
/*
- * The scripted part of the definitions of slots.
- */
-
-static const char *slotScript =
-"::oo::define ::oo::Slot {\n"
-" method Get {} {error unimplemented}\n"
-" method Set list {error unimplemented}\n"
-" method -set args {\n"
-" uplevel 1 [list [namespace which my] Set $args]\n"
-" }\n"
-" method -append args {\n"
-" uplevel 1 [list [namespace which my] Set [list"
-" {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
-" }\n"
-" method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
-" forward --default-operation my -append\n"
-" method unknown {args} {\n"
-" set def --default-operation\n"
-" if {[llength $args] == 0} {\n"
-" return [uplevel 1 [list [namespace which my] $def]]\n"
-" } elseif {![string match -* [lindex $args 0]]} {\n"
-" return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
-" }\n"
-" next {*}$args\n"
-" }\n"
-" export -set -append -clear\n"
-" unexport unknown destroy\n"
-"}\n"
-"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
-"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
-"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";
-
-/*
- * The body of the <cloned> method of oo::object.
+ * The scripted part of the definitions of TclOO.
*/
-static const char *clonedBody =
-"foreach p [info procs [info object namespace $originObject]::*] {"
-" set args [info args $p];"
-" set idx -1;"
-" foreach a $args {"
-" lset args [incr idx] "
-" [if {[info default $p $a d]} {list $a $d} {list $a}]"
-" };"
-" set b [info body $p];"
-" set p [namespace tail $p];"
-" proc $p $args $b;"
-"};"
-"foreach v [info vars [info object namespace $originObject]::*] {"
-" upvar 0 $v vOrigin;"
-" namespace upvar [namespace current] [namespace tail $v] vNew;"
-" if {[info exists vOrigin]} {"
-" if {[array exists vOrigin]} {"
-" array set vNew [array get vOrigin];"
-" } else {"
-" set vNew $vOrigin;"
-" }"
-" }"
-"}";
+#include "tclOOScript.h"
/*
* The actual definition of the variable holding the TclOO stub table.
@@ -232,14 +181,50 @@ MODULE_SCOPE const TclOOStubs tclOOStubs;
#define IsRoot(ocPtr) ((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))
#define RemoveItem(type, lst, i) \
- do { \
- Remove ## type ((lst).list, (lst).num, i); \
- (lst).num--; \
+ do { \
+ Remove ## type ((lst).list, (lst).num, i); \
+ (lst).num--; \
} while (0)
/*
* ----------------------------------------------------------------------
*
+ * RemoveClass, RemoveObject --
+ *
+ * Helpers for the RemoveItem macro for deleting a class or object from a
+ * list. Setting the "empty" location to NULL makes debugging a little
+ * easier.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+RemoveClass(
+ Class **list,
+ int num,
+ int idx)
+{
+ for (; idx < num - 1; idx++) {
+ list[idx] = list[idx + 1];
+ }
+ list[idx] = NULL;
+}
+
+static inline void
+RemoveObject(
+ Object **list,
+ int num,
+ int idx)
+{
+ for (; idx < num - 1; idx++) {
+ list[idx] = list[idx + 1];
+ }
+ list[idx] = NULL;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOOInit --
*
* Called to initialise the OO system within an interpreter.
@@ -271,7 +256,7 @@ TclOOInit(
* to be fully provided.
*/
- if (Tcl_Eval(interp, initScript) != TCL_OK) {
+ if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
return TCL_ERROR;
}
@@ -316,11 +301,7 @@ InitFoundation(
ThreadLocalData *tsdPtr =
Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
Foundation *fPtr = ckalloc(sizeof(Foundation));
- Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
-
- Class fakeCls;
- Object fakeObject;
-
+ Tcl_Obj *namePtr;
Tcl_DString buffer;
Command *cmdPtr;
int i;
@@ -383,58 +364,10 @@ InitFoundation(
Tcl_CallWhenDeleted(interp, KillFoundation, NULL);
/*
- * Create the objects at the core of the object system. These need to be
- * spliced manually.
- */
-
- /* Stand up a phony class for bootstrapping. */
- fPtr->objectCls = &fakeCls;
- /* referenced in TclOOAllocClass to increment the refCount. */
- fakeCls.thisPtr = &fakeObject;
-
- fPtr->objectCls = TclOOAllocClass(interp,
- AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
- /* Corresponding TclOODecrRefCount in KillFoudation */
- AddRef(fPtr->objectCls->thisPtr);
-
- /* This is why it is unnecessary in this routine to replace the
- * incremented reference count of fPtr->objectCls that was swallowed by
- * fakeObject. */
- fPtr->objectCls->superclasses.num = 0;
- ckfree(fPtr->objectCls->superclasses.list);
- fPtr->objectCls->superclasses.list = NULL;
-
- /* special initialization for the primordial objects */
- fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
- fPtr->objectCls->flags |= ROOT_OBJECT;
-
- fPtr->classCls = TclOOAllocClass(interp,
- AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
- /* Corresponding TclOODecrRefCount in KillFoudation */
- AddRef(fPtr->classCls->thisPtr);
-
- /*
- * Increment reference counts for each reference because these
- * relationships can be dynamically changed.
- *
- * Corresponding TclOODecrRefCount for all incremented refcounts is in
- * KillFoundation.
+ * Create the special objects at the core of the object system.
*/
- /* Rewire bootstrapped objects. */
- fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
- AddRef(fPtr->classCls->thisPtr);
- TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
-
- fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
- AddRef(fPtr->classCls->thisPtr);
- TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
-
- fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
- fPtr->classCls->flags |= ROOT_CLASS;
-
- /* Standard initialization for new Objects */
- TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
+ InitClassSystemRoots(interp, fPtr);
/*
* Basic method declarations for the core classes.
@@ -448,18 +381,6 @@ InitFoundation(
}
/*
- * Create the default <cloned> method implementation, used when 'oo::copy'
- * is called to finish the copying of one object to another.
- */
-
- TclNewLiteralStringObj(argsPtr, "originObject");
- Tcl_IncrRefCount(argsPtr);
- bodyPtr = Tcl_NewStringObj(clonedBody, -1);
- TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
- bodyPtr, NULL);
- TclDecrRefCount(argsPtr);
-
- /*
* Finish setting up the class of classes by marking the 'new' method as
* private; classes, unlike general objects, must have explicit names. We
* also need to create the constructor for classes.
@@ -499,7 +420,102 @@ InitFoundation(
if (TclOODefineSlots(fPtr) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_Eval(interp, slotScript);
+
+ /*
+ * Evaluate the remaining definitions, which are a compiled-in Tcl script.
+ */
+
+ return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * InitClassSystemRoots --
+ *
+ * Creates the objects at the core of the object system. These need to be
+ * spliced manually.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InitClassSystemRoots(
+ Tcl_Interp *interp,
+ Foundation *fPtr)
+{
+ Class fakeCls;
+ Object fakeObject;
+ Tcl_Obj *defNsName;
+
+ /* Stand up a phony class for bootstrapping. */
+ fPtr->objectCls = &fakeCls;
+ /* referenced in TclOOAllocClass to increment the refCount. */
+ fakeCls.thisPtr = &fakeObject;
+
+ fPtr->objectCls = TclOOAllocClass(interp,
+ AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
+ /* Corresponding TclOODecrRefCount in KillFoudation */
+ AddRef(fPtr->objectCls->thisPtr);
+
+ /*
+ * This is why it is unnecessary in this routine to replace the
+ * incremented reference count of fPtr->objectCls that was swallowed by
+ * fakeObject.
+ */
+
+ fPtr->objectCls->superclasses.num = 0;
+ ckfree(fPtr->objectCls->superclasses.list);
+ fPtr->objectCls->superclasses.list = NULL;
+
+ /*
+ * Special initialization for the primordial objects.
+ */
+
+ fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
+ fPtr->objectCls->flags |= ROOT_OBJECT;
+ TclNewLiteralStringObj(defNsName, "::oo::objdefine");
+ fPtr->objectCls->objDefinitionNs = defNsName;
+ Tcl_IncrRefCount(defNsName);
+
+ fPtr->classCls = TclOOAllocClass(interp,
+ AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
+ /* Corresponding TclOODecrRefCount in KillFoudation */
+ AddRef(fPtr->classCls->thisPtr);
+
+ /*
+ * Increment reference counts for each reference because these
+ * relationships can be dynamically changed.
+ *
+ * Corresponding TclOODecrRefCount for all incremented refcounts is in
+ * KillFoundation.
+ */
+
+ /*
+ * Rewire bootstrapped objects.
+ */
+
+ fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
+ AddRef(fPtr->classCls->thisPtr);
+ TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
+
+ fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
+ AddRef(fPtr->classCls->thisPtr);
+ TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
+
+ fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
+ fPtr->classCls->flags |= ROOT_CLASS;
+ TclNewLiteralStringObj(defNsName, "::oo::define");
+ fPtr->classCls->clsDefinitionNs = defNsName;
+ Tcl_IncrRefCount(defNsName);
+
+ /* Standard initialization for new Objects */
+ TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
+
+ /*
+ * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING.
+ * Everything else is careful to prohibit looping.
+ */
}
/*
@@ -594,8 +610,8 @@ AllocObject(
* if the OO system should pick the object
* name itself (equal to the namespace
* name). */
- Namespace *nsPtr, /* The namespace to create the object in,
- or NULL if *nameStr is NULL */
+ Namespace *nsPtr, /* The namespace to create the object in, or
+ * NULL if *nameStr is NULL */
const char *nsNameStr) /* The name of the namespace to create, or
* NULL if the OO system should pick a unique
* name itself. If this is non-NULL but names
@@ -692,10 +708,10 @@ AllocObject(
/*
* An object starts life with a refCount of 2 to mark the two stages of
* destruction it occur: A call to ObjectRenamedTrace(), and a call to
- * ObjectNamespaceDeleted().
+ * ObjectNamespaceDeleted().
*/
- oPtr->refCount = 2;
+ oPtr->refCount = 2;
oPtr->flags = USE_CLASS_CACHE;
/*
@@ -710,10 +726,9 @@ AllocObject(
if (nsPtr->parentPtr != NULL) {
nsPtr = nsPtr->parentPtr;
}
-
}
oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
- (Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
+ (Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);
/*
* Add the NRE command and trace directly. While this breaks a number of
@@ -730,7 +745,10 @@ AllocObject(
tracePtr->refCount = 1;
oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
- PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
+ TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
+ oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
+ oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
+ MyClassDeleted);
return oPtr;
}
@@ -758,12 +776,12 @@ SquelchCachedName(
/*
* ----------------------------------------------------------------------
*
- * MyDeleted --
+ * MyDeleted, MyClassDeleted --
*
- * This callback is triggered when the object's [my] command is deleted
- * by any mechanism. It just marks the object as not having a [my]
- * command, and so prevents cleanup of that when the object itself is
- * deleted.
+ * These callbacks are triggered when the object's [my] or [myclass]
+ * commands are deleted by any mechanism. They just mark the object as
+ * not having a [my] command or [myclass] command, and so prevent cleanup
+ * of those commands when the object itself is deleted.
*
* ----------------------------------------------------------------------
*/
@@ -777,6 +795,14 @@ MyDeleted(
oPtr->myCommand = NULL;
}
+
+static void
+MyClassDeleted(
+ ClientData clientData)
+{
+ Object *oPtr = clientData;
+ oPtr->myclassCommand = NULL;
+}
/*
* ----------------------------------------------------------------------
@@ -800,6 +826,7 @@ ObjectRenamedTrace(
int flags) /* Why was the object deleted? */
{
Object *oPtr = clientData;
+
/*
* If this is a rename and not a delete of the object, we just flush the
* cache of the object name.
@@ -863,6 +890,7 @@ TclOODeleteDescendants(
ckfree(clsPtr->mixinSubs.list);
clsPtr->mixinSubs.size = 0;
}
+
/*
* Squelch subclasses of this class.
*/
@@ -891,7 +919,10 @@ TclOODeleteDescendants(
if (clsPtr->instances.num > 0) {
while (clsPtr->instances.num > 0) {
instancePtr = clsPtr->instances.list[clsPtr->instances.num-1];
- /* This condition also covers the case where instancePtr == oPtr */
+ /*
+ * This condition also covers the case where instancePtr == oPtr
+ */
+
if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
!(instancePtr->flags & DONT_DELETE)) {
Tcl_DeleteCommandFromToken(interp, instancePtr->command);
@@ -905,7 +936,6 @@ TclOODeleteDescendants(
clsPtr->instances.size = 0;
}
}
-
/*
* ----------------------------------------------------------------------
@@ -924,11 +954,12 @@ TclOOReleaseClassContents(
Object *oPtr) /* The object representing the class. */
{
FOREACH_HASH_DECLS;
- int i;
+ int i;
Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
Method *mPtr;
Foundation *fPtr = oPtr->fPtr;
Tcl_Obj *variableObj;
+ PrivateVariableMapping *privateVariable;
/*
* Sanity check!
@@ -945,6 +976,19 @@ TclOOReleaseClassContents(
}
/*
+ * Stop using the class for definition information.
+ */
+
+ if (clsPtr->clsDefinitionNs) {
+ Tcl_DecrRefCount(clsPtr->clsDefinitionNs);
+ clsPtr->clsDefinitionNs = NULL;
+ }
+ if (clsPtr->objDefinitionNs) {
+ Tcl_DecrRefCount(clsPtr->objDefinitionNs);
+ clsPtr->objDefinitionNs = NULL;
+ }
+
+ /*
* Squelch method implementation chain caches.
*/
@@ -1032,6 +1076,14 @@ TclOOReleaseClassContents(
ckfree(clsPtr->variables.list);
}
+ FOREACH_STRUCT(privateVariable, clsPtr->privateVariables) {
+ TclDecrRefCount(privateVariable->variableObj);
+ TclDecrRefCount(privateVariable->fullNameObj);
+ }
+ if (i) {
+ ckfree(clsPtr->privateVariables.list);
+ }
+
if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
}
@@ -1061,13 +1113,16 @@ ObjectNamespaceDeleted(
Class *mixinPtr;
Method *mPtr;
Tcl_Obj *filterObj, *variableObj;
+ PrivateVariableMapping *privateVariable;
Tcl_Interp *interp = oPtr->fPtr->interp;
int i;
if (Deleted(oPtr)) {
- /* To do: Can ObjectNamespaceDeleted ever be called twice? If not,
- * this guard could be removed.
+ /*
+ * TODO: Can ObjectNamespaceDeleted ever be called twice? If not, this
+ * guard could be removed.
*/
+
return;
}
@@ -1076,6 +1131,7 @@ ObjectNamespaceDeleted(
* process of being deleted, nothing else may modify its bookeeping
* records. This is the flag that
*/
+
oPtr->flags |= OBJECT_DELETED;
/* Let the dominoes fall */
@@ -1089,9 +1145,10 @@ ObjectNamespaceDeleted(
* in that case when the destructor is partially deleted before the uses
* of it have gone. [Bug 2949397]
*/
+
if (!Tcl_InterpDeleted(interp) && !(oPtr->flags & DESTRUCTOR_CALLED)) {
CallContext *contextPtr =
- TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
+ TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL, NULL);
int result;
Tcl_InterpState state;
@@ -1128,9 +1185,13 @@ ObjectNamespaceDeleted(
* The namespace must have been deleted directly. Delete the command
* as well.
*/
+
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
}
+ if (oPtr->myclassCommand) {
+ Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
+ }
if (oPtr->myCommand) {
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
}
@@ -1140,7 +1201,10 @@ ObjectNamespaceDeleted(
* methods on the object.
*/
- /* To do: Should this be protected with a * !IsRoot() condition? */
+ /*
+ * TODO: Should this be protected with a * !IsRoot() condition?
+ */
+
TclOORemoveFromInstances(oPtr, oPtr->selfCls);
if (oPtr->mixins.num > 0) {
@@ -1175,6 +1239,14 @@ ObjectNamespaceDeleted(
ckfree(oPtr->variables.list);
}
+ FOREACH_STRUCT(privateVariable, oPtr->privateVariables) {
+ TclDecrRefCount(privateVariable->variableObj);
+ TclDecrRefCount(privateVariable->fullNameObj);
+ }
+ if (i) {
+ ckfree(oPtr->privateVariables.list);
+ }
+
if (oPtr->chainCache) {
TclOODeleteChainCache(oPtr->chainCache);
}
@@ -1196,7 +1268,7 @@ ObjectNamespaceDeleted(
/*
* Because an object can be a class that is an instance of itself, the
* class object's class structure should only be cleaned after most of
- * the cleanup on the object is done.
+ * the cleanup on the object is done.
*
* The class of objects needs some special care; if it is deleted (and
* we're not killing the whole interpreter) we force the delete of the
@@ -1207,7 +1279,6 @@ ObjectNamespaceDeleted(
if (IsRootObject(oPtr) && !Deleted(fPtr->classCls->thisPtr)
&& !Tcl_InterpDeleted(interp)) {
-
Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);
}
@@ -1230,7 +1301,7 @@ ObjectNamespaceDeleted(
/*
* ----------------------------------------------------------------------
*
- * TclOODecrRef --
+ * TclOODecrRefCount --
*
* Decrement the refcount of an object and deallocate storage then object
* is no longer referenced. Returns 1 if storage was deallocated, and 0
@@ -1238,8 +1309,13 @@ ObjectNamespaceDeleted(
*
* ----------------------------------------------------------------------
*/
-int TclOODecrRefCount(Object *oPtr) {
+
+int
+TclOODecrRefCount(
+ Object *oPtr)
+{
if (oPtr->refCount-- <= 1) {
+
if (oPtr->classPtr != NULL) {
ckfree(oPtr->classPtr);
}
@@ -1249,18 +1325,6 @@ int TclOODecrRefCount(Object *oPtr) {
return 0;
}
-/* setting the "empty" location to NULL makes debugging a little easier */
-#define REMOVEBODY { \
- for (; idx < num - 1; idx++) { \
- list[idx] = list[idx+1]; \
- } \
- list[idx] = NULL; \
- return; \
-}
-void RemoveClass(Class **list, int num, int idx) REMOVEBODY
-
-void RemoveObject(Object **list, int num, int idx) REMOVEBODY
-
/*
* ----------------------------------------------------------------------
*
@@ -1498,6 +1562,25 @@ TclOOAddToMixinSubs(
* ----------------------------------------------------------------------
*/
+static inline void
+InitClassPath(
+ Tcl_Interp *interp,
+ Class *clsPtr)
+{
+ Foundation *fPtr = GetFoundation(interp);
+
+ if (fPtr->helpersNs != NULL) {
+ Tcl_Namespace *path[2];
+
+ path[0] = fPtr->helpersNs;
+ path[1] = fPtr->ooNs;
+ TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
+ } else {
+ TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
+ &fPtr->ooNs);
+ }
+}
+
Class *
TclOOAllocClass(
Tcl_Interp *interp, /* Interpreter within which to allocate the
@@ -1514,7 +1597,8 @@ TclOOAllocClass(
/*
* Configure the namespace path for the class's object.
*/
- initClassPath(interp, clsPtr);
+
+ InitClassPath(interp, clsPtr);
/*
* Classes are subclasses of oo::object, i.e. the objects they create are
@@ -1540,19 +1624,6 @@ TclOOAllocClass(
Tcl_InitObjHashTable(&clsPtr->classMethods);
return clsPtr;
}
-static void
-initClassPath(Tcl_Interp *interp, Class *clsPtr) {
- Foundation *fPtr = GetFoundation(interp);
- if (fPtr->helpersNs != NULL) {
- Tcl_Namespace *path[2];
- path[0] = fPtr->helpersNs;
- path[1] = fPtr->ooNs;
- TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 2, path);
- } else {
- TclSetNsPath((Namespace *) clsPtr->thisPtr->namespacePtr, 1,
- &fPtr->ooNs);
- }
-}
/*
* ----------------------------------------------------------------------
@@ -1583,7 +1654,9 @@ Tcl_NewObjectInstance(
ClientData clientData[4];
oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
- if (oPtr == NULL) {return NULL;}
+ if (oPtr == NULL) {
+ return NULL;
+ }
/*
* Run constructors, except when objc < 0, which is a special flag case
@@ -1592,7 +1665,7 @@ Tcl_NewObjectInstance(
if (objc >= 0) {
CallContext *contextPtr =
- TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
+ TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
if (contextPtr != NULL) {
int isRoot, result;
@@ -1652,7 +1725,9 @@ TclNRNewObjectInstance(
Object *oPtr;
oPtr = TclNewObjectInstanceCommon(interp, classPtr, nameStr, nsNameStr);
- if (oPtr == NULL) {return TCL_ERROR;}
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
/*
* Run constructors, except when objc < 0 (a special flag case used for
@@ -1663,7 +1738,7 @@ TclNRNewObjectInstance(
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
}
- contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
+ contextPtr = TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL, NULL, NULL);
if (contextPtr == NULL) {
*objectPtr = (Tcl_Object) oPtr;
return TCL_OK;
@@ -1703,29 +1778,33 @@ TclNewObjectInstanceCommon(
Foundation *fPtr = GetFoundation(interp);
Object *oPtr;
const char *simpleName = NULL;
- Namespace *nsPtr = NULL, *dummy,
- *inNsPtr = (Namespace *)TclGetCurrentNamespace(interp);
+ Namespace *nsPtr = NULL, *dummy;
+ Namespace *inNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
int isNew;
if (nameStr) {
- TclGetNamespaceForQualName(interp, nameStr, inNsPtr, TCL_CREATE_NS_IF_UNKNOWN,
- &nsPtr, &dummy, &dummy, &simpleName);
+ TclGetNamespaceForQualName(interp, nameStr, inNsPtr,
+ TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy, &dummy, &simpleName);
/*
* Disallow creation of an object over an existing command.
*/
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, simpleName, &isNew);
- if (isNew) {
- /* Just kidding */
- Tcl_DeleteHashEntry(hPtr);
- } else {
+ if (!isNew) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create object \"%s\": command already exists with"
" that name", nameStr));
Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", NULL);
return NULL;
}
+
+ /*
+ * We could make a hash entry! Don't actually want to do that here so
+ * nuke it immediately because we'll create it properly soon.
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
}
/*
@@ -1736,6 +1815,7 @@ TclNewObjectInstanceCommon(
oPtr->selfCls = classPtr;
AddRef(classPtr->thisPtr);
TclOOAddToInstances(oPtr, classPtr);
+
/*
* Check to see if we're really creating a class. If so, allocate the
* class structure as well.
@@ -1771,8 +1851,8 @@ FinalizeAlloc(
Tcl_Object *objectPtr = data[3];
/*
- * Ensure an error if the object was deleted in the constructor.
- * Don't want to lose errors by accident. [Bug 2903011]
+ * Ensure an error if the object was deleted in the constructor. Don't
+ * want to lose errors by accident. [Bug 2903011]
*/
if (result != TCL_ERROR && Deleted(oPtr)) {
@@ -1794,13 +1874,21 @@ FinalizeAlloc(
(void) TclOOObjectName(interp, oPtr);
Tcl_DeleteCommandFromToken(interp, oPtr->command);
}
- /* This decrements the refcount of oPtr */
+
+ /*
+ * This decrements the refcount of oPtr.
+ */
+
TclOODeleteContext(contextPtr);
return TCL_ERROR;
}
Tcl_RestoreInterpState(interp, state);
*objectPtr = (Tcl_Object) oPtr;
- /* This decrements the refcount of oPtr */
+
+ /*
+ * This decrements the refcount of oPtr.
+ */
+
TclOODeleteContext(contextPtr);
return TCL_OK;
}
@@ -1830,6 +1918,7 @@ Tcl_CopyObjectInstance(
Class *mixinPtr;
CallContext *contextPtr;
Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
+ PrivateVariableMapping *privateVariable;
int i, result;
/*
@@ -1899,7 +1988,7 @@ Tcl_CopyObjectInstance(
}
/*
- * Copy the object's variable resolution list to the new object.
+ * Copy the object's variable resolution lists to the new object.
*/
DUPLICATE(o2Ptr->variables, oPtr->variables, Tcl_Obj *);
@@ -1907,6 +1996,13 @@ Tcl_CopyObjectInstance(
Tcl_IncrRefCount(variableObj);
}
+ DUPLICATE(o2Ptr->privateVariables, oPtr->privateVariables,
+ PrivateVariableMapping);
+ FOREACH_STRUCT(privateVariable, o2Ptr->privateVariables) {
+ Tcl_IncrRefCount(privateVariable->variableObj);
+ Tcl_IncrRefCount(privateVariable->fullNameObj);
+ }
+
/*
* Copy the object's flags to the new object, clearing those that must be
* kept object-local. The duplicate is never deleted at this point, nor is
@@ -1915,7 +2011,7 @@ Tcl_CopyObjectInstance(
*/
o2Ptr->flags = oPtr->flags & ~(
- OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
+ OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);
/*
* Copy the object's metadata.
*/
@@ -1995,7 +2091,7 @@ Tcl_CopyObjectInstance(
}
/*
- * Copy the source class's variable resolution list.
+ * Copy the source class's variable resolution lists.
*/
DUPLICATE(cls2Ptr->variables, clsPtr->variables, Tcl_Obj *);
@@ -2003,6 +2099,13 @@ Tcl_CopyObjectInstance(
Tcl_IncrRefCount(variableObj);
}
+ DUPLICATE(cls2Ptr->privateVariables, clsPtr->privateVariables,
+ PrivateVariableMapping);
+ FOREACH_STRUCT(privateVariable, cls2Ptr->privateVariables) {
+ Tcl_IncrRefCount(privateVariable->variableObj);
+ Tcl_IncrRefCount(privateVariable->fullNameObj);
+ }
+
/*
* Duplicate the source class's mixins (which cannot be circular
* references to the duplicate).
@@ -2075,7 +2178,8 @@ Tcl_CopyObjectInstance(
}
TclResetRewriteEnsemble(interp, 1);
- contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
+ contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL,
+ NULL, NULL);
if (contextPtr) {
args[0] = TclOOObjectName(interp, o2Ptr);
args[1] = oPtr->fPtr->clonedName;
@@ -2363,7 +2467,7 @@ Tcl_ObjectSetMetadata(
/*
* ----------------------------------------------------------------------
*
- * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
+ * TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject --
*
* Main entry point for object invocations. The Public* and Private*
* wrapper functions (implementations of both object instance commands
@@ -2373,8 +2477,8 @@ Tcl_ObjectSetMetadata(
* ----------------------------------------------------------------------
*/
-static int
-PublicObjectCmd(
+int
+TclOOPublicObjectCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
@@ -2394,8 +2498,8 @@ PublicNRObjectCmd(
NULL);
}
-static int
-PrivateObjectCmd(
+int
+TclOOPrivateObjectCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
@@ -2448,6 +2552,43 @@ TclOOInvokeObject(
/*
* ----------------------------------------------------------------------
*
+ * TclOOMyClassObjCmd, MyClassNRObjCmd --
+ *
+ * Special trap door to allow an object to delegate simply to its class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOMyClassObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
+}
+
+static int
+MyClassNRObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr = clientData;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
+ return TCL_ERROR;
+ }
+ return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
+ NULL);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOOObjectCmdCore, FinalizeObjectCall --
*
* Main function for object invocations. Does call chain creation,
@@ -2472,6 +2613,9 @@ TclOOObjectCmdCore(
{
CallContext *contextPtr;
Tcl_Obj *methodNamePtr;
+ CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
+ Object *callerObjPtr = NULL;
+ Class *callerClsPtr = NULL;
int result;
/*
@@ -2486,6 +2630,24 @@ TclOOObjectCmdCore(
}
/*
+ * Determine if we're in a context that can see the extra, private methods
+ * in this class.
+ */
+
+ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
+ CallContext *callerContextPtr = framePtr->clientData;
+ Method *callerMethodPtr =
+ callerContextPtr->callPtr->chain[callerContextPtr->index].mPtr;
+
+ if (callerMethodPtr->declaringObjectPtr) {
+ callerObjPtr = callerMethodPtr->declaringObjectPtr;
+ }
+ if (callerMethodPtr->declaringClassPtr) {
+ callerClsPtr = callerMethodPtr->declaringClassPtr;
+ }
+ }
+
+ /*
* Give plugged in code a chance to remap the method name.
*/
@@ -2512,7 +2674,8 @@ TclOOObjectCmdCore(
Tcl_IncrRefCount(mappedMethodName);
contextPtr = TclOOGetCallContext(oPtr, mappedMethodName,
- flags | (oPtr->flags & FILTER_HANDLING), methodNamePtr);
+ flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
+ callerClsPtr, methodNamePtr);
TclDecrRefCount(mappedMethodName);
if (contextPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2529,7 +2692,8 @@ TclOOObjectCmdCore(
noMapping:
contextPtr = TclOOGetCallContext(oPtr, methodNamePtr,
- flags | (oPtr->flags & FILTER_HANDLING), NULL);
+ flags | (oPtr->flags & FILTER_HANDLING), callerObjPtr,
+ callerClsPtr, NULL);
if (contextPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"impossible to invoke method \"%s\": no defined method or"
@@ -2779,9 +2943,9 @@ Tcl_GetObjectFromObj(
if (cmdPtr == NULL) {
goto notAnObject;
}
- if (cmdPtr->objProc != PublicObjectCmd) {
+ if (cmdPtr->objProc != TclOOPublicObjectCmd) {
cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
- if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
+ if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
goto notAnObject;
}
}
diff --git a/generic/tclOO.decls b/generic/tclOO.decls
index 265ba88..f1bb320 100644
--- a/generic/tclOO.decls
+++ b/generic/tclOO.decls
@@ -58,12 +58,12 @@ declare 10 {
}
declare 11 {
Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp, Tcl_Object object,
- Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
+ Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
ClientData clientData)
}
declare 12 {
Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
- Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr,
+ Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr,
ClientData clientData)
}
declare 13 {
@@ -126,6 +126,9 @@ declare 27 {
declare 28 {
Tcl_Obj *Tcl_GetObjectName(Tcl_Interp *interp, Tcl_Object object)
}
+declare 29 {
+ int Tcl_MethodIsPrivate(Tcl_Method method)
+}
######################################################################
# Private API, exposed to support advanced OO systems that plug in on top of
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 32afbf1..9c1dd1e 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -24,7 +24,7 @@
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "1.1.0"
+#define TCLOO_VERSION "1.2.0"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
#include "tcl.h"
@@ -99,6 +99,15 @@ typedef struct {
*/
#define TCL_OO_METHOD_VERSION_CURRENT 1
+
+/*
+ * Visibility constants for the flags parameter to Tcl_NewMethod and
+ * Tcl_NewInstanceMethod.
+ */
+
+#define TCL_OO_METHOD_PUBLIC 1
+#define TCL_OO_METHOD_UNEXPORTED 0
+#define TCL_OO_METHOD_PRIVATE 0x20
/*
* The type of some object (or class) metadata. This describes how to delete
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index d874cba..13c98f4 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -83,7 +83,7 @@ TclOO_Class_Constructor(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
- Tcl_Obj **invoke;
+ Tcl_Obj **invoke, *nameObj;
if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -94,6 +94,17 @@ TclOO_Class_Constructor(
}
/*
+ * Make the class definition delegate. This is special; it doesn't reenter
+ * here (and the class definition delegate doesn't run any constructors).
+ */
+
+ nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1);
+ Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1);
+ Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
+ TclGetString(nameObj), NULL, -1, NULL, -1);
+ Tcl_DecrRefCount(nameObj);
+
+ /*
* Delegate to [oo::define] to do the work.
*/
@@ -111,7 +122,7 @@ TclOO_Class_Constructor(
Tcl_IncrRefCount(invoke[1]);
Tcl_IncrRefCount(invoke[2]);
TclNRAddCallback(interp, DecrRefsPostClassConstructor,
- invoke, NULL, NULL, NULL);
+ invoke, oPtr, NULL, NULL);
/*
* Tricky point: do not want the extra reported level in the Tcl stack
@@ -128,12 +139,27 @@ DecrRefsPostClassConstructor(
int result)
{
Tcl_Obj **invoke = data[0];
+ Object *oPtr = data[1];
+ Tcl_InterpState saved;
+ int code;
TclDecrRefCount(invoke[0]);
TclDecrRefCount(invoke[1]);
TclDecrRefCount(invoke[2]);
+ invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
+ invoke[1] = TclOOObjectName(interp, oPtr);
+ Tcl_IncrRefCount(invoke[0]);
+ Tcl_IncrRefCount(invoke[1]);
+ saved = Tcl_SaveInterpState(interp, result);
+ code = Tcl_EvalObjv(interp, 2, invoke, 0);
+ TclDecrRefCount(invoke[0]);
+ TclDecrRefCount(invoke[1]);
ckfree(invoke);
- return result;
+ if (code != TCL_OK) {
+ Tcl_DiscardInterpState(saved);
+ return code;
+ }
+ return Tcl_RestoreInterpState(interp, saved);
}
/*
@@ -347,7 +373,8 @@ TclOO_Object_Destroy(
}
if (!(oPtr->flags & DESTRUCTOR_CALLED)) {
oPtr->flags |= DESTRUCTOR_CALLED;
- contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
+ contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL, NULL,
+ NULL);
if (contextPtr != NULL) {
contextPtr->callPtr->flags |= DESTRUCTOR;
contextPtr->skip = 0;
@@ -499,9 +526,12 @@ TclOO_Object_Unknown(
Tcl_Obj *const *objv) /* The actual arguments. */
{
CallContext *contextPtr = (CallContext *) context;
+ Object *callerObj = NULL;
+ Class *callerCls = NULL;
Object *oPtr = contextPtr->oPtr;
const char **methodNames;
int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);
+ CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
Tcl_Obj *errorMsg;
/*
@@ -516,10 +546,31 @@ TclOO_Object_Unknown(
}
/*
+ * Determine if the calling context should know about extra private
+ * methods, and if so, which.
+ */
+
+ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
+ CallContext *callerContext = framePtr->clientData;
+ Method *mPtr = callerContext->callPtr->chain[
+ callerContext->index].mPtr;
+
+ if (mPtr->declaringObjectPtr) {
+ if (oPtr == mPtr->declaringObjectPtr) {
+ callerObj = mPtr->declaringObjectPtr;
+ }
+ } else {
+ if (TclOOIsReachable(mPtr->declaringClassPtr, oPtr->selfCls)) {
+ callerCls = mPtr->declaringClassPtr;
+ }
+ }
+ }
+
+ /*
* Get the list of methods that we want to know about.
*/
- numMethodNames = TclOOGetSortedMethodList(oPtr,
+ numMethodNames = TclOOGetSortedMethodList(oPtr, callerObj, callerCls,
contextPtr->callPtr->flags & PUBLIC_METHOD, &methodNames);
/*
@@ -684,6 +735,7 @@ TclOO_Object_VarName(
{
Var *varPtr, *aryVar;
Tcl_Obj *varNamePtr, *argPtr;
+ CallFrame *framePtr = ((Interp *) interp)->varFramePtr;
const char *arg;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
@@ -709,6 +761,58 @@ TclOO_Object_VarName(
Tcl_Namespace *namespacePtr =
Tcl_GetObjectNamespace(Tcl_ObjectContextObject(context));
+ /*
+ * Private method handling. [TIP 500]
+ *
+ * If we're in a context that can see some private methods of an
+ * object, we may need to precede a variable name with its prefix.
+ * This is a little tricky as we need to check through the inheritance
+ * hierarchy when the method was declared by a class to see if the
+ * current object is an instance of that class.
+ */
+
+ if (framePtr->isProcCallFrame & FRAME_IS_METHOD) {
+ Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
+ CallContext *callerContext = framePtr->clientData;
+ Method *mPtr = callerContext->callPtr->chain[
+ callerContext->index].mPtr;
+ PrivateVariableMapping *pvPtr;
+ int i;
+
+ if (mPtr->declaringObjectPtr == oPtr) {
+ FOREACH_STRUCT(pvPtr, oPtr->privateVariables) {
+ if (!strcmp(Tcl_GetString(pvPtr->variableObj),
+ Tcl_GetString(argPtr))) {
+ argPtr = pvPtr->fullNameObj;
+ break;
+ }
+ }
+ } else if (mPtr->declaringClassPtr &&
+ mPtr->declaringClassPtr->privateVariables.num) {
+ Class *clsPtr = mPtr->declaringClassPtr;
+ int isInstance = TclOOIsReachable(clsPtr, oPtr->selfCls);
+ Class *mixinCls;
+
+ if (!isInstance) {
+ FOREACH(mixinCls, oPtr->mixins) {
+ if (TclOOIsReachable(clsPtr, mixinCls)) {
+ isInstance = 1;
+ break;
+ }
+ }
+ }
+ if (isInstance) {
+ FOREACH_STRUCT(pvPtr, clsPtr->privateVariables) {
+ if (!strcmp(Tcl_GetString(pvPtr->variableObj),
+ Tcl_GetString(argPtr))) {
+ argPtr = pvPtr->fullNameObj;
+ break;
+ }
+ }
+ }
+ }
+ }
+
varNamePtr = Tcl_NewStringObj(namespacePtr->fullName, -1);
Tcl_AppendToObj(varNamePtr, "::", 2);
Tcl_AppendObjToObj(varNamePtr, argPtr);
@@ -729,26 +833,16 @@ TclOO_Object_VarName(
varNamePtr = Tcl_NewObj();
if (aryVar != NULL) {
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
-
Tcl_GetVariableFullName(interp, (Tcl_Var) aryVar, varNamePtr);
/*
* WARNING! This code pokes inside the implementation of hash tables!
*/
- hPtr = Tcl_FirstHashEntry((Tcl_HashTable *) aryVar->value.tablePtr,
- &search);
- while (hPtr != NULL) {
- if (varPtr == Tcl_GetHashValue(hPtr)) {
- Tcl_AppendToObj(varNamePtr, "(", -1);
- Tcl_AppendObjToObj(varNamePtr, hPtr->key.objPtr);
- Tcl_AppendToObj(varNamePtr, ")", -1);
- break;
- }
- hPtr = Tcl_NextHashEntry(&search);
- }
+ Tcl_AppendToObj(varNamePtr, "(", -1);
+ Tcl_AppendObjToObj(varNamePtr, ((VarInHash *)
+ varPtr)->entry.key.objPtr);
+ Tcl_AppendToObj(varNamePtr, ")", -1);
} else {
Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, varNamePtr);
}
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index a46b8bc..908dd26 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -15,6 +15,7 @@
#endif
#include "tclInt.h"
#include "tclOOInt.h"
+#include <assert.h>
/*
* Structure containing a CallContext and any other values needed only during
@@ -31,6 +32,22 @@ struct ChainBuilder {
};
/*
+ * Structures used for traversing the class hierarchy to find out where
+ * definitions are supposed to be done.
+ */
+
+typedef struct {
+ Class *definerCls;
+ Tcl_Obj *namespaceName;
+} DefineEntry;
+
+typedef struct {
+ DefineEntry *list;
+ int num;
+ int size;
+} DefineChain;
+
+/*
* Extra flags used for call chain management.
*/
@@ -46,6 +63,28 @@ struct ChainBuilder {
!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
/*
+ * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
+ * Itcl's special type of private.
+ */
+
+#define IS_PUBLIC(mPtr) \
+ (((mPtr)->flags & PUBLIC_METHOD) != 0)
+#define IS_UNEXPORTED(mPtr) \
+ (((mPtr)->flags & SCOPE_FLAGS) == 0)
+#define IS_ITCLPRIVATE(mPtr) \
+ (((mPtr)->flags & PRIVATE_METHOD) != 0)
+#define IS_PRIVATE(mPtr) \
+ (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
+#define WANT_PUBLIC(flags) \
+ (((flags) & PUBLIC_METHOD) != 0)
+#define WANT_UNEXPORTED(flags) \
+ (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
+#define WANT_ITCLPRIVATE(flags) \
+ (((flags) & PRIVATE_METHOD) != 0)
+#define WANT_PRIVATE(flags) \
+ (((flags) & TRUE_PRIVATE_METHOD) != 0)
+
+/*
* Function declarations for things defined in this file.
*/
@@ -55,20 +94,41 @@ static void AddClassFiltersToCallContext(Object *const oPtr,
static void AddClassMethodNames(Class *clsPtr, const int flags,
Tcl_HashTable *const namesPtr,
Tcl_HashTable *const examinedClassesPtr);
+static inline void AddDefinitionNamespaceToChain(Class *const definerCls,
+ Tcl_Obj *const namespaceName,
+ DefineChain *const definePtr, int flags);
static inline void AddMethodToCallChain(Method *const mPtr,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters,
Class *const filterDecl, int flags);
-static inline void AddSimpleChainToCallContext(Object *const oPtr,
+static inline int AddInstancePrivateToCallContext(Object *const oPtr,
+ Tcl_Obj *const methodNameObj,
+ struct ChainBuilder *const cbPtr, int flags);
+static inline void AddStandardMethodName(int flags, Tcl_Obj *namePtr,
+ Method *mPtr, Tcl_HashTable *namesPtr);
+static inline void AddPrivateMethodNames(Tcl_HashTable *methodsTablePtr,
+ Tcl_HashTable *namesPtr);
+static inline int AddSimpleChainToCallContext(Object *const oPtr,
+ Class *const contextCls,
+ Tcl_Obj *const methodNameObj,
+ struct ChainBuilder *const cbPtr,
+ Tcl_HashTable *const doneFilters, int flags,
+ Class *const filterDecl);
+static int AddPrivatesFromClassChainToCallContext(Class *classPtr,
+ Class *const contextCls,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
-static void AddSimpleClassChainToCallContext(Class *classPtr,
+static int AddSimpleClassChainToCallContext(Class *classPtr,
Tcl_Obj *const methodNameObj,
struct ChainBuilder *const cbPtr,
Tcl_HashTable *const doneFilters, int flags,
Class *const filterDecl);
+static void AddSimpleClassDefineNamespaces(Class *classPtr,
+ DefineChain *const definePtr, int flags);
+static inline void AddSimpleDefineNamespaces(Object *const oPtr,
+ DefineChain *const definePtr, int flags);
static int CmpStr(const void *ptr1, const void *ptr2);
static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
static Tcl_NRPostProc FinalizeMethodRefs;
@@ -77,6 +137,8 @@ static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
int flags, int reuseMask);
static Tcl_NRPostProc ResetFilterFlags;
static Tcl_NRPostProc SetFilterFlags;
+static int SortMethodNames(Tcl_HashTable *namesPtr, int flags,
+ const char ***stringsPtr);
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
/*
@@ -90,6 +152,7 @@ static const Tcl_ObjType methodNameType = {
NULL,
NULL
};
+
/*
* ----------------------------------------------------------------------
@@ -110,7 +173,11 @@ TclOODeleteContext(
TclOODeleteChain(contextPtr->callPtr);
if (oPtr != NULL) {
TclStackFree(oPtr->fPtr->interp, contextPtr);
- /* Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore */
+
+ /*
+ * Corresponding AddRef() in TclOO.c/TclOOObjectCmdCore
+ */
+
TclOODecrRefCount(oPtr);
}
}
@@ -180,11 +247,12 @@ StashCallChain(
Tcl_Obj *objPtr,
CallChain *callPtr)
{
+ Tcl_ObjIntRep ir;
+
callPtr->refCount++;
TclGetString(objPtr);
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &methodNameType;
- objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+ ir.twoPtrValue.ptr1 = callPtr;
+ Tcl_StoreIntRep(objPtr, &methodNameType, &ir);
}
void
@@ -211,21 +279,16 @@ DupMethodNameRep(
Tcl_Obj *srcPtr,
Tcl_Obj *dstPtr)
{
- register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-
- dstPtr->typePtr = &methodNameType;
- dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
- callPtr->refCount++;
+ StashCallChain(dstPtr,
+ TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
}
static void
FreeMethodNameRep(
Tcl_Obj *objPtr)
{
- register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
- TclOODeleteChain(callPtr);
- objPtr->typePtr = NULL;
+ TclOODeleteChain(
+ TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
}
/*
@@ -362,6 +425,14 @@ FinalizeMethodRefs(
int
TclOOGetSortedMethodList(
Object *oPtr, /* The object to get the method names for. */
+ Object *contextObj, /* From what context object we are inquiring.
+ * NULL when the context shouldn't see
+ * object-level private methods. Note that
+ * flags can override this. */
+ Class *contextCls, /* From what context class we are inquiring.
+ * NULL when the context shouldn't see
+ * class-level private methods. Note that
+ * flags can override this. */
int flags, /* Whether we just want the public method
* names. */
const char ***stringsPtr) /* Where to write a pointer to the array of
@@ -374,12 +445,10 @@ TclOOGetSortedMethodList(
* at. Is set-like in nature and keyed by
* pointer to class. */
FOREACH_HASH_DECLS;
- int i;
+ int i, numStrings;
Class *mixinPtr;
Tcl_Obj *namePtr;
Method *mPtr;
- int isWantedIn;
- void *isWanted;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
@@ -396,18 +465,13 @@ TclOOGetSortedMethodList(
if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
- int isNew;
-
- if ((mPtr->flags & PRIVATE_METHOD) && !(flags & PRIVATE_METHOD)) {
+ if (IS_PRIVATE(mPtr)) {
continue;
}
- hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
- if (isNew) {
- isWantedIn = ((!(flags & PUBLIC_METHOD)
- || mPtr->flags & PUBLIC_METHOD) ? IN_LIST : 0);
- isWantedIn |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
- Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
+ if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
+ continue;
}
+ AddStandardMethodName(flags, namePtr, mPtr, &names);
}
}
@@ -415,84 +479,46 @@ TclOOGetSortedMethodList(
* Process method names due to private methods on the object's class.
*/
- if (flags & PRIVATE_METHOD) {
+ if (WANT_UNEXPORTED(flags)) {
FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
- if (mPtr->flags & PRIVATE_METHOD) {
- int isNew;
-
- hPtr = Tcl_CreateHashEntry(&names, (char *) namePtr, &isNew);
- if (isNew) {
- isWantedIn = IN_LIST;
- if (mPtr->typePtr == NULL) {
- isWantedIn |= NO_IMPLEMENTATION;
- }
- Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
- } else if (mPtr->typePtr != NULL) {
- isWantedIn = PTR2INT(Tcl_GetHashValue(hPtr));
- if (isWantedIn & NO_IMPLEMENTATION) {
- isWantedIn &= ~NO_IMPLEMENTATION;
- Tcl_SetHashValue(hPtr, INT2PTR(isWantedIn));
- }
- }
+ if (IS_UNEXPORTED(mPtr)) {
+ AddStandardMethodName(flags, namePtr, mPtr, &names);
}
}
}
/*
+ * Process method names due to private methods on the context's object or
+ * class. Which must be correct if either are not NULL.
+ */
+
+ if (contextObj && contextObj->methodsPtr) {
+ AddPrivateMethodNames(contextObj->methodsPtr, &names);
+ }
+ if (contextCls) {
+ AddPrivateMethodNames(&contextCls->classMethods, &names);
+ }
+
+ /*
* Process (normal) method names from the class hierarchy and the mixin
* hierarchy.
*/
AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
FOREACH(mixinPtr, oPtr->mixins) {
- AddClassMethodNames(mixinPtr, flags|TRAVERSED_MIXIN, &names,
+ AddClassMethodNames(mixinPtr, flags | TRAVERSED_MIXIN, &names,
&examinedClasses);
}
- Tcl_DeleteHashTable(&examinedClasses);
-
/*
- * See how many (visible) method names there are. If none, we do not (and
- * should not) try to sort the list of them.
+ * Tidy up, sort the names and resolve finally whether we really want
+ * them (processing export layering).
*/
- i = 0;
- if (names.numEntries != 0) {
- const char **strings;
-
- /*
- * We need to build the list of methods to sort. We will be using
- * qsort() for this, because it is very unlikely that the list will be
- * heavily sorted when it is long enough to matter.
- */
-
- strings = ckalloc(sizeof(char *) * names.numEntries);
- FOREACH_HASH(namePtr, isWanted, &names) {
- if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
- if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
- continue;
- }
- strings[i++] = TclGetString(namePtr);
- }
- }
-
- /*
- * Note that 'i' may well be less than names.numEntries when we are
- * dealing with public method names.
- */
-
- if (i > 0) {
- if (i > 1) {
- qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
- }
- *stringsPtr = strings;
- } else {
- ckfree(strings);
- }
- }
-
+ Tcl_DeleteHashTable(&examinedClasses);
+ numStrings = SortMethodNames(&names, flags, stringsPtr);
Tcl_DeleteHashTable(&names);
- return i;
+ return numStrings;
}
int
@@ -509,10 +535,7 @@ TclOOGetSortedClassMethodList(
/* Used to track what classes have been looked
* at. Is set-like in nature and keyed by
* pointer to class. */
- FOREACH_HASH_DECLS;
- int i;
- Tcl_Obj *namePtr;
- void *isWanted;
+ int numStrings;
Tcl_InitObjHashTable(&names);
Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
@@ -525,50 +548,100 @@ TclOOGetSortedClassMethodList(
Tcl_DeleteHashTable(&examinedClasses);
/*
+ * Process private method names if we should. [TIP 500]
+ */
+
+ if (WANT_PRIVATE(flags)) {
+ AddPrivateMethodNames(&clsPtr->classMethods, &names);
+ flags &= ~TRUE_PRIVATE_METHOD;
+ }
+
+ /*
+ * Tidy up, sort the names and resolve finally whether we really want
+ * them (processing export layering).
+ */
+
+ numStrings = SortMethodNames(&names, flags, stringsPtr);
+ Tcl_DeleteHashTable(&names);
+ return numStrings;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SortMethodNames --
+ *
+ * Shared helper for TclOOGetSortedMethodList etc. that knows the method
+ * sorting rules.
+ *
+ * Returns:
+ * The length of the sorted list.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+SortMethodNames(
+ Tcl_HashTable *namesPtr, /* The table of names; unsorted, but contains
+ * whether the names are wanted and under what
+ * circumstances. */
+ int flags, /* Whether we are looking for unexported
+ * methods. Full private methods are handled
+ * on insertion to the table. */
+ const char ***stringsPtr) /* Where to store the sorted list of strings
+ * that we produce. ckalloced() */
+{
+ const char **strings;
+ FOREACH_HASH_DECLS;
+ Tcl_Obj *namePtr;
+ void *isWanted;
+ int i = 0;
+
+ /*
* See how many (visible) method names there are. If none, we do not (and
* should not) try to sort the list of them.
*/
- i = 0;
- if (names.numEntries != 0) {
- const char **strings;
+ if (namesPtr->numEntries == 0) {
+ *stringsPtr = NULL;
+ return 0;
+ }
- /*
- * We need to build the list of methods to sort. We will be using
- * qsort() for this, because it is very unlikely that the list will be
- * heavily sorted when it is long enough to matter.
- */
+ /*
+ * We need to build the list of methods to sort. We will be using qsort()
+ * for this, because it is very unlikely that the list will be heavily
+ * sorted when it is long enough to matter.
+ */
- strings = ckalloc(sizeof(char *) * names.numEntries);
- FOREACH_HASH(namePtr, isWanted, &names) {
- if (!(flags & PUBLIC_METHOD) || (PTR2INT(isWanted) & IN_LIST)) {
- if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
- continue;
- }
- strings[i++] = TclGetString(namePtr);
+ strings = ckalloc(sizeof(char *) * namesPtr->numEntries);
+ FOREACH_HASH(namePtr, isWanted, namesPtr) {
+ if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
+ if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
+ continue;
}
+ strings[i++] = TclGetString(namePtr);
}
+ }
- /*
- * Note that 'i' may well be less than names.numEntries when we are
- * dealing with public method names.
- */
+ /*
+ * Note that 'i' may well be less than names.numEntries when we are
+ * dealing with public method names. We don't sort unless there's at least
+ * two method names.
+ */
- if (i > 0) {
- if (i > 1) {
- qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
- }
- *stringsPtr = strings;
- } else {
- ckfree(strings);
+ if (i > 0) {
+ if (i > 1) {
+ qsort((void *) strings, (unsigned) i, sizeof(char *), CmpStr);
}
+ *stringsPtr = strings;
+ } else {
+ ckfree(strings);
+ *stringsPtr = NULL;
}
-
- Tcl_DeleteHashTable(&names);
return i;
}
-/* Comparator for GetSortedMethodList */
+/* Comparator for SortMethodNames */
static int
CmpStr(
const void *ptr1,
@@ -577,7 +650,7 @@ CmpStr(
const char **strPtr1 = (const char **) ptr1;
const char **strPtr2 = (const char **) ptr2;
- return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1)+1);
+ return TclpUtfNcmp2(*strPtr1, *strPtr2, strlen(*strPtr1) + 1);
}
/*
@@ -610,6 +683,8 @@ AddClassMethodNames(
* pointers to the classes, and the values are
* immaterial. */
{
+ int i;
+
/*
* If we've already started looking at this class, stop working on it now
* to prevent repeated work.
@@ -640,7 +715,6 @@ AddClassMethodNames(
if (clsPtr->mixins.num != 0) {
Class *mixinPtr;
- int i;
FOREACH(mixinPtr, clsPtr->mixins) {
if (mixinPtr != clsPtr) {
@@ -651,20 +725,7 @@ AddClassMethodNames(
}
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
- hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
- if (isNew) {
- int isWanted = (!(flags & PUBLIC_METHOD)
- || (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
-
- isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
- Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
- } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
- && mPtr->typePtr != NULL) {
- int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
-
- isWanted &= ~NO_IMPLEMENTATION;
- Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
- }
+ AddStandardMethodName(flags, namePtr, mPtr, namesPtr);
}
if (clsPtr->superclasses.num != 1) {
@@ -674,7 +735,6 @@ AddClassMethodNames(
}
if (clsPtr->superclasses.num != 0) {
Class *superPtr;
- int i;
FOREACH(superPtr, clsPtr->superclasses) {
AddClassMethodNames(superPtr, flags, namesPtr,
@@ -686,19 +746,121 @@ AddClassMethodNames(
/*
* ----------------------------------------------------------------------
*
+ * AddPrivateMethodNames, AddStandardMethodName --
+ *
+ * Factored-out helpers for the sorted name list production functions.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddPrivateMethodNames(
+ Tcl_HashTable *methodsTablePtr,
+ Tcl_HashTable *namesPtr)
+{
+ FOREACH_HASH_DECLS;
+ Method *mPtr;
+ Tcl_Obj *namePtr;
+
+ FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
+ if (IS_PRIVATE(mPtr)) {
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
+ Tcl_SetHashValue(hPtr, INT2PTR(IN_LIST));
+ }
+ }
+}
+
+static inline void
+AddStandardMethodName(
+ int flags,
+ Tcl_Obj *namePtr,
+ Method *mPtr,
+ Tcl_HashTable *namesPtr)
+{
+ if (!IS_PRIVATE(mPtr)) {
+ int isNew;
+ Tcl_HashEntry *hPtr =
+ Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
+
+ if (isNew) {
+ int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
+ ? IN_LIST : 0;
+
+ isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
+ Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
+ } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
+ && mPtr->typePtr != NULL) {
+ int isWanted = PTR2INT(Tcl_GetHashValue(hPtr));
+
+ isWanted &= ~NO_IMPLEMENTATION;
+ Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
+ }
+ }
+}
+
+#undef IN_LIST
+#undef NO_IMPLEMENTATION
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddInstancePrivateToCallContext --
+ *
+ * Add private methods from the instance. Called when the calling Tcl
+ * context is a TclOO method declared by an object that is the same as
+ * the current object. Returns true iff a private method was actually
+ * found and added to the call chain (as this suppresses caching).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+AddInstancePrivateToCallContext(
+ Object *const oPtr, /* Object to add call chain entries for. */
+ Tcl_Obj *const methodName, /* Name of method to add the call chain
+ * entries for. */
+ struct ChainBuilder *const cbPtr,
+ /* Where to add the call chain entries. */
+ int flags) /* What sort of call chain are we building. */
+{
+ Tcl_HashEntry *hPtr;
+ Method *mPtr;
+ int donePrivate = 0;
+
+ if (oPtr->methodsPtr) {
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
+ if (hPtr != NULL) {
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (IS_PRIVATE(mPtr)) {
+ AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
+ donePrivate = 1;
+ }
+ }
+ }
+ return donePrivate;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* AddSimpleChainToCallContext --
*
* The core of the call-chain construction engine, this handles calling a
* particular method on a particular object. Note that filters and
* unknown handling are already handled by the logic that uses this
- * function.
+ * function. Returns true if a private method was one of those found.
*
* ----------------------------------------------------------------------
*/
-static inline void
+static inline int
AddSimpleChainToCallContext(
Object *const oPtr, /* Object to add call chain entries for. */
+ Class *const contextCls, /* Context class; the currently considered
+ * class is equal to this, private methods may
+ * also be added. [TIP 500] */
Tcl_Obj *const methodNameObj,
/* Name of method to add the call chain
* entries for. */
@@ -712,44 +874,62 @@ AddSimpleChainToCallContext(
* NULL, either the filter was declared by the
* object or this isn't a filter. */
{
- int i;
+ int i, foundPrivate = 0, blockedUnexported = 0;
+ Tcl_HashEntry *hPtr;
+ Method *mPtr;
if (!(flags & (KNOWN_STATE | SPECIAL)) && oPtr->methodsPtr) {
- Tcl_HashEntry *hPtr = Tcl_FindHashEntry(oPtr->methodsPtr,
- (char *) methodNameObj);
+ hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodNameObj);
if (hPtr != NULL) {
- Method *mPtr = Tcl_GetHashValue(hPtr);
-
- if (flags & PUBLIC_METHOD) {
- if (!(mPtr->flags & PUBLIC_METHOD)) {
- return;
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (!IS_PRIVATE(mPtr)) {
+ if (WANT_PUBLIC(flags)) {
+ if (!IS_PUBLIC(mPtr)) {
+ blockedUnexported = 1;
+ } else {
+ flags |= DEFINITE_PUBLIC;
+ }
} else {
- flags |= DEFINITE_PUBLIC;
+ flags |= DEFINITE_PROTECTED;
}
- } else {
- flags |= DEFINITE_PROTECTED;
}
}
}
if (!(flags & SPECIAL)) {
- Tcl_HashEntry *hPtr;
Class *mixinPtr;
FOREACH(mixinPtr, oPtr->mixins) {
- AddSimpleClassChainToCallContext(mixinPtr, methodNameObj, cbPtr,
- doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
+ if (contextCls) {
+ foundPrivate |= AddPrivatesFromClassChainToCallContext(
+ mixinPtr, contextCls, methodNameObj, cbPtr,
+ doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
+ }
+ foundPrivate |= AddSimpleClassChainToCallContext(mixinPtr,
+ methodNameObj, cbPtr, doneFilters,
+ flags | TRAVERSED_MIXIN, filterDecl);
}
- if (oPtr->methodsPtr) {
+ if (oPtr->methodsPtr && !blockedUnexported) {
hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
if (hPtr != NULL) {
- AddMethodToCallChain(Tcl_GetHashValue(hPtr), cbPtr,
- doneFilters, filterDecl, flags);
+ mPtr = Tcl_GetHashValue(hPtr);
+ if (!IS_PRIVATE(mPtr)) {
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
+ flags);
+ }
}
}
}
- AddSimpleClassChainToCallContext(oPtr->selfCls, methodNameObj, cbPtr,
- doneFilters, flags, filterDecl);
+ if (contextCls) {
+ foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls,
+ contextCls, methodNameObj, cbPtr, doneFilters, flags,
+ filterDecl);
+ }
+ if (!blockedUnexported) {
+ foundPrivate |= AddSimpleClassChainToCallContext(oPtr->selfCls,
+ methodNameObj, cbPtr, doneFilters, flags, filterDecl);
+ }
+ return foundPrivate;
}
/*
@@ -812,8 +992,8 @@ AddMethodToCallChain(
* should be sufficient for [incr Tcl] support though.
*/
- if (!(callPtr->flags & PRIVATE_METHOD)
- && (mPtr->flags & PRIVATE_METHOD)
+ if (!WANT_UNEXPORTED(callPtr->flags)
+ && IS_UNEXPORTED(mPtr)
&& (mPtr->declaringClassPtr != NULL)
&& (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
return;
@@ -854,7 +1034,7 @@ AddMethodToCallChain(
if (callPtr->numChain == CALL_CHAIN_STATIC_SIZE) {
callPtr->chain =
- ckalloc(sizeof(struct MInvoke) * (callPtr->numChain+1));
+ ckalloc(sizeof(struct MInvoke) * (callPtr->numChain + 1));
memcpy(callPtr->chain, callPtr->staticChain,
sizeof(struct MInvoke) * callPtr->numChain);
} else if (callPtr->numChain > CALL_CHAIN_STATIC_SIZE) {
@@ -901,6 +1081,7 @@ InitCallChain(
* ----------------------------------------------------------------------
*
* IsStillValid --
+ *
* Calculates whether the given call chain can be used for executing a
* method for the given object. The condition on a chain from a cached
* location being reusable is:
@@ -952,6 +1133,12 @@ TclOOGetCallContext(
* Only the bits PUBLIC_METHOD, CONSTRUCTOR,
* PRIVATE_METHOD, DESTRUCTOR and
* FILTER_HANDLING are useful. */
+ Object *contextObj, /* Context object; when equal to oPtr, it
+ * means that private methods may also be
+ * added. [TIP 500] */
+ Class *contextCls, /* Context class; the currently considered
+ * class is equal to this, private methods may
+ * also be added. [TIP 500] */
Tcl_Obj *cacheInThisObj) /* What object to cache in, or NULL if it is
* to be in the same object as the
* methodNameObj. */
@@ -959,7 +1146,7 @@ TclOOGetCallContext(
CallContext *contextPtr;
CallChain *callPtr;
struct ChainBuilder cb;
- int i, count, doFilters;
+ int i, count, doFilters, donePrivate = 0;
Tcl_HashEntry *hPtr;
Tcl_HashTable doneFilters;
@@ -999,15 +1186,16 @@ TclOOGetCallContext(
* the object, and in the class).
*/
- const int reuseMask = ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
+ const Tcl_ObjIntRep *irPtr;
+ const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
- if (cacheInThisObj->typePtr == &methodNameType) {
- callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
+ if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) {
+ callPtr = irPtr->twoPtrValue.ptr1;
if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
callPtr->refCount++;
goto returnContext;
}
- FreeMethodNameRep(cacheInThisObj);
+ Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL);
}
if (oPtr->flags & USE_CLASS_CACHE) {
@@ -1051,10 +1239,11 @@ TclOOGetCallContext(
*/
if (flags & FORCE_UNKNOWN) {
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, 0, NULL);
+ AddSimpleChainToCallContext(oPtr, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
+ NULL);
+ AddSimpleChainToCallContext(oPtr, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (callPtr->numChain == 0) {
@@ -1083,10 +1272,10 @@ TclOOGetCallContext(
OBJECT_MIXIN);
}
FOREACH(filterObj, oPtr->filters) {
- AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters,
- BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, filterObj, &cb, &doneFilters, 0,
- NULL);
+ donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
+ filterObj, &cb, &doneFilters, BUILDING_MIXINS, NULL);
+ donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
+ filterObj, &cb, &doneFilters, 0, NULL);
}
AddClassFiltersToCallContext(oPtr, oPtr->selfCls, &cb, &doneFilters,
BUILDING_MIXINS);
@@ -1101,9 +1290,15 @@ TclOOGetCallContext(
* handle class mixins right.
*/
- AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL,
- flags|BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, methodNameObj, &cb, NULL, flags, NULL);
+ if (oPtr == contextObj) {
+ donePrivate |= AddInstancePrivateToCallContext(oPtr, methodNameObj,
+ &cb, flags);
+ donePrivate |= (contextObj->flags & HAS_PRIVATE_METHODS);
+ }
+ donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
+ methodNameObj, &cb, NULL, flags|BUILDING_MIXINS, NULL);
+ donePrivate |= AddSimpleChainToCallContext(oPtr, contextCls,
+ methodNameObj, &cb, NULL, flags, NULL);
/*
* Check to see if the method has no implementation. If so, we probably
@@ -1121,17 +1316,18 @@ TclOOGetCallContext(
TclOODeleteChain(callPtr);
return NULL;
}
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
- &cb, NULL, 0, NULL);
+ AddSimpleChainToCallContext(oPtr, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, BUILDING_MIXINS,
+ NULL);
+ AddSimpleChainToCallContext(oPtr, NULL,
+ oPtr->fPtr->unknownMethodNameObj, &cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (count == callPtr->numChain) {
TclOODeleteChain(callPtr);
return NULL;
}
- } else if (doFilters) {
+ } else if (doFilters && !donePrivate) {
if (hPtr == NULL) {
if (oPtr->flags & USE_CLASS_CACHE) {
if (oPtr->selfCls->classChainCache == NULL) {
@@ -1172,7 +1368,11 @@ TclOOGetCallContext(
returnContext:
contextPtr = TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
contextPtr->oPtr = oPtr;
- /* Corresponding TclOODecrRefCount() in TclOODeleteContext */
+
+ /*
+ * Corresponding TclOODecrRefCount() in TclOODeleteContext
+ */
+
AddRef(oPtr);
contextPtr->callPtr = callPtr;
contextPtr->skip = 2;
@@ -1233,8 +1433,7 @@ TclOOGetStereotypeCallChain(
hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
(char *) methodNameObj);
if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
- const int reuseMask =
- ((flags & PUBLIC_METHOD) ? ~0 : ~PUBLIC_METHOD);
+ const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
callPtr = Tcl_GetHashValue(hPtr);
if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
@@ -1278,9 +1477,10 @@ TclOOGetStereotypeCallChain(
* Add the actual method implementations.
*/
- AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL,
+ AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL,
flags|BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(&obj, methodNameObj, &cb, NULL, flags, NULL);
+ AddSimpleChainToCallContext(&obj, NULL, methodNameObj, &cb, NULL, flags,
+ NULL);
/*
* Check to see if the method has no implementation. If so, we probably
@@ -1289,10 +1489,10 @@ TclOOGetStereotypeCallChain(
*/
if (count == callPtr->numChain) {
- AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
- NULL, BUILDING_MIXINS, NULL);
- AddSimpleChainToCallContext(&obj, fPtr->unknownMethodNameObj, &cb,
- NULL, 0, NULL);
+ AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
+ &cb, NULL, BUILDING_MIXINS, NULL);
+ AddSimpleChainToCallContext(&obj, NULL, fPtr->unknownMethodNameObj,
+ &cb, NULL, 0, NULL);
callPtr->flags |= OO_UNKNOWN_METHOD;
callPtr->epoch = -1;
if (count == callPtr->numChain) {
@@ -1372,9 +1572,9 @@ AddClassFiltersToCallContext(
(void) Tcl_CreateHashEntry(doneFilters, (char *) filterObj,
&isNew);
if (isNew) {
- AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
doneFilters, clearedFlags|BUILDING_MIXINS, clsPtr);
- AddSimpleChainToCallContext(oPtr, filterObj, cbPtr,
+ AddSimpleChainToCallContext(oPtr, NULL, filterObj, cbPtr,
doneFilters, clearedFlags, clsPtr);
}
}
@@ -1401,6 +1601,87 @@ AddClassFiltersToCallContext(
/*
* ----------------------------------------------------------------------
*
+ * AddPrivatesFromClassChainToCallContext --
+ *
+ * Helper for AddSimpleChainToCallContext that is used to find private
+ * methds and add them to the call chain. Returns true when a private
+ * method is found and added. [TIP 500]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+AddPrivatesFromClassChainToCallContext(
+ Class *classPtr, /* Class to add the call chain entries for. */
+ Class *const contextCls, /* Context class; the currently considered
+ * class is equal to this, private methods may
+ * also be added. */
+ Tcl_Obj *const methodName, /* Name of method to add the call chain
+ * entries for. */
+ struct ChainBuilder *const cbPtr,
+ /* Where to add the call chain entries. */
+ Tcl_HashTable *const doneFilters,
+ /* Where to record what call chain entries
+ * have been processed. */
+ int flags, /* What sort of call chain are we building. */
+ Class *const filterDecl) /* The class that declared the filter. If
+ * NULL, either the filter was declared by the
+ * object or this isn't a filter. */
+{
+ int i;
+ Class *superPtr;
+
+ /*
+ * We hard-code the tail-recursive form. It's by far the most common case
+ * *and* it is much more gentle on the stack.
+ *
+ * Note that mixins must be processed before the main class hierarchy.
+ * [Bug 1998221]
+ */
+
+ tailRecurse:
+ FOREACH(superPtr, classPtr->mixins) {
+ if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
+ methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN,
+ filterDecl)) {
+ return 1;
+ }
+ }
+
+ if (classPtr == contextCls) {
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
+ (char *) methodName);
+
+ if (hPtr != NULL) {
+ register Method *mPtr = Tcl_GetHashValue(hPtr);
+
+ if (IS_PRIVATE(mPtr)) {
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
+ flags);
+ return 1;
+ }
+ }
+ }
+
+ switch (classPtr->superclasses.num) {
+ case 1:
+ classPtr = classPtr->superclasses.list[0];
+ goto tailRecurse;
+ default:
+ FOREACH(superPtr, classPtr->superclasses) {
+ if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls,
+ methodName, cbPtr, doneFilters, flags, filterDecl)) {
+ return 1;
+ }
+ }
+ case 0:
+ return 0;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* AddSimpleClassChainToCallContext --
*
* Construct a call-chain from a class hierarchy.
@@ -1408,7 +1689,7 @@ AddClassFiltersToCallContext(
* ----------------------------------------------------------------------
*/
-static void
+static int
AddSimpleClassChainToCallContext(
Class *classPtr, /* Class to add the call chain entries for. */
Tcl_Obj *const methodNameObj,
@@ -1424,7 +1705,7 @@ AddSimpleClassChainToCallContext(
* NULL, either the filter was declared by the
* object or this isn't a filter. */
{
- int i;
+ int i, privateDanger = 0;
Class *superPtr;
/*
@@ -1437,8 +1718,9 @@ AddSimpleClassChainToCallContext(
tailRecurse:
FOREACH(superPtr, classPtr->mixins) {
- AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
- doneFilters, flags|TRAVERSED_MIXIN, filterDecl);
+ privateDanger |= AddSimpleClassChainToCallContext(superPtr,
+ methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN,
+ filterDecl);
}
if (flags & CONSTRUCTOR) {
@@ -1451,21 +1733,26 @@ AddSimpleClassChainToCallContext(
Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&classPtr->classMethods,
(char *) methodNameObj);
+ if (classPtr->flags & HAS_PRIVATE_METHODS) {
+ privateDanger |= 1;
+ }
if (hPtr != NULL) {
register Method *mPtr = Tcl_GetHashValue(hPtr);
- if (!(flags & KNOWN_STATE)) {
- if (flags & PUBLIC_METHOD) {
- if (mPtr->flags & PUBLIC_METHOD) {
+ if (!IS_PRIVATE(mPtr)) {
+ if (!(flags & KNOWN_STATE)) {
+ if (flags & PUBLIC_METHOD) {
+ if (!IS_PUBLIC(mPtr)) {
+ return privateDanger;
+ }
flags |= DEFINITE_PUBLIC;
} else {
- return;
+ flags |= DEFINITE_PROTECTED;
}
- } else {
- flags |= DEFINITE_PROTECTED;
}
+ AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
+ flags);
}
- AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl, flags);
}
}
@@ -1475,11 +1762,11 @@ AddSimpleClassChainToCallContext(
goto tailRecurse;
default:
FOREACH(superPtr, classPtr->superclasses) {
- AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr,
- doneFilters, flags, filterDecl);
+ privateDanger |= AddSimpleClassChainToCallContext(superPtr,
+ methodNameObj, cbPtr, doneFilters, flags, filterDecl);
}
case 0:
- return;
+ return privateDanger;
}
}
@@ -1499,7 +1786,7 @@ TclOORenderCallChain(
Tcl_Interp *interp,
CallChain *callPtr)
{
- Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral;
+ Tcl_Obj *filterLiteral, *methodLiteral, *objectLiteral, *privateLiteral;
Tcl_Obj *resultObj, *descObjs[4], **objv;
Foundation *fPtr = TclOOGetFoundation(interp);
int i;
@@ -1508,12 +1795,14 @@ TclOORenderCallChain(
* Allocate the literals (potentially) used in our description.
*/
- filterLiteral = Tcl_NewStringObj("filter", -1);
+ TclNewLiteralStringObj(filterLiteral, "filter");
Tcl_IncrRefCount(filterLiteral);
- methodLiteral = Tcl_NewStringObj("method", -1);
+ TclNewLiteralStringObj(methodLiteral, "method");
Tcl_IncrRefCount(methodLiteral);
- objectLiteral = Tcl_NewStringObj("object", -1);
+ TclNewLiteralStringObj(objectLiteral, "object");
Tcl_IncrRefCount(objectLiteral);
+ TclNewLiteralStringObj(privateLiteral, "private");
+ Tcl_IncrRefCount(privateLiteral);
/*
* Do the actual construction of the descriptions. They consist of a list
@@ -1531,16 +1820,15 @@ TclOORenderCallChain(
for (i=0 ; i<callPtr->numChain ; i++) {
struct MInvoke *miPtr = &callPtr->chain[i];
- descObjs[0] = miPtr->isFilter
- ? filterLiteral
- : callPtr->flags & OO_UNKNOWN_METHOD
- ? fPtr->unknownMethodNameObj
- : methodLiteral;
- descObjs[1] = callPtr->flags & CONSTRUCTOR
- ? fPtr->constructorName
- : callPtr->flags & DESTRUCTOR
- ? fPtr->destructorName
- : miPtr->mPtr->namePtr;
+ descObjs[0] =
+ miPtr->isFilter ? filterLiteral :
+ callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
+ IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
+ methodLiteral;
+ descObjs[1] =
+ callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
+ callPtr->flags & DESTRUCTOR ? fPtr->destructorName :
+ miPtr->mPtr->namePtr;
descObjs[2] = miPtr->mPtr->declaringClassPtr
? Tcl_GetObjectName(interp,
(Tcl_Object) miPtr->mPtr->declaringClassPtr->thisPtr)
@@ -1558,6 +1846,7 @@ TclOORenderCallChain(
Tcl_DecrRefCount(filterLiteral);
Tcl_DecrRefCount(methodLiteral);
Tcl_DecrRefCount(objectLiteral);
+ Tcl_DecrRefCount(privateLiteral);
/*
* Finish building the description and return it.
@@ -1569,6 +1858,246 @@ TclOORenderCallChain(
}
/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetDefineContextNamespace --
+ *
+ * Responsible for determining which namespace to use for definitions.
+ * This is done by building a define chain, which models (strongly!) the
+ * way that a call chain works but with a different internal model.
+ *
+ * Then it walks the chain to find the first namespace name that actually
+ * resolves to an existing namespace.
+ *
+ * Returns:
+ * Name of namespace, or NULL if none can be found. Note that this
+ * function does *not* set an error message in the interpreter on failure.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+#define DEFINE_CHAIN_STATIC_SIZE 4 /* Enough space to store most cases. */
+
+Tcl_Namespace *
+TclOOGetDefineContextNamespace(
+ Tcl_Interp *interp, /* In what interpreter should namespace names
+ * actually be resolved. */
+ Object *oPtr, /* The object to get the context for. */
+ int forClass) /* What sort of context are we looking for.
+ * If true, we are going to use this for
+ * [oo::define], otherwise, we are going to
+ * use this for [oo::objdefine]. */
+{
+ DefineChain define;
+ DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
+ DefineEntry *entryPtr;
+ Tcl_Namespace *nsPtr = NULL;
+ int i;
+
+ define.list = staticSpace;
+ define.num = 0;
+ define.size = DEFINE_CHAIN_STATIC_SIZE;
+
+ /*
+ * Add the actual define locations. We have to do this twice to handle
+ * class mixins right.
+ */
+
+ AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
+ AddSimpleDefineNamespaces(oPtr, &define, forClass);
+
+ /*
+ * Go through the list until we find a namespace whose name we can
+ * resolve.
+ */
+
+ FOREACH_STRUCT(entryPtr, define) {
+ if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
+ &nsPtr) == TCL_OK) {
+ break;
+ }
+ Tcl_ResetResult(interp);
+ }
+ if (define.list != staticSpace) {
+ ckfree(define.list);
+ }
+ return nsPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleDefineNamespaces --
+ *
+ * Adds to the definition chain all the definitions provided by an
+ * object's class and its mixins, taking into account everything they
+ * inherit from.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddSimpleDefineNamespaces(
+ Object *const oPtr, /* Object to add define chain entries for. */
+ DefineChain *const definePtr,
+ /* Where to add the define chain entries. */
+ int flags) /* What sort of define chain are we
+ * building. */
+{
+ Class *mixinPtr;
+ int i;
+
+ FOREACH(mixinPtr, oPtr->mixins) {
+ AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
+ flags | TRAVERSED_MIXIN);
+ }
+
+ AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleClassDefineNamespaces --
+ *
+ * Adds to the definition chain all the definitions provided by a class
+ * and its superclasses and its class mixins.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddSimpleClassDefineNamespaces(
+ Class *classPtr, /* Class to add the define chain entries for. */
+ DefineChain *const definePtr,
+ /* Where to add the define chain entries. */
+ int flags) /* What sort of define chain are we
+ * building. */
+{
+ int i;
+ Class *superPtr;
+
+ /*
+ * We hard-code the tail-recursive form. It's by far the most common case
+ * *and* it is much more gentle on the stack.
+ */
+
+ tailRecurse:
+ FOREACH(superPtr, classPtr->mixins) {
+ AddSimpleClassDefineNamespaces(superPtr, definePtr,
+ flags | TRAVERSED_MIXIN);
+ }
+
+ if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
+ AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
+ definePtr, flags);
+ } else {
+ AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
+ definePtr, flags);
+ }
+
+ switch (classPtr->superclasses.num) {
+ case 1:
+ classPtr = classPtr->superclasses.list[0];
+ goto tailRecurse;
+ default:
+ FOREACH(superPtr, classPtr->superclasses) {
+ AddSimpleClassDefineNamespaces(superPtr, definePtr, flags);
+ }
+ case 0:
+ return;
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddDefinitionNamespaceToChain --
+ *
+ * Adds a single item to the definition chain (if it is meaningful),
+ * reallocating the space for the chain if necessary.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddDefinitionNamespaceToChain(
+ Class *const definerCls, /* What class defines this entry. */
+ Tcl_Obj *const namespaceName, /* The name for this entry (or NULL, a
+ * no-op). */
+ DefineChain *const definePtr,
+ /* The define chain to add the method
+ * implementation to. */
+ int flags) /* Used to check if we're mixin-consistent
+ * only. Mixin-consistent means that either
+ * we're looking to add things from a mixin
+ * and we have passed a mixin, or we're not
+ * looking to add things from a mixin and have
+ * not passed a mixin. */
+{
+ int i;
+
+ /*
+ * Return if this entry is blank. This is also where we enforce
+ * mixin-consistency.
+ */
+
+ if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
+ return;
+ }
+
+ /*
+ * First test whether the method is already in the call chain.
+ */
+
+ for (i=0 ; i<definePtr->num ; i++) {
+ if (definePtr->list[i].definerCls == definerCls) {
+ /*
+ * Call chain semantics states that methods come as *late* in the
+ * call chain as possible. This is done by copying down the
+ * following methods. Note that this does not change the number of
+ * method invocations in the call chain; it just rearranges them.
+ *
+ * We skip changing anything if the place we found was already at
+ * the end of the list.
+ */
+
+ if (i < definePtr->num - 1) {
+ memmove(&definePtr->list[i], &definePtr->list[i + 1],
+ sizeof(DefineEntry) * (definePtr->num - i - 1));
+ definePtr->list[i].definerCls = definerCls;
+ definePtr->list[i].namespaceName = namespaceName;
+ }
+ return;
+ }
+ }
+
+ /*
+ * Need to really add the define. This is made a bit more complex by the
+ * fact that we are using some "static" space initially, and only start
+ * realloc-ing if the chain gets long.
+ */
+
+ if (definePtr->num == definePtr->size) {
+ definePtr->size *= 2;
+ if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
+ DefineEntry *staticList = definePtr->list;
+
+ definePtr->list =
+ ckalloc(sizeof(DefineEntry) * definePtr->size);
+ memcpy(definePtr->list, staticList,
+ sizeof(DefineEntry) * definePtr->num);
+ } else {
+ definePtr->list = ckrealloc(definePtr->list,
+ sizeof(DefineEntry) * definePtr->size);
+ }
+ }
+ definePtr->list[i].definerCls = definerCls;
+ definePtr->list[i].namespaceName = namespaceName;
+ definePtr->num++;
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/generic/tclOODecls.h b/generic/tclOODecls.h
index 9fd62ec..928d07e 100644
--- a/generic/tclOODecls.h
+++ b/generic/tclOODecls.h
@@ -59,11 +59,11 @@ TCLAPI Tcl_Obj * Tcl_MethodName(Tcl_Method method);
/* 11 */
TCLAPI Tcl_Method Tcl_NewInstanceMethod(Tcl_Interp *interp,
Tcl_Object object, Tcl_Obj *nameObj,
- int isPublic, const Tcl_MethodType *typePtr,
+ int flags, const Tcl_MethodType *typePtr,
ClientData clientData);
/* 12 */
TCLAPI Tcl_Method Tcl_NewMethod(Tcl_Interp *interp, Tcl_Class cls,
- Tcl_Obj *nameObj, int isPublic,
+ Tcl_Obj *nameObj, int flags,
const Tcl_MethodType *typePtr,
ClientData clientData);
/* 13 */
@@ -116,6 +116,8 @@ TCLAPI void Tcl_ClassSetDestructor(Tcl_Interp *interp,
/* 28 */
TCLAPI Tcl_Obj * Tcl_GetObjectName(Tcl_Interp *interp,
Tcl_Object object);
+/* 29 */
+TCLAPI int Tcl_MethodIsPrivate(Tcl_Method method);
typedef struct {
const struct TclOOIntStubs *tclOOIntStubs;
@@ -136,8 +138,8 @@ typedef struct TclOOStubs {
int (*tcl_MethodIsPublic) (Tcl_Method method); /* 8 */
int (*tcl_MethodIsType) (Tcl_Method method, const Tcl_MethodType *typePtr, ClientData *clientDataPtr); /* 9 */
Tcl_Obj * (*tcl_MethodName) (Tcl_Method method); /* 10 */
- Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
- Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int isPublic, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
+ Tcl_Method (*tcl_NewInstanceMethod) (Tcl_Interp *interp, Tcl_Object object, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 11 */
+ Tcl_Method (*tcl_NewMethod) (Tcl_Interp *interp, Tcl_Class cls, Tcl_Obj *nameObj, int flags, const Tcl_MethodType *typePtr, ClientData clientData); /* 12 */
Tcl_Object (*tcl_NewObjectInstance) (Tcl_Interp *interp, Tcl_Class cls, const char *nameStr, const char *nsNameStr, int objc, Tcl_Obj *const *objv, int skip); /* 13 */
int (*tcl_ObjectDeleted) (Tcl_Object object); /* 14 */
int (*tcl_ObjectContextIsFiltering) (Tcl_ObjectContext context); /* 15 */
@@ -154,6 +156,7 @@ typedef struct TclOOStubs {
void (*tcl_ClassSetConstructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 26 */
void (*tcl_ClassSetDestructor) (Tcl_Interp *interp, Tcl_Class clazz, Tcl_Method method); /* 27 */
Tcl_Obj * (*tcl_GetObjectName) (Tcl_Interp *interp, Tcl_Object object); /* 28 */
+ int (*tcl_MethodIsPrivate) (Tcl_Method method); /* 29 */
} TclOOStubs;
extern const TclOOStubs *tclOOStubsPtr;
@@ -226,6 +229,8 @@ extern const TclOOStubs *tclOOStubsPtr;
(tclOOStubsPtr->tcl_ClassSetDestructor) /* 27 */
#define Tcl_GetObjectName \
(tclOOStubsPtr->tcl_GetObjectName) /* 28 */
+#define Tcl_MethodIsPrivate \
+ (tclOOStubsPtr->tcl_MethodIsPrivate) /* 29 */
#endif /* defined(USE_TCLOO_STUBS) */
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 0271a43..65d6ea1 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -17,6 +17,12 @@
#include "tclOOInt.h"
/*
+ * The actual value used to mark private declaration frames.
+ */
+
+#define PRIVATE_FRAME (FRAME_IS_OO_DEFINE | FRAME_IS_PRIVATE_DEFINE)
+
+/*
* The maximum length of fully-qualified object name to use in an errorinfo
* message. Longer than this will be curtailed.
*/
@@ -31,14 +37,17 @@ struct DeclaredSlot {
const char *name;
const Tcl_MethodType getterType;
const Tcl_MethodType setterType;
+ const Tcl_MethodType resolverType;
};
-#define SLOT(name,getter,setter) \
+#define SLOT(name,getter,setter,resolver) \
{"::oo::" name, \
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
getter, NULL, NULL}, \
{TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
- setter, NULL, NULL}}
+ setter, NULL, NULL}, \
+ {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
+ resolver, NULL, NULL}}
/*
* Forward declarations.
@@ -54,6 +63,8 @@ static inline int MagicDefinitionInvoke(Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv);
static inline Class * GetClassInOuterContext(Tcl_Interp *interp,
Tcl_Obj *className, const char *errMsg);
+static inline Tcl_Namespace *GetNamespaceInOuterContext(Tcl_Interp *interp,
+ Tcl_Obj *namespaceName);
static inline int InitDefineContext(Tcl_Interp *interp,
Tcl_Namespace *namespacePtr, Object *oPtr,
int objc, Tcl_Obj *const objv[]);
@@ -103,26 +114,59 @@ static int ObjVarsGet(ClientData clientData,
static int ObjVarsSet(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
+static int ResolveClass(ClientData clientData,
+ Tcl_Interp *interp, Tcl_ObjectContext context,
+ int objc, Tcl_Obj *const *objv);
/*
* Now define the slots used in declarations.
*/
static const struct DeclaredSlot slots[] = {
- SLOT("define::filter", ClassFilterGet, ClassFilterSet),
- SLOT("define::mixin", ClassMixinGet, ClassMixinSet),
- SLOT("define::superclass", ClassSuperGet, ClassSuperSet),
- SLOT("define::variable", ClassVarsGet, ClassVarsSet),
- SLOT("objdefine::filter", ObjFilterGet, ObjFilterSet),
- SLOT("objdefine::mixin", ObjMixinGet, ObjMixinSet),
- SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet),
- {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
+ SLOT("define::filter", ClassFilterGet, ClassFilterSet, NULL),
+ SLOT("define::mixin", ClassMixinGet, ClassMixinSet, ResolveClass),
+ SLOT("define::superclass", ClassSuperGet, ClassSuperSet, ResolveClass),
+ SLOT("define::variable", ClassVarsGet, ClassVarsSet, NULL),
+ SLOT("objdefine::filter", ObjFilterGet, ObjFilterSet, NULL),
+ SLOT("objdefine::mixin", ObjMixinGet, ObjMixinSet, ResolveClass),
+ SLOT("objdefine::variable", ObjVarsGet, ObjVarsSet, NULL),
+ {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};
+
+/*
+ * How to build the in-namespace name of a private variable. This is a pattern
+ * used with Tcl_ObjPrintf().
+ */
+
+#define PRIVATE_VARIABLE_PATTERN "%d : %s"
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * IsPrivateDefine --
+ *
+ * Extracts whether the current context is handling private definitions.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+IsPrivateDefine(
+ Tcl_Interp *interp)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (!iPtr->varFramePtr) {
+ return 0;
+ }
+ return iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME;
+}
/*
* ----------------------------------------------------------------------
*
* BumpGlobalEpoch --
+ *
* Utility that ensures that call chains that are invalid will get thrown
* away at an appropriate time. Note that exactly which epoch gets
* advanced will depend on exactly what the class is tangled up in; in
@@ -167,6 +211,7 @@ BumpGlobalEpoch(
* ----------------------------------------------------------------------
*
* RecomputeClassCacheFlag --
+ *
* Determine whether the object is prototypical of its class, and hence
* able to use the class's method chain cache.
*
@@ -189,6 +234,7 @@ RecomputeClassCacheFlag(
* ----------------------------------------------------------------------
*
* TclOOObjectSetFilters --
+ *
* Install a list of filter method names into an object.
*
* ----------------------------------------------------------------------
@@ -247,6 +293,7 @@ TclOOObjectSetFilters(
* ----------------------------------------------------------------------
*
* TclOOClassSetFilters --
+ *
* Install a list of filter method names into a class.
*
* ----------------------------------------------------------------------
@@ -309,6 +356,7 @@ TclOOClassSetFilters(
* ----------------------------------------------------------------------
*
* TclOOObjectSetMixins --
+ *
* Install a list of mixin classes into an object.
*
* ----------------------------------------------------------------------
@@ -364,6 +412,7 @@ TclOOObjectSetMixins(
* ----------------------------------------------------------------------
*
* TclOOClassSetMixins --
+ *
* Install a list of mixin classes into a class.
*
* ----------------------------------------------------------------------
@@ -413,7 +462,125 @@ TclOOClassSetMixins(
/*
* ----------------------------------------------------------------------
*
+ * InstallStandardVariableMapping, InstallPrivateVariableMapping --
+ *
+ * Helpers for installing standard and private variable maps.
+ *
+ * ----------------------------------------------------------------------
+ */
+static inline void
+InstallStandardVariableMapping(
+ VariableNameList *vnlPtr,
+ int varc,
+ Tcl_Obj *const *varv)
+{
+ Tcl_Obj *variableObj;
+ int i, n, created;
+ Tcl_HashTable uniqueTable;
+
+ for (i=0 ; i<varc ; i++) {
+ Tcl_IncrRefCount(varv[i]);
+ }
+ FOREACH(variableObj, *vnlPtr) {
+ Tcl_DecrRefCount(variableObj);
+ }
+ if (i != varc) {
+ if (varc == 0) {
+ ckfree(vnlPtr->list);
+ } else if (i) {
+ vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * varc);
+ } else {
+ vnlPtr->list = ckalloc(sizeof(Tcl_Obj *) * varc);
+ }
+ }
+ vnlPtr->num = 0;
+ if (varc > 0) {
+ Tcl_InitObjHashTable(&uniqueTable);
+ for (i=n=0 ; i<varc ; i++) {
+ Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+ if (created) {
+ vnlPtr->list[n++] = varv[i];
+ } else {
+ Tcl_DecrRefCount(varv[i]);
+ }
+ }
+ vnlPtr->num = n;
+
+ /*
+ * Shouldn't be necessary, but maintain num/list invariant.
+ */
+
+ if (n != varc) {
+ vnlPtr->list = ckrealloc(vnlPtr->list, sizeof(Tcl_Obj *) * n);
+ }
+ Tcl_DeleteHashTable(&uniqueTable);
+ }
+}
+
+static inline void
+InstallPrivateVariableMapping(
+ PrivateVariableList *pvlPtr,
+ int varc,
+ Tcl_Obj *const *varv,
+ int creationEpoch)
+{
+ PrivateVariableMapping *privatePtr;
+ int i, n, created;
+ Tcl_HashTable uniqueTable;
+
+ for (i=0 ; i<varc ; i++) {
+ Tcl_IncrRefCount(varv[i]);
+ }
+ FOREACH_STRUCT(privatePtr, *pvlPtr) {
+ Tcl_DecrRefCount(privatePtr->variableObj);
+ Tcl_DecrRefCount(privatePtr->fullNameObj);
+ }
+ if (i != varc) {
+ if (varc == 0) {
+ ckfree(pvlPtr->list);
+ } else if (i) {
+ pvlPtr->list = ckrealloc(pvlPtr->list,
+ sizeof(PrivateVariableMapping) * varc);
+ } else {
+ pvlPtr->list = ckalloc(sizeof(PrivateVariableMapping) * varc);
+ }
+ }
+
+ pvlPtr->num = 0;
+ if (varc > 0) {
+ Tcl_InitObjHashTable(&uniqueTable);
+ for (i=n=0 ; i<varc ; i++) {
+ Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
+ if (created) {
+ privatePtr = &(pvlPtr->list[n++]);
+ privatePtr->variableObj = varv[i];
+ privatePtr->fullNameObj = Tcl_ObjPrintf(
+ PRIVATE_VARIABLE_PATTERN,
+ creationEpoch, Tcl_GetString(varv[i]));
+ Tcl_IncrRefCount(privatePtr->fullNameObj);
+ } else {
+ Tcl_DecrRefCount(varv[i]);
+ }
+ }
+ pvlPtr->num = n;
+
+ /*
+ * Shouldn't be necessary, but maintain num/list invariant.
+ */
+
+ if (n != varc) {
+ pvlPtr->list = ckrealloc(pvlPtr->list,
+ sizeof(PrivateVariableMapping) * n);
+ }
+ Tcl_DeleteHashTable(&uniqueTable);
+ }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* RenameDeleteMethod --
+ *
* Core of the code to rename and delete methods.
*
* ----------------------------------------------------------------------
@@ -503,6 +670,7 @@ RenameDeleteMethod(
* ----------------------------------------------------------------------
*
* TclOOUnknownDefinition --
+ *
* Handles what happens when an unknown command is encountered during the
* processing of a definition script. Works by finding a command in the
* operating definition namespace that the requested command is a unique
@@ -534,7 +702,7 @@ TclOOUnknownDefinition(
return TCL_ERROR;
}
- soughtStr = Tcl_GetStringFromObj(objv[1], &soughtLen);
+ soughtStr = TclGetStringFromObj(objv[1], &soughtLen);
if (soughtLen == 0) {
goto noMatch;
}
@@ -581,6 +749,7 @@ TclOOUnknownDefinition(
* ----------------------------------------------------------------------
*
* FindCommand --
+ *
* Specialized version of Tcl_FindCommand that handles command prefixes
* and disallows namespace magic.
*
@@ -594,7 +763,7 @@ FindCommand(
Tcl_Namespace *const namespacePtr)
{
int length;
- const char *nameStr, *string = Tcl_GetStringFromObj(stringObj, &length);
+ const char *nameStr, *string = TclGetStringFromObj(stringObj, &length);
register Namespace *const nsPtr = (Namespace *) namespacePtr;
FOREACH_HASH_DECLS;
Tcl_Command cmd, cmd2;
@@ -641,6 +810,7 @@ FindCommand(
* ----------------------------------------------------------------------
*
* InitDefineContext --
+ *
* Does the magic incantations necessary to push the special stack frame
* used when processing object definitions. It is up to the caller to
* dispose of the frame (with TclPopStackFrame) when finished.
@@ -660,13 +830,14 @@ InitDefineContext(
if (namespacePtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "cannot process definitions; support namespace deleted",
- -1));
+ "no definition namespace available", -1));
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
- /* framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules */
+ /*
+ * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
+ */
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, FRAME_IS_OO_DEFINE);
@@ -681,6 +852,7 @@ InitDefineContext(
* ----------------------------------------------------------------------
*
* TclOOGetDefineCmdContext --
+ *
* Extracts the magic token from the current stack frame, or returns NULL
* (and leaves an error message) otherwise.
*
@@ -695,7 +867,8 @@ TclOOGetDefineCmdContext(
Tcl_Object object;
if ((iPtr->varFramePtr == NULL)
- || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE)) {
+ || (iPtr->varFramePtr->isProcCallFrame != FRAME_IS_OO_DEFINE
+ && iPtr->varFramePtr->isProcCallFrame != PRIVATE_FRAME)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"this command may only be called from within the context of"
" an ::oo::define or ::oo::objdefine command", -1));
@@ -716,11 +889,12 @@ TclOOGetDefineCmdContext(
/*
* ----------------------------------------------------------------------
*
- * GetClassInOuterContext --
- * Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
- * context that called oo::define (or equivalent). Note that this may
- * have to go up multiple levels to get the level that we started doing
- * definitions at.
+ * GetClassInOuterContext, GetNamespaceInOuterContext --
+ *
+ * Wrappers round Tcl_GetObjectFromObj and TclGetNamespaceFromObj to
+ * perform the lookup in the context that called oo::define (or
+ * equivalent). Note that this may have to go up multiple levels to get
+ * the level that we started doing definitions at.
*
* ----------------------------------------------------------------------
*/
@@ -735,7 +909,8 @@ GetClassInOuterContext(
Object *oPtr;
CallFrame *savedFramePtr = iPtr->varFramePtr;
- while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE) {
+ while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
+ || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
if (iPtr->varFramePtr->callerVarPtr == NULL) {
Tcl_Panic("getting outer context when already in global context");
}
@@ -754,11 +929,37 @@ GetClassInOuterContext(
}
return oPtr->classPtr;
}
+
+static inline Tcl_Namespace *
+GetNamespaceInOuterContext(
+ Tcl_Interp *interp,
+ Tcl_Obj *namespaceName)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Namespace *nsPtr;
+ int result;
+ CallFrame *savedFramePtr = iPtr->varFramePtr;
+
+ while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
+ || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
+ if (iPtr->varFramePtr->callerVarPtr == NULL) {
+ Tcl_Panic("getting outer context when already in global context");
+ }
+ iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
+ }
+ result = TclGetNamespaceFromObj(interp, namespaceName, &nsPtr);
+ iPtr->varFramePtr = savedFramePtr;
+ if (result != TCL_OK) {
+ return NULL;
+ }
+ return nsPtr;
+}
/*
* ----------------------------------------------------------------------
*
* GenerateErrorInfo --
+ *
* Factored out code to generate part of the error trace messages.
*
* ----------------------------------------------------------------------
@@ -783,7 +984,7 @@ GenerateErrorInfo(
int length;
Tcl_Obj *realNameObj = Tcl_ObjectDeleted((Tcl_Object) oPtr)
? savedNameObj : TclOOObjectName(interp, oPtr);
- const char *objName = Tcl_GetStringFromObj(realNameObj, &length);
+ const char *objName = TclGetStringFromObj(realNameObj, &length);
int limit = OBJNAME_LENGTH_IN_ERRORINFO_LIMIT;
int overflow = (length > limit);
@@ -797,6 +998,7 @@ GenerateErrorInfo(
* ----------------------------------------------------------------------
*
* MagicDefinitionInvoke --
+ *
* Part of the implementation of the "oo::define" and "oo::objdefine"
* commands that is used to implement the more-than-one-argument case,
* applying ensemble-like tricks with dispatch so that error messages are
@@ -860,6 +1062,7 @@ MagicDefinitionInvoke(
* ----------------------------------------------------------------------
*
* TclOODefineObjCmd --
+ *
* Implementation of the "oo::define" command. Works by effectively doing
* the same as 'namespace eval', but with extra magic applied so that the
* object to be modified is known to the commands in the target
@@ -876,7 +1079,7 @@ TclOODefineObjCmd(
int objc,
Tcl_Obj *const *objv)
{
- Foundation *fPtr = TclOOGetFoundation(interp);
+ Tcl_Namespace *nsPtr;
Object *oPtr;
int result;
@@ -891,7 +1094,7 @@ TclOODefineObjCmd(
}
if (oPtr->classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%s does not refer to a class",TclGetString(objv[1])));
+ "%s does not refer to a class", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
TclGetString(objv[1]), NULL);
return TCL_ERROR;
@@ -902,7 +1105,8 @@ TclOODefineObjCmd(
* command(s).
*/
- if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){
+ nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 1);
+ if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -918,7 +1122,7 @@ TclOODefineObjCmd(
}
TclDecrRefCount(objNameObj);
} else {
- result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
+ result = MagicDefinitionInvoke(interp, nsPtr, 2, objc, objv);
}
TclOODecrRefCount(oPtr);
@@ -934,6 +1138,7 @@ TclOODefineObjCmd(
* ----------------------------------------------------------------------
*
* TclOOObjDefObjCmd --
+ *
* Implementation of the "oo::objdefine" command. Works by effectively
* doing the same as 'namespace eval', but with extra magic applied so
* that the object to be modified is known to the commands in the target
@@ -950,7 +1155,7 @@ TclOOObjDefObjCmd(
int objc,
Tcl_Obj *const *objv)
{
- Foundation *fPtr = TclOOGetFoundation(interp);
+ Tcl_Namespace *nsPtr;
Object *oPtr;
int result;
@@ -969,7 +1174,8 @@ TclOOObjDefObjCmd(
* command(s).
*/
- if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
+ nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
+ if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
@@ -985,7 +1191,7 @@ TclOOObjDefObjCmd(
}
TclDecrRefCount(objNameObj);
} else {
- result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
+ result = MagicDefinitionInvoke(interp, nsPtr, 2, objc, objv);
}
TclOODecrRefCount(oPtr);
@@ -1001,6 +1207,7 @@ TclOOObjDefObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineSelfObjCmd --
+ *
* Implementation of the "self" subcommand of the "oo::define" command.
* Works by effectively doing the same as 'namespace eval', but with
* extra magic applied so that the object to be modified is known to the
@@ -1017,28 +1224,34 @@ TclOODefineSelfObjCmd(
int objc,
Tcl_Obj *const *objv)
{
- Foundation *fPtr = TclOOGetFoundation(interp);
+ Tcl_Namespace *nsPtr;
Object *oPtr;
- int result;
-
- if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
- return TCL_ERROR;
- }
+ int result, private;
oPtr = (Object *) TclOOGetDefineCmdContext(interp);
if (oPtr == NULL) {
return TCL_ERROR;
}
+ if (objc < 2) {
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
+ return TCL_OK;
+ }
+
+ private = IsPrivateDefine(interp);
+
/*
* Make the oo::objdefine namespace the current namespace and evaluate the
* command(s).
*/
- if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
+ nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
+ if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
return TCL_ERROR;
}
+ if (private) {
+ ((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
+ }
AddRef(oPtr);
if (objc == 2) {
@@ -1046,13 +1259,13 @@ TclOODefineSelfObjCmd(
Tcl_IncrRefCount(objNameObj);
result = TclEvalObjEx(interp, objv[1], 0,
- ((Interp *)interp)->cmdFramePtr, 2);
+ ((Interp *)interp)->cmdFramePtr, 1);
if (result == TCL_ERROR) {
GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
}
TclDecrRefCount(objNameObj);
} else {
- result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
+ result = MagicDefinitionInvoke(interp, nsPtr, 1, objc, objv);
}
TclOODecrRefCount(oPtr);
@@ -1067,7 +1280,115 @@ TclOODefineSelfObjCmd(
/*
* ----------------------------------------------------------------------
*
+ * TclOODefineObjSelfObjCmd --
+ *
+ * Implementation of the "self" subcommand of the "oo::objdefine"
+ * command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineObjSelfObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Object *oPtr;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOODefinePrivateObjCmd --
+ *
+ * Implementation of the "private" subcommand of the "oo::define"
+ * and "oo::objdefine" commands.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefinePrivateObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int isInstancePrivate = (clientData != NULL);
+ /* Just so that we can generate the correct
+ * error message depending on the context of
+ * usage of this function. */
+ Interp *iPtr = (Interp *) interp;
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ int saved; /* The saved flag. We restore it on exit so
+ * that [private private ...] doesn't make
+ * things go weird. */
+ int result;
+
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 1) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(IsPrivateDefine(interp)));
+ return TCL_OK;
+ }
+
+ /*
+ * Change the frame type flag while evaluating the body.
+ */
+
+ saved = iPtr->varFramePtr->isProcCallFrame;
+ iPtr->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
+
+ /*
+ * Evaluate the body; standard pattern.
+ */
+
+ AddRef(oPtr);
+ if (objc == 2) {
+ Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
+
+ Tcl_IncrRefCount(objNameObj);
+ result = TclEvalObjEx(interp, objv[1], 0, iPtr->cmdFramePtr, 1);
+ if (result == TCL_ERROR) {
+ GenerateErrorInfo(interp, oPtr, objNameObj,
+ isInstancePrivate ? "object" : "class");
+ }
+ TclDecrRefCount(objNameObj);
+ } else {
+ result = MagicDefinitionInvoke(interp, TclGetCurrentNamespace(interp),
+ 1, objc, objv);
+ }
+ TclOODecrRefCount(oPtr);
+
+ /*
+ * Restore the frame type flag to what it was previously.
+ */
+
+ iPtr->varFramePtr->isProcCallFrame = saved;
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOODefineClassObjCmd --
+ *
* Implementation of the "class" subcommand of the "oo::objdefine"
* command.
*
@@ -1176,6 +1497,7 @@ TclOODefineClassObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineConstructorObjCmd --
+ *
* Implementation of the "constructor" subcommand of the "oo::define"
* command.
*
@@ -1210,7 +1532,7 @@ TclOODefineConstructorObjCmd(
}
clsPtr = oPtr->classPtr;
- Tcl_GetStringFromObj(objv[2], &bodyLength);
+ TclGetStringFromObj(objv[2], &bodyLength);
if (bodyLength > 0) {
/*
* Create the method structure.
@@ -1243,7 +1565,93 @@ TclOODefineConstructorObjCmd(
/*
* ----------------------------------------------------------------------
*
+ * TclOODefineDefnNsObjCmd --
+ *
+ * Implementation of the "definitionnamespace" subcommand of the
+ * "oo::define" command.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOODefineDefnNsObjCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ static const char *kindList[] = {
+ "-class",
+ "-instance",
+ NULL
+ };
+ int kind = 0;
+ Object *oPtr;
+ Tcl_Namespace *nsPtr;
+ Tcl_Obj *nsNamePtr, **storagePtr;
+
+ oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!oPtr->classPtr) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "attempt to misuse API", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+ if (oPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "may not modify the definition namespace of the root classes",
+ -1));
+ Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the arguments and work out what the user wants to do.
+ */
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?kind? namespace");
+ return TCL_ERROR;
+ }
+ if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[1], kindList, "kind", 0,
+ &kind) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!Tcl_GetString(objv[objc - 1])[0]) {
+ nsNamePtr = NULL;
+ } else {
+ nsPtr = GetNamespaceInOuterContext(interp, objv[objc - 1]);
+ if (nsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, -1);
+ Tcl_IncrRefCount(nsNamePtr);
+ }
+
+ /*
+ * Update the correct field of the class definition.
+ */
+
+ if (kind) {
+ storagePtr = &oPtr->classPtr->objDefinitionNs;
+ } else {
+ storagePtr = &oPtr->classPtr->clsDefinitionNs;
+ }
+ if (*storagePtr != NULL) {
+ Tcl_DecrRefCount(*storagePtr);
+ }
+ *storagePtr = nsNamePtr;
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOODefineDeleteMethodObjCmd --
+ *
* Implementation of the "deletemethod" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
@@ -1300,6 +1708,7 @@ TclOODefineDeleteMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineDestructorObjCmd --
+ *
* Implementation of the "destructor" subcommand of the "oo::define"
* command.
*
@@ -1329,7 +1738,7 @@ TclOODefineDestructorObjCmd(
}
clsPtr = oPtr->classPtr;
- Tcl_GetStringFromObj(objv[1], &bodyLength);
+ TclGetStringFromObj(objv[1], &bodyLength);
if (bodyLength > 0) {
/*
* Create the method structure.
@@ -1364,6 +1773,7 @@ TclOODefineDestructorObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineExportObjCmd --
+ *
* Implementation of the "export" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1434,8 +1844,9 @@ TclOODefineExportObjCmd(
} else {
mPtr = Tcl_GetHashValue(hPtr);
}
- if (isNew || !(mPtr->flags & PUBLIC_METHOD)) {
+ if (isNew || !(mPtr->flags & (PUBLIC_METHOD | PRIVATE_METHOD))) {
mPtr->flags |= PUBLIC_METHOD;
+ mPtr->flags &= ~TRUE_PRIVATE_METHOD;
changed = 1;
}
}
@@ -1458,6 +1869,7 @@ TclOODefineExportObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineForwardObjCmd --
+ *
* Implementation of the "forward" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1494,6 +1906,9 @@ TclOODefineForwardObjCmd(
}
isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
? PUBLIC_METHOD : 0;
+ if (IsPrivateDefine(interp)) {
+ isPublic = TRUE_PRIVATE_METHOD;
+ }
/*
* Create the method structure.
@@ -1518,6 +1933,7 @@ TclOODefineForwardObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineMethodObjCmd --
+ *
* Implementation of the "method" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1531,12 +1947,28 @@ TclOODefineMethodObjCmd(
int objc,
Tcl_Obj *const *objv)
{
+ /*
+ * Table of export modes for methods and their corresponding enum.
+ */
+
+ static const char *const exportModes[] = {
+ "-export",
+ "-private",
+ "-unexport",
+ NULL
+ };
+ enum ExportMode {
+ MODE_EXPORT,
+ MODE_PRIVATE,
+ MODE_UNEXPORT
+ } exportMode;
+
int isInstanceMethod = (clientData != NULL);
Object *oPtr;
- int isPublic;
+ int isPublic = 0;
- if (objc != 4) {
- Tcl_WrongNumArgs(interp, 1, objv, "name args body");
+ if (objc < 4 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?option? args body");
return TCL_ERROR;
}
@@ -1550,8 +1982,30 @@ TclOODefineMethodObjCmd(
Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
return TCL_ERROR;
}
- isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
- ? PUBLIC_METHOD : 0;
+ if (objc == 5) {
+ if (Tcl_GetIndexFromObj(interp, objv[2], exportModes, "export flag",
+ 0, (int *) &exportMode) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ switch (exportMode) {
+ case MODE_EXPORT:
+ isPublic = PUBLIC_METHOD;
+ break;
+ case MODE_PRIVATE:
+ isPublic = TRUE_PRIVATE_METHOD;
+ break;
+ case MODE_UNEXPORT:
+ isPublic = 0;
+ break;
+ }
+ } else {
+ if (IsPrivateDefine(interp)) {
+ isPublic = TRUE_PRIVATE_METHOD;
+ } else {
+ isPublic = Tcl_StringMatch(TclGetString(objv[1]), "[a-z]*")
+ ? PUBLIC_METHOD : 0;
+ }
+ }
/*
* Create the method by using the right back-end API.
@@ -1559,12 +2013,12 @@ TclOODefineMethodObjCmd(
if (isInstanceMethod) {
if (TclOONewProcInstanceMethod(interp, oPtr, isPublic, objv[1],
- objv[2], objv[3], NULL) == NULL) {
+ objv[objc - 2], objv[objc - 1], NULL) == NULL) {
return TCL_ERROR;
}
} else {
if (TclOONewProcMethod(interp, oPtr->classPtr, isPublic, objv[1],
- objv[2], objv[3], NULL) == NULL) {
+ objv[objc - 2], objv[objc - 1], NULL) == NULL) {
return TCL_ERROR;
}
}
@@ -1575,6 +2029,7 @@ TclOODefineMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineRenameMethodObjCmd --
+ *
* Implementation of the "renamemethod" subcommand of the "oo::define"
* and "oo::objdefine" commands.
*
@@ -1631,6 +2086,7 @@ TclOODefineRenameMethodObjCmd(
* ----------------------------------------------------------------------
*
* TclOODefineUnexportObjCmd --
+ *
* Implementation of the "unexport" subcommand of the "oo::define" and
* "oo::objdefine" commands.
*
@@ -1701,8 +2157,8 @@ TclOODefineUnexportObjCmd(
} else {
mPtr = Tcl_GetHashValue(hPtr);
}
- if (isNew || mPtr->flags & PUBLIC_METHOD) {
- mPtr->flags &= ~PUBLIC_METHOD;
+ if (isNew || mPtr->flags & (PUBLIC_METHOD | TRUE_PRIVATE_METHOD)) {
+ mPtr->flags &= ~(PUBLIC_METHOD | TRUE_PRIVATE_METHOD);
changed = 1;
}
}
@@ -1725,6 +2181,7 @@ TclOODefineUnexportObjCmd(
* ----------------------------------------------------------------------
*
* Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
+ *
* How to install a constructor or destructor into a class; API to call
* from C.
*
@@ -1779,6 +2236,7 @@ Tcl_ClassSetDestructor(
* ----------------------------------------------------------------------
*
* TclOODefineSlots --
+ *
* Create the "::oo::Slot" class and its standard instances. Class
* definition is empty at the stage (added by scripting).
*
@@ -1792,6 +2250,7 @@ TclOODefineSlots(
const struct DeclaredSlot *slotInfoPtr;
Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
+ Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
Class *slotCls;
slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
@@ -1801,9 +2260,10 @@ TclOODefineSlots(
}
Tcl_IncrRefCount(getName);
Tcl_IncrRefCount(setName);
+ Tcl_IncrRefCount(resolveName);
for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
- (Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
+ (Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);
if (slotObject == NULL) {
continue;
@@ -1812,9 +2272,14 @@ TclOODefineSlots(
&slotInfoPtr->getterType, NULL);
Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
&slotInfoPtr->setterType, NULL);
+ if (slotInfoPtr->resolverType.callProc) {
+ Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
+ &slotInfoPtr->resolverType, NULL);
+ }
}
Tcl_DecrRefCount(getName);
Tcl_DecrRefCount(setName);
+ Tcl_DecrRefCount(resolveName);
return TCL_OK;
}
@@ -1822,6 +2287,7 @@ TclOODefineSlots(
* ----------------------------------------------------------------------
*
* ClassFilterGet, ClassFilterSet --
+ *
* Implementation of the "filter" slot accessors of the "oo::define"
* command.
*
@@ -1901,6 +2367,7 @@ ClassFilterSet(
* ----------------------------------------------------------------------
*
* ClassMixinGet, ClassMixinSet --
+ *
* Implementation of the "mixin" slot accessors of the "oo::define"
* command.
*
@@ -2006,6 +2473,7 @@ ClassMixinSet(
* ----------------------------------------------------------------------
*
* ClassSuperGet, ClassSuperSet --
+ *
* Implementation of the "superclass" slot accessors of the "oo::define"
* command.
*
@@ -2135,8 +2603,12 @@ ClassSuperSet(
ckfree(superclasses);
return TCL_ERROR;
}
- /* Corresponding TclOODecrRefCount() is near the end of this
- * function */
+
+ /*
+ * Corresponding TclOODecrRefCount() is near the end of this
+ * function.
+ */
+
AddRef(superclasses[i]->thisPtr);
}
}
@@ -2153,7 +2625,7 @@ ClassSuperSet(
TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
TclOODecrRefCount(superPtr->thisPtr);
}
- ckfree((char *) oPtr->classPtr->superclasses.list);
+ ckfree(oPtr->classPtr->superclasses.list);
}
oPtr->classPtr->superclasses.list = superclasses;
oPtr->classPtr->superclasses.num = superc;
@@ -2169,6 +2641,7 @@ ClassSuperSet(
* ----------------------------------------------------------------------
*
* ClassVarsGet, ClassVarsSet --
+ *
* Implementation of the "variable" slot accessors of the "oo::define"
* command.
*
@@ -2184,7 +2657,7 @@ ClassVarsGet(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
- Tcl_Obj *resultObj, *variableObj;
+ Tcl_Obj *resultObj;
int i;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
@@ -2202,8 +2675,18 @@ ClassVarsGet(
}
resultObj = Tcl_NewObj();
- FOREACH(variableObj, oPtr->classPtr->variables) {
- Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ if (IsPrivateDefine(interp)) {
+ PrivateVariableMapping *privatePtr;
+
+ FOREACH_STRUCT(privatePtr, oPtr->classPtr->privateVariables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
+ }
+ } else {
+ Tcl_Obj *variableObj;
+
+ FOREACH(variableObj, oPtr->classPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -2219,7 +2702,7 @@ ClassVarsSet(
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
int varc;
- Tcl_Obj **varv, *variableObj;
+ Tcl_Obj **varv;
int i;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
@@ -2242,7 +2725,7 @@ ClassVarsSet(
}
for (i=0 ; i<varc ; i++) {
- const char *varName = Tcl_GetString(varv[i]);
+ const char *varName = TclGetString(varv[i]);
if (strstr(varName, "::") != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2260,49 +2743,11 @@ ClassVarsSet(
}
}
- for (i=0 ; i<varc ; i++) {
- Tcl_IncrRefCount(varv[i]);
- }
- FOREACH(variableObj, oPtr->classPtr->variables) {
- Tcl_DecrRefCount(variableObj);
- }
- if (i != varc) {
- if (varc == 0) {
- ckfree((char *) oPtr->classPtr->variables.list);
- } else if (i) {
- oPtr->classPtr->variables.list = (Tcl_Obj **)
- ckrealloc((char *) oPtr->classPtr->variables.list,
- sizeof(Tcl_Obj *) * varc);
- } else {
- oPtr->classPtr->variables.list = (Tcl_Obj **)
- ckalloc(sizeof(Tcl_Obj *) * varc);
- }
- }
-
- oPtr->classPtr->variables.num = 0;
- if (varc > 0) {
- int created, n;
- Tcl_HashTable uniqueTable;
-
- Tcl_InitObjHashTable(&uniqueTable);
- for (i=n=0 ; i<varc ; i++) {
- Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
- if (created) {
- oPtr->classPtr->variables.list[n++] = varv[i];
- } else {
- Tcl_DecrRefCount(varv[i]);
- }
- }
- oPtr->classPtr->variables.num = n;
-
- /*
- * Shouldn't be necessary, but maintain num/list invariant.
- */
-
- oPtr->classPtr->variables.list = (Tcl_Obj **)
- ckrealloc((char *) oPtr->classPtr->variables.list,
- sizeof(Tcl_Obj *) * n);
- Tcl_DeleteHashTable(&uniqueTable);
+ if (IsPrivateDefine(interp)) {
+ InstallPrivateVariableMapping(&oPtr->classPtr->privateVariables,
+ varc, varv, oPtr->classPtr->thisPtr->creationEpoch);
+ } else {
+ InstallStandardVariableMapping(&oPtr->classPtr->variables, varc, varv);
}
return TCL_OK;
}
@@ -2311,6 +2756,7 @@ ClassVarsSet(
* ----------------------------------------------------------------------
*
* ObjectFilterGet, ObjectFilterSet --
+ *
* Implementation of the "filter" slot accessors of the "oo::objdefine"
* command.
*
@@ -2378,6 +2824,7 @@ ObjFilterSet(
* ----------------------------------------------------------------------
*
* ObjectMixinGet, ObjectMixinSet --
+ *
* Implementation of the "mixin" slot accessors of the "oo::objdefine"
* command.
*
@@ -2463,6 +2910,7 @@ ObjMixinSet(
* ----------------------------------------------------------------------
*
* ObjectVarsGet, ObjectVarsSet --
+ *
* Implementation of the "variable" slot accessors of the "oo::objdefine"
* command.
*
@@ -2478,7 +2926,7 @@ ObjVarsGet(
Tcl_Obj *const *objv)
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
- Tcl_Obj *resultObj, *variableObj;
+ Tcl_Obj *resultObj;
int i;
if (Tcl_ObjectContextSkippedArgs(context) != objc) {
@@ -2490,8 +2938,18 @@ ObjVarsGet(
}
resultObj = Tcl_NewObj();
- FOREACH(variableObj, oPtr->variables) {
- Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ if (IsPrivateDefine(interp)) {
+ PrivateVariableMapping *privatePtr;
+
+ FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
+ }
+ } else {
+ Tcl_Obj *variableObj;
+
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -2507,7 +2965,7 @@ ObjVarsSet(
{
Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
int varc, i;
- Tcl_Obj **varv, *variableObj;
+ Tcl_Obj **varv;
if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -2523,7 +2981,7 @@ ObjVarsSet(
}
for (i=0 ; i<varc ; i++) {
- const char *varName = Tcl_GetString(varv[i]);
+ const char *varName = TclGetString(varv[i]);
if (strstr(varName, "::") != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2540,50 +2998,66 @@ ObjVarsSet(
return TCL_ERROR;
}
}
- for (i=0 ; i<varc ; i++) {
- Tcl_IncrRefCount(varv[i]);
- }
- FOREACH(variableObj, oPtr->variables) {
- Tcl_DecrRefCount(variableObj);
- }
- if (i != varc) {
- if (varc == 0) {
- ckfree((char *) oPtr->variables.list);
- } else if (i) {
- oPtr->variables.list = (Tcl_Obj **)
- ckrealloc((char *) oPtr->variables.list,
- sizeof(Tcl_Obj *) * varc);
- } else {
- oPtr->variables.list = (Tcl_Obj **)
- ckalloc(sizeof(Tcl_Obj *) * varc);
- }
+ if (IsPrivateDefine(interp)) {
+ InstallPrivateVariableMapping(&oPtr->privateVariables, varc, varv,
+ oPtr->creationEpoch);
+ } else {
+ InstallStandardVariableMapping(&oPtr->variables, varc, varv);
}
- oPtr->variables.num = 0;
- if (varc > 0) {
- int created, n;
- Tcl_HashTable uniqueTable;
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ResolveClass --
+ *
+ * Implementation of the "Resolve" support method for some slots (those
+ * that are slots around a list of classes). This resolves possible class
+ * names to their fully-qualified names if possible.
+ *
+ * ----------------------------------------------------------------------
+ */
- Tcl_InitObjHashTable(&uniqueTable);
- for (i=n=0 ; i<varc ; i++) {
- Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
- if (created) {
- oPtr->variables.list[n++] = varv[i];
- } else {
- Tcl_DecrRefCount(varv[i]);
- }
- }
- oPtr->variables.num = n;
+static int
+ResolveClass(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ Tcl_ObjectContext context,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ int idx = Tcl_ObjectContextSkippedArgs(context);
+ Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+ Class *clsPtr;
- /*
- * Shouldn't be necessary, but maintain num/list invariant.
- */
+ /*
+ * Check if were called wrongly. The definition context isn't used...
+ * except that GetClassInOuterContext() assumes that it is there.
+ */
- oPtr->variables.list = (Tcl_Obj **)
- ckrealloc((char *) oPtr->variables.list,
- sizeof(Tcl_Obj *) * n);
- Tcl_DeleteHashTable(&uniqueTable);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ } else if (objc != idx + 1) {
+ Tcl_WrongNumArgs(interp, idx, objv, "slotElement");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Resolve the class if possible. If not, remove any resolution error and
+ * return what we've got anyway as the failure might not be fatal overall.
+ */
+
+ clsPtr = GetClassInOuterContext(interp, objv[idx],
+ "USER SHOULD NOT SEE THIS MESSAGE");
+ if (clsPtr == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, objv[idx]);
+ } else {
+ Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
}
+
return TCL_OK;
}
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index c9263b5..fefeb0f 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -22,6 +22,7 @@ static Tcl_ObjCmdProc InfoObjectClassCmd;
static Tcl_ObjCmdProc InfoObjectDefnCmd;
static Tcl_ObjCmdProc InfoObjectFiltersCmd;
static Tcl_ObjCmdProc InfoObjectForwardCmd;
+static Tcl_ObjCmdProc InfoObjectIdCmd;
static Tcl_ObjCmdProc InfoObjectIsACmd;
static Tcl_ObjCmdProc InfoObjectMethodsCmd;
static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
@@ -32,6 +33,7 @@ static Tcl_ObjCmdProc InfoObjectVariablesCmd;
static Tcl_ObjCmdProc InfoClassCallCmd;
static Tcl_ObjCmdProc InfoClassConstrCmd;
static Tcl_ObjCmdProc InfoClassDefnCmd;
+static Tcl_ObjCmdProc InfoClassDefnNsCmd;
static Tcl_ObjCmdProc InfoClassDestrCmd;
static Tcl_ObjCmdProc InfoClassFiltersCmd;
static Tcl_ObjCmdProc InfoClassForwardCmd;
@@ -50,6 +52,7 @@ static Tcl_ObjCmdProc InfoClassVariablesCmd;
static const EnsembleImplMap infoObjectCmds[] = {
{"call", InfoObjectCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"class", InfoObjectClassCmd, TclCompileInfoObjectClassCmd, NULL, NULL, 0},
+ {"creationid", InfoObjectIdCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"definition", InfoObjectDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"filters", InfoObjectFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"forward", InfoObjectForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
@@ -58,7 +61,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
{"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"mixins", InfoObjectMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"namespace", InfoObjectNsCmd, TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
- {"variables", InfoObjectVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"variables", InfoObjectVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"vars", InfoObjectVarsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -71,6 +74,7 @@ static const EnsembleImplMap infoClassCmds[] = {
{"call", InfoClassCallCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"constructor", InfoClassConstrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"definition", InfoClassDefnCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"definitionnamespace", InfoClassDefnNsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"destructor", InfoClassDestrCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"filters", InfoClassFiltersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"forward", InfoClassForwardCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
@@ -80,7 +84,7 @@ static const EnsembleImplMap infoClassCmds[] = {
{"mixins", InfoClassMixinsCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
{"subclasses", InfoClassSubsCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"superclasses", InfoClassSupersCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
- {"variables", InfoClassVariablesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
+ {"variables", InfoClassVariablesCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{NULL, NULL, NULL, NULL, NULL, 0}
};
@@ -519,15 +523,22 @@ InfoObjectMethodsCmd(
Tcl_Obj *const objv[])
{
Object *oPtr;
- int flag = PUBLIC_METHOD, recurse = 0;
+ int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
FOREACH_HASH_DECLS;
Tcl_Obj *namePtr, *resultObj;
Method *mPtr;
static const char *const options[] = {
- "-all", "-localprivate", "-private", NULL
+ "-all", "-localprivate", "-private", "-scope", NULL
};
enum Options {
- OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
+ OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
+ };
+ static const char *const scopes[] = {
+ "private", "public", "unexported"
+ };
+ enum Scopes {
+ SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED,
+ SCOPE_LOCALPRIVATE
};
if (objc < 2) {
@@ -556,14 +567,45 @@ InfoObjectMethodsCmd(
case OPT_PRIVATE:
flag = 0;
break;
+ case OPT_SCOPE:
+ if (++i >= objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing option for -scope"));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
+ &scope) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
}
}
}
+ if (scope != -1) {
+ recurse = 0;
+ switch (scope) {
+ case SCOPE_PRIVATE:
+ flag = TRUE_PRIVATE_METHOD;
+ break;
+ case SCOPE_PUBLIC:
+ flag = PUBLIC_METHOD;
+ break;
+ case SCOPE_LOCALPRIVATE:
+ flag = PRIVATE_METHOD;
+ break;
+ case SCOPE_UNEXPORTED:
+ flag = 0;
+ break;
+ }
+ }
resultObj = Tcl_NewObj();
if (recurse) {
const char **names;
- int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names);
+ int i, numNames = TclOOGetSortedMethodList(oPtr, NULL, NULL, flag,
+ &names);
for (i=0 ; i<numNames ; i++) {
Tcl_ListObjAppendElement(NULL, resultObj,
@@ -574,7 +616,7 @@ InfoObjectMethodsCmd(
}
} else if (oPtr->methodsPtr) {
FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
- if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
+ if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
@@ -686,6 +728,38 @@ InfoObjectMixinsCmd(
/*
* ----------------------------------------------------------------------
*
+ * InfoObjectIdCmd --
+ *
+ * Implements [info object creationid $objName]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoObjectIdCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ Object *oPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ return TCL_ERROR;
+ }
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(oPtr->creationEpoch));
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* InfoObjectNsCmd --
*
* Implements [info object namespace $objName]
@@ -721,7 +795,7 @@ InfoObjectNsCmd(
*
* InfoObjectVariablesCmd --
*
- * Implements [info object variables $objName]
+ * Implements [info object variables $objName ?-private?]
*
* ----------------------------------------------------------------------
*/
@@ -734,21 +808,37 @@ InfoObjectVariablesCmd(
Tcl_Obj *const objv[])
{
Object *oPtr;
- Tcl_Obj *variableObj, *resultObj;
- int i;
+ Tcl_Obj *resultObj;
+ int i, private = 0;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "objName");
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "objName ?-private?");
return TCL_ERROR;
}
+ if (objc == 3) {
+ if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
+ return TCL_ERROR;
+ }
+ private = 1;
+ }
oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
if (oPtr == NULL) {
return TCL_ERROR;
}
resultObj = Tcl_NewObj();
- FOREACH(variableObj, oPtr->variables) {
- Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ if (private) {
+ PrivateVariableMapping *privatePtr;
+
+ FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
+ }
+ } else {
+ Tcl_Obj *variableObj;
+
+ FOREACH(variableObj, oPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -947,6 +1037,56 @@ InfoClassDefnCmd(
/*
* ----------------------------------------------------------------------
*
+ * InfoClassDefnNsCmd --
+ *
+ * Implements [info class definitionnamespace $clsName ?$kind?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+InfoClassDefnNsCmd(
+ ClientData clientData,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const objv[])
+{
+ static const char *kindList[] = {
+ "-class",
+ "-instance",
+ NULL
+ };
+ int kind = 0;
+ Tcl_Obj *nsNamePtr;
+ Class *clsPtr;
+
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className ?kind?");
+ return TCL_ERROR;
+ }
+ clsPtr = GetClassFromObj(interp, objv[1]);
+ if (clsPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[2], kindList, "kind", 0,
+ &kind) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (kind) {
+ nsNamePtr = clsPtr->objDefinitionNs;
+ } else {
+ nsNamePtr = clsPtr->clsDefinitionNs;
+ }
+ if (nsNamePtr) {
+ Tcl_SetObjResult(interp, nsNamePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* InfoClassDestrCmd --
*
* Implements [info class destructor $clsName]
@@ -1130,7 +1270,7 @@ InfoClassInstancesCmd(
*
* InfoClassMethodsCmd --
*
- * Implements [info class methods $clsName ?-private?]
+ * Implements [info class methods $clsName ?options...?]
*
* ----------------------------------------------------------------------
*/
@@ -1142,15 +1282,21 @@ InfoClassMethodsCmd(
int objc,
Tcl_Obj *const objv[])
{
- int flag = PUBLIC_METHOD, recurse = 0;
+ int flag = PUBLIC_METHOD, recurse = 0, scope = -1;
Tcl_Obj *namePtr, *resultObj;
Method *mPtr;
Class *clsPtr;
static const char *const options[] = {
- "-all", "-localprivate", "-private", NULL
+ "-all", "-localprivate", "-private", "-scope", NULL
};
enum Options {
- OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE
+ OPT_ALL, OPT_LOCALPRIVATE, OPT_PRIVATE, OPT_SCOPE
+ };
+ static const char *const scopes[] = {
+ "private", "public", "unexported"
+ };
+ enum Scopes {
+ SCOPE_PRIVATE, SCOPE_PUBLIC, SCOPE_UNEXPORTED
};
if (objc < 2) {
@@ -1179,9 +1325,36 @@ InfoClassMethodsCmd(
case OPT_PRIVATE:
flag = 0;
break;
+ case OPT_SCOPE:
+ if (++i >= objc) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "missing option for -scope"));
+ Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "MISSING",
+ NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[i], scopes, "scope", 0,
+ &scope) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ break;
}
}
}
+ if (scope != -1) {
+ recurse = 0;
+ switch (scope) {
+ case SCOPE_PRIVATE:
+ flag = TRUE_PRIVATE_METHOD;
+ break;
+ case SCOPE_PUBLIC:
+ flag = PUBLIC_METHOD;
+ break;
+ case SCOPE_UNEXPORTED:
+ flag = 0;
+ break;
+ }
+ }
resultObj = Tcl_NewObj();
if (recurse) {
@@ -1199,7 +1372,7 @@ InfoClassMethodsCmd(
FOREACH_HASH_DECLS;
FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
- if (mPtr->typePtr != NULL && (mPtr->flags & flag) == flag) {
+ if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) {
Tcl_ListObjAppendElement(NULL, resultObj, namePtr);
}
}
@@ -1401,7 +1574,7 @@ InfoClassSupersCmd(
*
* InfoClassVariablesCmd --
*
- * Implements [info class variables $clsName]
+ * Implements [info class variables $clsName ?-private?]
*
* ----------------------------------------------------------------------
*/
@@ -1414,21 +1587,37 @@ InfoClassVariablesCmd(
Tcl_Obj *const objv[])
{
Class *clsPtr;
- Tcl_Obj *variableObj, *resultObj;
- int i;
+ Tcl_Obj *resultObj;
+ int i, private = 0;
- if (objc != 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "className");
+ if (objc != 2 && objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "className ?-private?");
return TCL_ERROR;
}
+ if (objc == 3) {
+ if (strcmp("-private", Tcl_GetString(objv[2])) != 0) {
+ return TCL_ERROR;
+ }
+ private = 1;
+ }
clsPtr = GetClassFromObj(interp, objv[1]);
if (clsPtr == NULL) {
return TCL_ERROR;
}
resultObj = Tcl_NewObj();
- FOREACH(variableObj, clsPtr->variables) {
- Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ if (private) {
+ PrivateVariableMapping *privatePtr;
+
+ FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, privatePtr->variableObj);
+ }
+ } else {
+ Tcl_Obj *variableObj;
+
+ FOREACH(variableObj, clsPtr->variables) {
+ Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
+ }
}
Tcl_SetObjResult(interp, resultObj);
return TCL_OK;
@@ -1467,7 +1656,8 @@ InfoObjectCallCmd(
* Get the call context and render its call chain.
*/
- contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL);
+ contextPtr = TclOOGetCallContext(oPtr, objv[2], PUBLIC_METHOD, NULL, NULL,
+ NULL);
if (contextPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"cannot construct any call chain", -1));
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index e59fe8a..c1a9010 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -47,7 +47,7 @@ typedef struct Method {
* special flag record which is just used for
* the setting of the flags field. */
int refCount;
- ClientData clientData; /* Type-specific data. */
+ void *clientData; /* Type-specific data. */
Tcl_Obj *namePtr; /* Name of the method. */
struct Object *declaringObjectPtr;
/* The object that declares this method, or
@@ -84,7 +84,7 @@ typedef struct ProcedureMethod {
* body bytecodes. */
int flags; /* Flags to control features. */
int refCount;
- ClientData clientData;
+ void *clientData;
TclOO_PmCDDeleteProc *deleteClientdataProc;
TclOO_PmCDCloneProc *cloneClientdataProc;
ProcErrorProc *errProc; /* Replacement error handler. */
@@ -125,6 +125,18 @@ typedef struct ForwardMethod {
} ForwardMethod;
/*
+ * Structure used in private variable mappings. Describes the mapping of a
+ * single variable from the user's local name to the system's storage name.
+ * [TIP #500]
+ */
+
+typedef struct {
+ Tcl_Obj *variableObj; /* Name used within methods. This is the part
+ * that is properly under user control. */
+ Tcl_Obj *fullNameObj; /* Name used at the instance namespace level. */
+} PrivateVariableMapping;
+
+/*
* Helper definitions that declare a "list" array. The two varieties are
* either optimized for simplicity (in the case that the whole array is
* typically assigned at once) or efficiency (in the case that the array is
@@ -142,6 +154,13 @@ typedef struct ForwardMethod {
struct { int num, size; listType_t *list; }
/*
+ * These types are needed in function arguments.
+ */
+
+typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
+typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
+
+/*
* Now, the definition of what an object actually is.
*/
@@ -186,7 +205,12 @@ typedef struct Object {
Tcl_ObjectMapMethodNameProc *mapMethodNameProc;
/* Function to allow remapping of method
* names. For itcl-ng. */
- LIST_STATIC(Tcl_Obj *) variables;
+ VariableNameList variables;
+ PrivateVariableList privateVariables;
+ /* Configurations for the variable resolver
+ * used inside methods. */
+ Tcl_Command myclassCommand; /* Reference to this object's class dispatcher
+ * command. */
} Object;
#define OBJECT_DELETED 1 /* Flag to say that an object has been
@@ -214,7 +238,14 @@ typedef struct Object {
* other spots). */
#define FORCE_UNKNOWN 0x10000 /* States that we are *really* looking up the
* unknown method handler at that point. */
-#define DONT_DELETE 0x20000 /* Inhibit deletion of this object. */
+#define HAS_PRIVATE_METHODS 0x20000
+ /* Object/class has (or had) private methods,
+ * and so shouldn't be cached so
+ * aggressively. */
+#define DONT_DELETE 0x40000 /* Inhibit deletion of this object. Used
+ * during fundamental object type mutation to
+ * make sure that the object actually survives
+ * to the end of the operation. */
/*
* And the definition of a class. Note that every class also has an associated
@@ -269,7 +300,28 @@ typedef struct Class {
* object doesn't override with its own mixins
* (and filters and method implementations for
* when getting method chains). */
- LIST_STATIC(Tcl_Obj *) variables;
+ VariableNameList variables;
+ PrivateVariableList privateVariables;
+ /* Configurations for the variable resolver
+ * used inside methods. */
+ Tcl_Obj *clsDefinitionNs; /* Name of the namespace to use for
+ * definitions commands of instances of this
+ * class in when those instances are defined
+ * as classes. If NULL, use the value from the
+ * class hierarchy. It's an error at
+ * [oo::define] call time if this namespace is
+ * defined but doesn't exist; we also check at
+ * setting time but don't check between
+ * times. */
+ Tcl_Obj *objDefinitionNs; /* Name of the namespace to use for
+ * definitions commands of instances of this
+ * class in when those instances are defined
+ * as instances. If NULL, use the value from
+ * the class hierarchy. It's an error at
+ * [oo::objdefine]/[self] call time if this
+ * namespace is defined but doesn't exist; we
+ * also check at setting time but don't check
+ * between times. */
} Class;
/*
@@ -371,10 +423,15 @@ typedef struct CallContext {
#define PUBLIC_METHOD 0x01 /* This is a public (exported) method. */
#define PRIVATE_METHOD 0x02 /* This is a private (class's direct instances
- * only) method. */
+ * only) method. Supports itcl. */
#define OO_UNKNOWN_METHOD 0x04 /* This is an unknown method. */
#define CONSTRUCTOR 0x08 /* This is a constructor. */
#define DESTRUCTOR 0x10 /* This is a destructor. */
+#define TRUE_PRIVATE_METHOD 0x20
+ /* This is a private method only accessible
+ * from other methods defined on this class
+ * or instance. [TIP #500] */
+#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
/*
* Structure containing definition information about basic class methods.
@@ -402,6 +459,9 @@ MODULE_SCOPE int TclOOObjDefObjCmd(ClientData clientData,
MODULE_SCOPE int TclOODefineConstructorObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineDefnNsObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
MODULE_SCOPE int TclOODefineDeleteMethodObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
@@ -429,6 +489,12 @@ MODULE_SCOPE int TclOODefineClassObjCmd(ClientData clientData,
MODULE_SCOPE int TclOODefineSelfObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefineObjSelfObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
+MODULE_SCOPE int TclOODefinePrivateObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv);
MODULE_SCOPE int TclOOUnknownDefinition(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv);
@@ -506,7 +572,10 @@ MODULE_SCOPE void TclOODeleteDescendants(Tcl_Interp *interp,
MODULE_SCOPE void TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
Tcl_Obj *methodNameObj, int flags,
+ Object *contextObjPtr, Class *contextClsPtr,
Tcl_Obj *cacheInThisObj);
+MODULE_SCOPE Tcl_Namespace *TclOOGetDefineContextNamespace(
+ Tcl_Interp *interp, Object *oPtr, int forClass);
MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
Tcl_Obj *methodNameObj, int flags);
MODULE_SCOPE Foundation *TclOOGetFoundation(Tcl_Interp *interp);
@@ -515,7 +584,8 @@ MODULE_SCOPE Proc * TclOOGetProcFromMethod(Method *mPtr);
MODULE_SCOPE Tcl_Obj * TclOOGetMethodBody(Method *mPtr);
MODULE_SCOPE int TclOOGetSortedClassMethodList(Class *clsPtr,
int flags, const char ***stringsPtr);
-MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr, int flags,
+MODULE_SCOPE int TclOOGetSortedMethodList(Object *oPtr,
+ Object *contextObj, Class *contextCls, int flags,
const char ***stringsPtr);
MODULE_SCOPE int TclOOInit(Tcl_Interp *interp);
MODULE_SCOPE void TclOOInitInfo(Tcl_Interp *interp);
@@ -563,13 +633,24 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
#define FOREACH(var,ary) \
for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
continue; \
- } else if (var = (ary).list[i], 1)
+ } else if (var = (ary).list[i], 1)
+
+/*
+ * A variation where the array is an array of structs. There's no issue with
+ * possible NULLs; every element of the array will be iterated over and the
+ * varable set to a pointer to each of those elements in turn.
+ * REQUIRES DECLARATION: int i;
+ */
+
+#define FOREACH_STRUCT(var,ary) \
+ for(i=0 ; var=&((ary).list[i]), i<(ary).num; i++)
/*
* Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS
* sets up the declarations needed for the main macro, FOREACH_HASH, which
* does the actual iteration. FOREACH_HASH_VALUE is a restricted version that
* only iterates over values.
+ * REQUIRES DECLARATION: FOREACH_HASH_DECLS;
*/
#define FOREACH_HASH_DECLS \
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 3e64ba2..db31795 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -67,7 +67,7 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc,
Tcl_Obj *const *objv, int toRewrite,
int rewriteLength, Tcl_Obj *const *rewriteObjs,
int *lengthPtr);
-static int InvokeProcedureMethod(ClientData clientData,
+static int InvokeProcedureMethod(void *clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
static Tcl_NRPostProc FinalizeForwardCall;
@@ -77,22 +77,22 @@ static int PushMethodCallFrame(Tcl_Interp *interp,
int objc, Tcl_Obj *const *objv,
PMFrameData *fdPtr);
static void DeleteProcedureMethodRecord(ProcedureMethod *pmPtr);
-static void DeleteProcedureMethod(ClientData clientData);
+static void DeleteProcedureMethod(void *clientData);
static int CloneProcedureMethod(Tcl_Interp *interp,
- ClientData clientData, ClientData *newClientData);
+ void *clientData, void **newClientData);
static void MethodErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void ConstructorErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
static void DestructorErrorHandler(Tcl_Interp *interp,
Tcl_Obj *procNameObj);
-static Tcl_Obj * RenderDeclarerName(ClientData clientData);
-static int InvokeForwardMethod(ClientData clientData,
+static Tcl_Obj * RenderDeclarerName(void *clientData);
+static int InvokeForwardMethod(void *clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
-static void DeleteForwardMethod(ClientData clientData);
+static void DeleteForwardMethod(void *clientData);
static int CloneForwardMethod(Tcl_Interp *interp,
- ClientData clientData, ClientData *newClientData);
+ void *clientData, void **newClientData);
static int ProcedureMethodVarResolver(Tcl_Interp *interp,
const char *varName, Tcl_Namespace *contextNs,
int flags, Tcl_Var *varPtr);
@@ -146,7 +146,7 @@ Tcl_NewInstanceMethod(
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
- ClientData clientData) /* Some data associated with the particular
+ void *clientData) /* Some data associated with the particular
* method to be created. */
{
register Object *oPtr = (Object *) object;
@@ -186,7 +186,11 @@ Tcl_NewInstanceMethod(
mPtr->declaringObjectPtr = oPtr;
mPtr->declaringClassPtr = NULL;
if (flags) {
- mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+ mPtr->flags |= flags &
+ (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
+ if (flags & TRUE_PRIVATE_METHOD) {
+ oPtr->flags |= HAS_PRIVATE_METHODS;
+ }
}
oPtr->epoch++;
return (Tcl_Method) mPtr;
@@ -214,7 +218,7 @@ Tcl_NewMethod(
/* The type of method this is, which defines
* how to invoke, delete and clone the
* method. */
- ClientData clientData) /* Some data associated with the particular
+ void *clientData) /* Some data associated with the particular
* method to be created. */
{
register Class *clsPtr = (Class *) cls;
@@ -250,7 +254,11 @@ Tcl_NewMethod(
mPtr->declaringObjectPtr = NULL;
mPtr->declaringClassPtr = clsPtr;
if (flags) {
- mPtr->flags |= flags & (PUBLIC_METHOD | PRIVATE_METHOD);
+ mPtr->flags |= flags &
+ (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD);
+ if (flags & TRUE_PRIVATE_METHOD) {
+ clsPtr->flags |= HAS_PRIVATE_METHODS;
+ }
}
return (Tcl_Method) mPtr;
@@ -450,7 +458,7 @@ TclOOMakeProcInstanceMethod(
* NULL. */
const Tcl_MethodType *typePtr,
/* The type of the method to create. */
- ClientData clientData, /* The per-method type-specific data. */
+ void *clientData, /* The per-method type-specific data. */
Proc **procPtrPtr) /* A pointer to the variable in which to write
* the procedure record reference. Presumably
* inside the structure indicated by the
@@ -563,7 +571,7 @@ TclOOMakeProcMethod(
* NULL. */
const Tcl_MethodType *typePtr,
/* The type of the method to create. */
- ClientData clientData, /* The per-method type-specific data. */
+ void *clientData, /* The per-method type-specific data. */
Proc **procPtrPtr) /* A pointer to the variable in which to write
* the procedure record reference. Presumably
* inside the structure indicated by the
@@ -658,7 +666,7 @@ TclOOMakeProcMethod(
static int
InvokeProcedureMethod(
- ClientData clientData, /* Pointer to some per-method context. */
+ void *clientData, /* Pointer to some per-method context. */
Tcl_Interp *interp,
Tcl_ObjectContext context, /* The method calling context. */
int objc, /* Number of arguments. */
@@ -737,7 +745,7 @@ InvokeProcedureMethod(
static int
FinalizePMCall(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -791,6 +799,7 @@ PushMethodCallFrame(
register int result;
const char *namePtr;
CallFrame **framePtrPtr = &fdPtr->framePtr;
+ ByteCode *codePtr;
/*
* Compute basic information on the basis of the type of method it is.
@@ -856,10 +865,8 @@ PushMethodCallFrame(
* alternative is *so* slow...
*/
- if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
- ByteCode *codePtr =
- pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
-
+ ByteCodeGetIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr);
+ if (codePtr) {
codePtr->nsPtr = nsPtr;
}
result = TclProcCompileProc(interp, pmPtr->procPtr,
@@ -928,7 +935,7 @@ PushMethodCallFrame(
* variables used in methods. The compiled variable resolver is more
* important, but both are needed as it is possible to have a variable
* that is only referred to in ways that aren't compilable and we can't
- * force LVT presence. [TIP #320]
+ * force LVT presence. [TIP #320, #500]
*
* ----------------------------------------------------------------------
*/
@@ -984,6 +991,7 @@ ProcedureMethodCompiledVarConnect(
CallFrame *framePtr = iPtr->varFramePtr;
CallContext *contextPtr;
Tcl_Obj *variableObj;
+ PrivateVariableMapping *privateVar;
Tcl_HashEntry *hPtr;
int i, isNew, cacheIt, varLen, len;
const char *match, *varName;
@@ -1017,6 +1025,15 @@ ProcedureMethodCompiledVarConnect(
varName = TclGetStringFromObj(infoPtr->variableObj, &varLen);
if (contextPtr->callPtr->chain[contextPtr->index]
.mPtr->declaringClassPtr != NULL) {
+ FOREACH_STRUCT(privateVar, contextPtr->callPtr->chain[contextPtr->index]
+ .mPtr->declaringClassPtr->privateVariables) {
+ match = TclGetStringFromObj(privateVar->variableObj, &len);
+ if ((len == varLen) && !memcmp(match, varName, len)) {
+ variableObj = privateVar->fullNameObj;
+ cacheIt = 0;
+ goto gotMatch;
+ }
+ }
FOREACH(variableObj, contextPtr->callPtr->chain[contextPtr->index]
.mPtr->declaringClassPtr->variables) {
match = TclGetStringFromObj(variableObj, &len);
@@ -1026,6 +1043,14 @@ ProcedureMethodCompiledVarConnect(
}
}
} else {
+ FOREACH_STRUCT(privateVar, contextPtr->oPtr->privateVariables) {
+ match = TclGetStringFromObj(privateVar->variableObj, &len);
+ if ((len == varLen) && !memcmp(match, varName, len)) {
+ variableObj = privateVar->fullNameObj;
+ cacheIt = 1;
+ goto gotMatch;
+ }
+ }
FOREACH(variableObj, contextPtr->oPtr->variables) {
match = TclGetStringFromObj(variableObj, &len);
if ((len == varLen) && !memcmp(match, varName, len)) {
@@ -1125,7 +1150,7 @@ ProcedureMethodCompiledVarResolver(
static Tcl_Obj *
RenderDeclarerName(
- ClientData clientData)
+ void *clientData)
{
struct PNI *pni = clientData;
Tcl_Object object = Tcl_MethodDeclarerObject(pni->method);
@@ -1164,7 +1189,7 @@ MethodErrorHandler(
CallContext *contextPtr = ((Interp *) interp)->varFramePtr->clientData;
Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
const char *objectName, *kindName, *methodName =
- Tcl_GetStringFromObj(mPtr->namePtr, &nameLen);
+ TclGetStringFromObj(mPtr->namePtr, &nameLen);
Object *declarerPtr;
if (mPtr->declaringObjectPtr != NULL) {
@@ -1267,7 +1292,7 @@ DeleteProcedureMethodRecord(
static void
DeleteProcedureMethod(
- ClientData clientData)
+ void *clientData)
{
register ProcedureMethod *pmPtr = clientData;
@@ -1279,8 +1304,8 @@ DeleteProcedureMethod(
static int
CloneProcedureMethod(
Tcl_Interp *interp,
- ClientData clientData,
- ClientData *newClientData)
+ void *clientData,
+ void **newClientData)
{
ProcedureMethod *pmPtr = clientData;
ProcedureMethod *pm2Ptr;
@@ -1313,7 +1338,7 @@ CloneProcedureMethod(
bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
Tcl_GetString(bodyObj);
- TclFreeIntRep(bodyObj);
+ Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);
/*
* Create the actual copy of the method record, manufacturing a new proc
@@ -1433,7 +1458,7 @@ TclOONewForwardMethod(
static int
InvokeForwardMethod(
- ClientData clientData, /* Pointer to some per-method context. */
+ void *clientData, /* Pointer to some per-method context. */
Tcl_Interp *interp,
Tcl_ObjectContext context, /* The method calling context. */
int objc, /* Number of arguments. */
@@ -1467,7 +1492,7 @@ InvokeForwardMethod(
static int
FinalizeForwardCall(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -1489,7 +1514,7 @@ FinalizeForwardCall(
static void
DeleteForwardMethod(
- ClientData clientData)
+ void *clientData)
{
ForwardMethod *fmPtr = clientData;
@@ -1500,8 +1525,8 @@ DeleteForwardMethod(
static int
CloneForwardMethod(
Tcl_Interp *interp,
- ClientData clientData,
- ClientData *newClientData)
+ void *clientData,
+ void **newClientData)
{
ForwardMethod *fmPtr = clientData;
ForwardMethod *fm2Ptr = ckalloc(sizeof(ForwardMethod));
@@ -1542,9 +1567,7 @@ TclOOGetMethodBody(
if (mPtr->typePtr == &procMethodType) {
ProcedureMethod *pmPtr = mPtr->clientData;
- if (pmPtr->procPtr->bodyPtr->bytes == NULL) {
- (void) Tcl_GetString(pmPtr->procPtr->bodyPtr);
- }
+ (void) TclGetString(pmPtr->procPtr->bodyPtr);
return pmPtr->procPtr->bodyPtr;
}
return NULL;
@@ -1652,7 +1675,7 @@ int
Tcl_MethodIsType(
Tcl_Method method,
const Tcl_MethodType *typePtr,
- ClientData *clientDataPtr)
+ void **clientDataPtr)
{
Method *mPtr = (Method *) method;
@@ -1671,6 +1694,13 @@ Tcl_MethodIsPublic(
{
return (((Method *)method)->flags & PUBLIC_METHOD) ? 1 : 0;
}
+
+int
+Tcl_MethodIsPrivate(
+ Tcl_Method method)
+{
+ return (((Method *)method)->flags & TRUE_PRIVATE_METHOD) ? 1 : 0;
+}
/*
* Extended method construction for itcl-ng.
@@ -1683,7 +1713,7 @@ TclOONewProcInstanceMethodEx(
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
ProcErrorProc *errProc,
- ClientData clientData,
+ void *clientData,
Tcl_Obj *nameObj, /* The name of the method, which must not be
* NULL. */
Tcl_Obj *argsObj, /* The formal argument list for the method,
@@ -1720,7 +1750,7 @@ TclOONewProcMethodEx(
TclOO_PreCallProc *preCallPtr,
TclOO_PostCallProc *postCallPtr,
ProcErrorProc *errProc,
- ClientData clientData,
+ void *clientData,
Tcl_Obj *nameObj, /* The name of the method, which may be NULL;
* if so, up to caller to manage storage
* (e.g., because it is a constructor or
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
new file mode 100644
index 0000000..ab637dd
--- /dev/null
+++ b/generic/tclOOScript.h
@@ -0,0 +1,263 @@
+/*
+ * tclOOScript.h --
+ *
+ * This file contains support scripts for TclOO. They are defined here so
+ * that the code can be definitely run even in safe interpreters; TclOO's
+ * core setup is safe.
+ *
+ * Copyright (c) 2012-2018 Donal K. Fellows
+ * Copyright (c) 2013 Andreas Kupries
+ * Copyright (c) 2017 Gerald Lester
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef TCL_OO_SCRIPT_H
+#define TCL_OO_SCRIPT_H
+
+/*
+ * The scripted part of the definitions of TclOO.
+ *
+ * Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
+ * contains the commented version of everything; *this* file is automatically
+ * generated.
+ */
+
+static const char *tclOOSetupScript =
+/* !BEGIN!: Do not edit below this line. */
+"::namespace eval ::oo {\n"
+"\t::namespace path {}\n"
+"\tnamespace eval Helpers {\n"
+"\t\t::namespace path {}\n"
+"\t\tproc callback {method args} {\n"
+"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
+"\t\t}\n"
+"\t\tnamespace export callback\n"
+"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
+"\t\tnamespace export -clear\n"
+"\t\trename tmp::callback mymethod\n"
+"\t\tnamespace delete tmp\n"
+"\t\tproc classvariable {name args} {\n"
+"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
+"\t\t\tforeach v [list $name {*}$args] {\n"
+"\t\t\t\tif {[string match *(*) $v]} {\n"
+"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
+"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
+"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {[string match *::* $v]} {\n"
+"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
+"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
+"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
+"\t\t\t\t}\n"
+"\t\t\t\tlappend vs $v $v\n"
+"\t\t\t}\n"
+"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
+"\t\t}\n"
+"\t\tproc link {args} {\n"
+"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
+"\t\t\tforeach link $args {\n"
+"\t\t\t\tif {[llength $link] == 2} {\n"
+"\t\t\t\t\tlassign $link src dst\n"
+"\t\t\t\t} elseif {[llength $link] == 1} {\n"
+"\t\t\t\t\tlassign $link src\n"
+"\t\t\t\t\tset dst $src\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {![string match ::* $src]} {\n"
+"\t\t\t\t\tset src [string cat $ns :: $src]\n"
+"\t\t\t\t}\n"
+"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
+"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
+"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
+"\t\t\t}\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t}\n"
+"\tproc UnlinkLinkedCommand {cmd args} {\n"
+"\t\tif {[namespace which $cmd] ne {}} {\n"
+"\t\t\trename $cmd {}\n"
+"\t\t}\n"
+"\t}\n"
+"\tproc DelegateName {class} {\n"
+"\t\tstring cat [info object namespace $class] {:: oo ::delegate}\n"
+"\t}\n"
+"\tproc MixinClassDelegates {class} {\n"
+"\t\tif {![info object isa class $class]} {\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t\tset delegate [DelegateName $class]\n"
+"\t\tif {![info object isa class $delegate]} {\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t\tforeach c [info class superclass $class] {\n"
+"\t\t\tset d [DelegateName $c]\n"
+"\t\t\tif {![info object isa class $d]} {\n"
+"\t\t\t\tcontinue\n"
+"\t\t\t}\n"
+"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
+"\t\t}\n"
+"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
+"\t}\n"
+"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
+"\t\tset originDelegate [DelegateName $originObject]\n"
+"\t\tset targetDelegate [DelegateName $targetObject]\n"
+"\t\tif {\n"
+"\t\t\t[info object isa class $originDelegate]\n"
+"\t\t\t&& ![info object isa class $targetDelegate]\n"
+"\t\t} then {\n"
+"\t\t\tcopy $originDelegate $targetDelegate\n"
+"\t\t\tobjdefine $targetObject mixin -set \\\n"
+"\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n"
+"\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n"
+"\t\t\t\t}]\n"
+"\t\t}\n"
+"\t}\n"
+"\tproc define::classmethod {name {args {}} {body {}}} {\n"
+"\t\t::set argc [::llength [::info level 0]]\n"
+"\t\t::if {$argc == 3} {\n"
+"\t\t\t::return -code error -errorcode {TCL WRONGARGS} [::format \\\n"
+"\t\t\t\t{wrong # args: should be \"%s name \?args body\?\"} \\\n"
+"\t\t\t\t[::lindex [::info level 0] 0]]\n"
+"\t\t}\n"
+"\t\t::set cls [::uplevel 1 self]\n"
+"\t\t::if {$argc == 4} {\n"
+"\t\t\t::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
+"\t\t}\n"
+"\t\t::tailcall forward $name myclass $name\n"
+"\t}\n"
+"\tproc define::initialise {body} {\n"
+"\t\t::set clsns [::info object namespace [::uplevel 1 self]]\n"
+"\t\t::tailcall apply [::list {} $body $clsns]\n"
+"\t}\n"
+"\tnamespace eval define {\n"
+"\t\t::namespace export initialise\n"
+"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
+"\t\t::namespace export -clear\n"
+"\t\t::rename tmp::initialise initialize\n"
+"\t\t::namespace delete tmp\n"
+"\t}\n"
+"\tdefine Slot {\n"
+"\t\tmethod Get {} {\n"
+"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
+"\t\t}\n"
+"\t\tmethod Set list {\n"
+"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
+"\t\t}\n"
+"\t\tmethod Resolve list {\n"
+"\t\t\treturn $list\n"
+"\t\t}\n"
+"\t\tmethod -set args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\ttailcall my Set $args\n"
+"\t\t}\n"
+"\t\tmethod -append args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
+"\t\t}\n"
+"\t\tmethod -clear {} {tailcall my Set {}}\n"
+"\t\tmethod -prepend args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
+"\t\t}\n"
+"\t\tmethod -remove args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\ttailcall my Set [lmap val $current {\n"
+"\t\t\t\tif {$val in $args} continue else {set val}\n"
+"\t\t\t}]\n"
+"\t\t}\n"
+"\t\tforward --default-operation my -append\n"
+"\t\tmethod unknown {args} {\n"
+"\t\t\tset def --default-operation\n"
+"\t\t\tif {[llength $args] == 0} {\n"
+"\t\t\t\ttailcall my $def\n"
+"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
+"\t\t\t\ttailcall my $def {*}$args\n"
+"\t\t\t}\n"
+"\t\t\tnext {*}$args\n"
+"\t\t}\n"
+"\t\texport -set -append -clear -prepend -remove\n"
+"\t\tunexport unknown destroy\n"
+"\t}\n"
+"\tobjdefine define::superclass forward --default-operation my -set\n"
+"\tobjdefine define::mixin forward --default-operation my -set\n"
+"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
+"\tdefine object method <cloned> {originObject} {\n"
+"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
+"\t\t\tset args [info args $p]\n"
+"\t\t\tset idx -1\n"
+"\t\t\tforeach a $args {\n"
+"\t\t\t\tif {[info default $p $a d]} {\n"
+"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\tlset args [incr idx] [list $a]\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\tset b [info body $p]\n"
+"\t\t\tset p [namespace tail $p]\n"
+"\t\t\tproc $p $args $b\n"
+"\t\t}\n"
+"\t\tforeach v [info vars [info object namespace $originObject]::*] {\n"
+"\t\t\tupvar 0 $v vOrigin\n"
+"\t\t\tnamespace upvar [namespace current] [namespace tail $v] vNew\n"
+"\t\t\tif {[info exists vOrigin]} {\n"
+"\t\t\t\tif {[array exists vOrigin]} {\n"
+"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\tset vNew $vOrigin\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t}\n"
+"\t}\n"
+"\tdefine class method <cloned> {originObject} {\n"
+"\t\tnext $originObject\n"
+"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
+"\t}\n"
+"\tclass create singleton {\n"
+"\t\tsuperclass class\n"
+"\t\tvariable object\n"
+"\t\tunexport create createWithNamespace\n"
+"\t\tmethod new args {\n"
+"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
+"\t\t\t\tset object [next {*}$args]\n"
+"\t\t\t\t::oo::objdefine $object {\n"
+"\t\t\t\t\tmethod destroy {} {\n"
+"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
+"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\tmethod <cloned> {originObject} {\n"
+"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
+"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\treturn $object\n"
+"\t\t}\n"
+"\t}\n"
+"\tclass create abstract {\n"
+"\t\tsuperclass class\n"
+"\t\tunexport create createWithNamespace new\n"
+"\t}\n"
+"}\n"
+/* !END!: Do not edit above this line. */
+;
+
+#endif /* TCL_OO_SCRIPT_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOScript.tcl b/generic/tclOOScript.tcl
new file mode 100644
index 0000000..5e0145f
--- /dev/null
+++ b/generic/tclOOScript.tcl
@@ -0,0 +1,456 @@
+# tclOOScript.h --
+#
+# This file contains support scripts for TclOO. They are defined here so
+# that the code can be definitely run even in safe interpreters; TclOO's
+# core setup is safe.
+#
+# Copyright (c) 2012-2018 Donal K. Fellows
+# Copyright (c) 2013 Andreas Kupries
+# Copyright (c) 2017 Gerald Lester
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+::namespace eval ::oo {
+ ::namespace path {}
+
+ #
+ # Commands that are made available to objects by default.
+ #
+ namespace eval Helpers {
+ ::namespace path {}
+
+ # ------------------------------------------------------------------
+ #
+ # callback, mymethod --
+ #
+ # Create a script prefix that calls a method on the current
+ # object. Same operation, two names.
+ #
+ # ------------------------------------------------------------------
+
+ proc callback {method args} {
+ list [uplevel 1 {::namespace which my}] $method {*}$args
+ }
+
+ # Make the [callback] command appear as [mymethod] too.
+ namespace export callback
+ namespace eval tmp {namespace import ::oo::Helpers::callback}
+ namespace export -clear
+ rename tmp::callback mymethod
+ namespace delete tmp
+
+ # ------------------------------------------------------------------
+ #
+ # classvariable --
+ #
+ # Link to a variable in the class of the current object.
+ #
+ # ------------------------------------------------------------------
+
+ proc classvariable {name args} {
+ # Get a reference to the class's namespace
+ set ns [info object namespace [uplevel 1 {self class}]]
+ # Double up the list of variable names
+ foreach v [list $name {*}$args] {
+ if {[string match *(*) $v]} {
+ set reason "can't create a scalar variable that looks like an array element"
+ return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
+ [format {bad variable name "%s": %s} $v $reason]
+ }
+ if {[string match *::* $v]} {
+ set reason "can't create a local variable with a namespace separator in it"
+ return -code error -errorcode {TCL UPVAR INVERTED} \
+ [format {bad variable name "%s": %s} $v $reason]
+ }
+ lappend vs $v $v
+ }
+ # Lastly, link the caller's local variables to the class's variables
+ tailcall namespace upvar $ns {*}$vs
+ }
+
+ # ------------------------------------------------------------------
+ #
+ # link --
+ #
+ # Make a command that invokes a method on the current object.
+ # The name of the command and the name of the method match by
+ # default.
+ #
+ # ------------------------------------------------------------------
+
+ proc link {args} {
+ set ns [uplevel 1 {::namespace current}]
+ foreach link $args {
+ if {[llength $link] == 2} {
+ lassign $link src dst
+ } elseif {[llength $link] == 1} {
+ lassign $link src
+ set dst $src
+ } else {
+ return -code error -errorcode {TCLOO CMDLINK FORMAT} \
+ "bad link description; must only have one or two elements"
+ }
+ if {![string match ::* $src]} {
+ set src [string cat $ns :: $src]
+ }
+ interp alias {} $src {} ${ns}::my $dst
+ trace add command ${ns}::my delete [list \
+ ::oo::UnlinkLinkedCommand $src]
+ }
+ return
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # UnlinkLinkedCommand --
+ #
+ # Callback used to remove linked command when the underlying mechanism
+ # that supports it is deleted.
+ #
+ # ----------------------------------------------------------------------
+
+ proc UnlinkLinkedCommand {cmd args} {
+ if {[namespace which $cmd] ne {}} {
+ rename $cmd {}
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # DelegateName --
+ #
+ # Utility that gets the name of the class delegate for a class. It's
+ # trivial, but makes working with them much easier as delegate names are
+ # intentionally hard to create by accident.
+ #
+ # ----------------------------------------------------------------------
+
+ proc DelegateName {class} {
+ string cat [info object namespace $class] {:: oo ::delegate}
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # MixinClassDelegates --
+ #
+ # Support code called *after* [oo::define] inside the constructor of a
+ # class that patches in the appropriate class delegates.
+ #
+ # ----------------------------------------------------------------------
+
+ proc MixinClassDelegates {class} {
+ if {![info object isa class $class]} {
+ return
+ }
+ set delegate [DelegateName $class]
+ if {![info object isa class $delegate]} {
+ return
+ }
+ foreach c [info class superclass $class] {
+ set d [DelegateName $c]
+ if {![info object isa class $d]} {
+ continue
+ }
+ define $delegate ::oo::define::superclass -append $d
+ }
+ objdefine $class ::oo::objdefine::mixin -append $delegate
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # UpdateClassDelegatesAfterClone --
+ #
+ # Support code that is like [MixinClassDelegates] except for when a
+ # class is cloned.
+ #
+ # ----------------------------------------------------------------------
+
+ proc UpdateClassDelegatesAfterClone {originObject targetObject} {
+ # Rebuild the class inheritance delegation class
+ set originDelegate [DelegateName $originObject]
+ set targetDelegate [DelegateName $targetObject]
+ if {
+ [info object isa class $originDelegate]
+ && ![info object isa class $targetDelegate]
+ } then {
+ copy $originDelegate $targetDelegate
+ objdefine $targetObject ::oo::objdefine::mixin -set \
+ {*}[lmap c [info object mixin $targetObject] {
+ if {$c eq $originDelegate} {set targetDelegate} {set c}
+ }]
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # oo::define::classmethod --
+ #
+ # Defines a class method. See define(n) for details.
+ #
+ # Note that the ::oo::define namespace is semi-public and a bit weird
+ # anyway, so we don't regard the namespace path as being under control:
+ # fully qualified names are used for everything.
+ #
+ # ----------------------------------------------------------------------
+
+ proc define::classmethod {name {args {}} {body {}}} {
+ # Create the method on the class if the caller gave arguments and body
+ ::set argc [::llength [::info level 0]]
+ ::if {$argc == 3} {
+ ::return -code error -errorcode {TCL WRONGARGS} [::format \
+ {wrong # args: should be "%s name ?args body?"} \
+ [::lindex [::info level 0] 0]]
+ }
+ ::set cls [::uplevel 1 self]
+ ::if {$argc == 4} {
+ ::oo::define [::oo::DelegateName $cls] method $name $args $body
+ }
+ # Make the connection by forwarding
+ ::tailcall forward $name myclass $name
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # oo::define::initialise, oo::define::initialize --
+ #
+ # Do specific initialisation for a class. See define(n) for details.
+ #
+ # Note that the ::oo::define namespace is semi-public and a bit weird
+ # anyway, so we don't regard the namespace path as being under control:
+ # fully qualified names are used for everything.
+ #
+ # ----------------------------------------------------------------------
+
+ proc define::initialise {body} {
+ ::set clsns [::info object namespace [::uplevel 1 self]]
+ ::tailcall apply [::list {} $body $clsns]
+ }
+
+ # Make the [initialise] definition appear as [initialize] too
+ namespace eval define {
+ ::namespace export initialise
+ ::namespace eval tmp {::namespace import ::oo::define::initialise}
+ ::namespace export -clear
+ ::rename tmp::initialise initialize
+ ::namespace delete tmp
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # Slot --
+ #
+ # The class of slot operations, which are basically lists at the low
+ # level of TclOO; this provides a more consistent interface to them.
+ #
+ # ----------------------------------------------------------------------
+
+ define Slot {
+ # ------------------------------------------------------------------
+ #
+ # Slot Get --
+ #
+ # Basic slot getter. Retrieves the contents of the slot.
+ # Particular slots must provide concrete non-erroring
+ # implementation.
+ #
+ # ------------------------------------------------------------------
+
+ method Get {} {
+ return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
+ }
+
+ # ------------------------------------------------------------------
+ #
+ # Slot Set --
+ #
+ # Basic slot setter. Sets the contents of the slot. Particular
+ # slots must provide concrete non-erroring implementation.
+ #
+ # ------------------------------------------------------------------
+
+ method Set list {
+ return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
+ }
+
+ # ------------------------------------------------------------------
+ #
+ # Slot Resolve --
+ #
+ # Helper that lets a slot convert a list of arguments of a
+ # particular type to their canonical forms. Defaults to doing
+ # nothing (suitable for simple strings).
+ #
+ # ------------------------------------------------------------------
+
+ method Resolve list {
+ return $list
+ }
+
+ # ------------------------------------------------------------------
+ #
+ # Slot -set, -append, -clear, --default-operation --
+ #
+ # Standard public slot operations. If a slot can't figure out
+ # what method to call directly, it uses --default-operation.
+ #
+ # ------------------------------------------------------------------
+
+ method -set args {
+ set my [namespace which my]
+ set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+ tailcall my Set $args
+ }
+ method -append args {
+ set my [namespace which my]
+ set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+ set current [uplevel 1 [list $my Get]]
+ tailcall my Set [list {*}$current {*}$args]
+ }
+ method -clear {} {tailcall my Set {}}
+ method -prepend args {
+ set my [namespace which my]
+ set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+ set current [uplevel 1 [list $my Get]]
+ tailcall my Set [list {*}$args {*}$current]
+ }
+ method -remove args {
+ set my [namespace which my]
+ set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+ set current [uplevel 1 [list $my Get]]
+ tailcall my Set [lmap val $current {
+ if {$val in $args} continue else {set val}
+ }]
+ }
+
+ # Default handling
+ forward --default-operation my -append
+ method unknown {args} {
+ set def --default-operation
+ if {[llength $args] == 0} {
+ tailcall my $def
+ } elseif {![string match -* [lindex $args 0]]} {
+ tailcall my $def {*}$args
+ }
+ next {*}$args
+ }
+
+ # Set up what is exported and what isn't
+ export -set -append -clear -prepend -remove
+ unexport unknown destroy
+ }
+
+ # Set the default operation differently for these slots
+ objdefine define::superclass forward --default-operation my -set
+ objdefine define::mixin forward --default-operation my -set
+ objdefine objdefine::mixin forward --default-operation my -set
+
+ # ----------------------------------------------------------------------
+ #
+ # oo::object <cloned> --
+ #
+ # Handler for cloning objects that clones basic bits (only!) of the
+ # object's namespace. Non-procedures, traces, sub-namespaces, etc. need
+ # more complex (and class-specific) handling.
+ #
+ # ----------------------------------------------------------------------
+
+ define object method <cloned> {originObject} {
+ # Copy over the procedures from the original namespace
+ foreach p [info procs [info object namespace $originObject]::*] {
+ set args [info args $p]
+ set idx -1
+ foreach a $args {
+ if {[info default $p $a d]} {
+ lset args [incr idx] [list $a $d]
+ } else {
+ lset args [incr idx] [list $a]
+ }
+ }
+ set b [info body $p]
+ set p [namespace tail $p]
+ proc $p $args $b
+ }
+ # Copy over the variables from the original namespace
+ foreach v [info vars [info object namespace $originObject]::*] {
+ upvar 0 $v vOrigin
+ namespace upvar [namespace current] [namespace tail $v] vNew
+ if {[info exists vOrigin]} {
+ if {[array exists vOrigin]} {
+ array set vNew [array get vOrigin]
+ } else {
+ set vNew $vOrigin
+ }
+ }
+ }
+ # General commands, sub-namespaces and advancd variable config (traces,
+ # etc) are *not* copied over. Classes that want that should do it
+ # themselves.
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # oo::class <cloned> --
+ #
+ # Handler for cloning classes, which fixes up the delegates.
+ #
+ # ----------------------------------------------------------------------
+
+ define class method <cloned> {originObject} {
+ next $originObject
+ # Rebuild the class inheritance delegation class
+ ::oo::UpdateClassDelegatesAfterClone $originObject [self]
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # oo::singleton --
+ #
+ # A metaclass that is used to make classes that only permit one instance
+ # of them to exist. See singleton(n).
+ #
+ # ----------------------------------------------------------------------
+
+ class create singleton {
+ superclass class
+ variable object
+ unexport create createWithNamespace
+ method new args {
+ if {![info exists object] || ![info object isa object $object]} {
+ set object [next {*}$args]
+ ::oo::objdefine $object {
+ method destroy {} {
+ ::return -code error -errorcode {TCLOO SINGLETON} \
+ "may not destroy a singleton object"
+ }
+ method <cloned> {originObject} {
+ ::return -code error -errorcode {TCLOO SINGLETON} \
+ "may not clone a singleton object"
+ }
+ }
+ }
+ return $object
+ }
+ }
+
+ # ----------------------------------------------------------------------
+ #
+ # oo::abstract --
+ #
+ # A metaclass that is used to make classes that can't be directly
+ # instantiated. See abstract(n).
+ #
+ # ----------------------------------------------------------------------
+
+ class create abstract {
+ superclass class
+ unexport create createWithNamespace new
+ }
+}
+
+# Local Variables:
+# mode: tcl
+# c-basic-offset: 4
+# fill-column: 78
+# End:
diff --git a/generic/tclOOStubInit.c b/generic/tclOOStubInit.c
index 900ab22..5e235f4 100644
--- a/generic/tclOOStubInit.c
+++ b/generic/tclOOStubInit.c
@@ -73,6 +73,7 @@ const TclOOStubs tclOOStubs = {
Tcl_ClassSetConstructor, /* 26 */
Tcl_ClassSetDestructor, /* 27 */
Tcl_GetObjectName, /* 28 */
+ Tcl_MethodIsPrivate, /* 29 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index a75ecdd..3385c0d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -17,6 +17,7 @@
#include "tclInt.h"
#include "tommath.h"
#include <math.h>
+#include <assert.h>
/*
* Table of all object types.
@@ -37,7 +38,7 @@ Tcl_Obj *tclFreeObjList = NULL;
* TclNewObj macro, however, so must be visible.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif
@@ -49,9 +50,8 @@ Tcl_Mutex tclObjMutex;
*/
char tclEmptyString = '\0';
-char *tclEmptyStringRep = &tclEmptyString;
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
* Structure for tracking the source file and line number where a given
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
@@ -76,7 +76,7 @@ typedef struct ObjData {
* The structure defined below is used in this file only.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
* generated by a call to the function
* TclSubstTokens() from a literal text
@@ -88,7 +88,7 @@ typedef struct ThreadSpecificData {
* tclCompile.h for the definition of this
* structure, and for references to all
* related places in the core. */
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
* that a Tcl_Obj was not allocated by some
* other thread. */
@@ -157,7 +157,7 @@ typedef struct PendingObjData {
/*
* Macro to set up the local reference to the deletion context.
*/
-#ifndef TCL_THREADS
+#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
PendingObjData *const contextPtr = &pendingObjData
@@ -178,7 +178,7 @@ static Tcl_ThreadDataKey pendingObjDataKey;
#define PACK_BIGNUM(bignum, objPtr) \
if ((bignum).used > 0x7fff) { \
- mp_int *temp = (void *) ckalloc((unsigned) sizeof(mp_int)); \
+ mp_int *temp = (void *) ckalloc(sizeof(mp_int)); \
*temp = bignum; \
(objPtr)->internalRep.twoPtrValue.ptr1 = temp; \
(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(-1); \
@@ -211,9 +211,8 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
static void UpdateStringOfInt(Tcl_Obj *objPtr);
-#ifndef TCL_WIDE_INT_IS_LONG
-static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
-static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
+static void UpdateStringOfOldInt(Tcl_Obj *objPtr);
#endif
static void FreeBignum(Tcl_Obj *objPtr);
static void DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
@@ -243,6 +242,7 @@ static int SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
* implementations.
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
static const Tcl_ObjType oldBooleanType = {
"boolean", /* name */
NULL, /* freeIntRepProc */
@@ -250,6 +250,7 @@ static const Tcl_ObjType oldBooleanType = {
NULL, /* updateStringProc */
TclSetBooleanFromAny /* setFromAnyProc */
};
+#endif
const Tcl_ObjType tclBooleanType = {
"booleanString", /* name */
NULL, /* freeIntRepProc */
@@ -265,19 +266,23 @@ const Tcl_ObjType tclDoubleType = {
SetDoubleFromAny /* setFromAnyProc */
};
const Tcl_ObjType tclIntType = {
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
"int", /* name */
+#else
+ "wideInt", /* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
+#endif
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
-#ifndef TCL_WIDE_INT_IS_LONG
-const Tcl_ObjType tclWideIntType = {
- "wideInt", /* name */
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
+static const Tcl_ObjType oldIntType = {
+ "int", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
- UpdateStringOfWideInt, /* updateStringProc */
- SetWideIntFromAny /* setFromAnyProc */
+ UpdateStringOfOldInt, /* updateStringProc */
+ SetIntFromAny /* setFromAnyProc */
};
#endif
const Tcl_ObjType tclBignumType = {
@@ -345,23 +350,23 @@ typedef struct ResolvedCmdName {
* reference (not the namespace that contains
* the referenced command). NULL if the name
* is fully qualified.*/
- long refNsId; /* refNsPtr's unique namespace id. Used to
+ unsigned 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
+ unsigned 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
+ unsigned 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
+ size_t 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
@@ -396,21 +401,21 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclByteArrayType);
Tcl_RegisterObjType(&tclDoubleType);
- Tcl_RegisterObjType(&tclEndOffsetType);
- Tcl_RegisterObjType(&tclIntType);
Tcl_RegisterObjType(&tclStringType);
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
- Tcl_RegisterObjType(&tclArraySearchType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
/* For backward compatibility only ... */
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+ Tcl_RegisterObjType(&tclIntType);
+#if !defined(TCL_WIDE_INT_IS_LONG)
+ Tcl_RegisterObjType(&oldIntType);
+#endif
Tcl_RegisterObjType(&oldBooleanType);
-#ifndef TCL_WIDE_INT_IS_LONG
- Tcl_RegisterObjType(&tclWideIntType);
#endif
#ifdef TCL_COMPILE_STATS
@@ -448,7 +453,7 @@ TclInitObjSubsystem(void)
void
TclFinalizeThreadObjects(void)
{
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -1005,7 +1010,7 @@ void
TclDbDumpActiveObjects(
FILE *outFile)
{
-#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
+#if TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashSearch hSearch;
Tcl_HashEntry *hPtr;
Tcl_HashTable *tablePtr;
@@ -1061,11 +1066,10 @@ TclDbInitNewObj(
* debugging. */
{
objPtr->refCount = 0;
- objPtr->bytes = tclEmptyStringRep;
- objPtr->length = 0;
objPtr->typePtr = NULL;
+ TclInitStringRep(objPtr, NULL, 0);
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Add entry to a thread local map used to check if a Tcl_Obj was
* allocated by the currently executing thread.
@@ -1301,7 +1305,7 @@ TclFreeObj(
ObjInitDeletionContext(context);
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -1628,32 +1632,30 @@ Tcl_GetString(
register Tcl_Obj *objPtr) /* Object whose string rep byte pointer should
* be returned. */
{
- if (objPtr->bytes != NULL) {
- return objPtr->bytes;
- }
-
- /*
- * Note we do not check for objPtr->typePtr == NULL. An invariant of
- * a properly maintained Tcl_Obj is that at least one of objPtr->bytes
- * and objPtr->typePtr must not be NULL. If broken extensions fail to
- * maintain that invariant, we can crash here.
- */
-
- if (objPtr->typePtr->updateStringProc == NULL) {
+ if (objPtr->bytes == NULL) {
/*
- * Those Tcl_ObjTypes which choose not to define an updateStringProc
- * must be written in such a way that (objPtr->bytes) never becomes
- * NULL. This panic was added in Tcl 8.1.
+ * Note we do not check for objPtr->typePtr == NULL. An invariant
+ * of a properly maintained Tcl_Obj is that at least one of
+ * objPtr->bytes and objPtr->typePtr must not be NULL. If broken
+ * extensions fail to maintain that invariant, we can crash here.
*/
- Tcl_Panic("UpdateStringProc should not be invoked for type %s",
- objPtr->typePtr->name);
- }
- objPtr->typePtr->updateStringProc(objPtr);
- if (objPtr->bytes == NULL || objPtr->length < 0
- || objPtr->bytes[objPtr->length] != '\0') {
- Tcl_Panic("UpdateStringProc for type '%s' "
- "failed to create a valid string rep", objPtr->typePtr->name);
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ /*
+ * Those Tcl_ObjTypes which choose not to define an
+ * updateStringProc must be written in such a way that
+ * (objPtr->bytes) never becomes NULL.
+ */
+ Tcl_Panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
+ }
+ objPtr->typePtr->updateStringProc(objPtr);
+ if (objPtr->bytes == NULL || objPtr->length < 0
+ || objPtr->bytes[objPtr->length] != '\0') {
+ Tcl_Panic("UpdateStringProc for type '%s' "
+ "failed to create a valid string rep",
+ objPtr->typePtr->name);
+ }
}
return objPtr->bytes;
}
@@ -1689,8 +1691,31 @@ Tcl_GetStringFromObj(
* rep's byte array length should * be stored.
* If NULL, no length is stored. */
{
- (void) TclGetString(objPtr);
+ if (objPtr->bytes == NULL) {
+ /*
+ * Note we do not check for objPtr->typePtr == NULL. An invariant
+ * of a properly maintained Tcl_Obj is that at least one of
+ * objPtr->bytes and objPtr->typePtr must not be NULL. If broken
+ * extensions fail to maintain that invariant, we can crash here.
+ */
+ if (objPtr->typePtr->updateStringProc == NULL) {
+ /*
+ * Those Tcl_ObjTypes which choose not to define an
+ * updateStringProc must be written in such a way that
+ * (objPtr->bytes) never becomes NULL.
+ */
+ Tcl_Panic("UpdateStringProc should not be invoked for type %s",
+ objPtr->typePtr->name);
+ }
+ objPtr->typePtr->updateStringProc(objPtr);
+ if (objPtr->bytes == NULL || objPtr->length < 0
+ || objPtr->bytes[objPtr->length] != '\0') {
+ Tcl_Panic("UpdateStringProc for type '%s' "
+ "failed to create a valid string rep",
+ objPtr->typePtr->name);
+ }
+ }
if (lengthPtr != NULL) {
*lengthPtr = objPtr->length;
}
@@ -1700,6 +1725,91 @@ Tcl_GetStringFromObj(
/*
*----------------------------------------------------------------------
*
+ * Tcl_InitStringRep --
+ *
+ * This function is called in several configurations to provide all
+ * the tools needed to set an object's string representation. The
+ * function is determined by the arguments.
+ *
+ * (objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0)
+ * Invalid call -- panic!
+ *
+ * objPtr->bytes == NULL && bytes == NULL && numBytes >= 0
+ * Allocation only - allocate space for (numBytes+1) chars.
+ * store in objPtr->bytes and return. Also sets
+ * objPtr->length to 0 and objPtr->bytes[0] to NUL.
+ *
+ * objPtr->bytes == NULL && bytes != NULL && numBytes >= 0
+ * Allocate and copy. bytes is assumed to point to chars to
+ * copy into the string rep. objPtr->length = numBytes. Allocate
+ * array of (numBytes + 1) chars. store in objPtr->bytes. Copy
+ * numBytes chars from bytes to objPtr->bytes; Set
+ * objPtr->bytes[numBytes] to NUL and return objPtr->bytes.
+ * Caller must guarantee there are numBytes chars at bytes to
+ * be copied.
+ *
+ * objPtr->bytes != NULL && bytes == NULL && numBytes >= 0
+ * Truncate. Set objPtr->length to numBytes and
+ * objPr->bytes[numBytes] to NUL. Caller has to guarantee
+ * that a prior allocating call allocated enough bytes for
+ * this to be valid. Return objPtr->bytes.
+ *
+ * Caller is expected to ascertain that the bytes copied into
+ * the string rep make up complete valid UTF-8 characters.
+ *
+ * Results:
+ * A pointer to the string rep of objPtr.
+ *
+ * Side effects:
+ * As described above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_InitStringRep(
+ Tcl_Obj *objPtr, /* Object whose string rep is to be set */
+ const char *bytes,
+ unsigned int numBytes)
+{
+ assert(objPtr->bytes == NULL || bytes == NULL);
+
+ if (numBytes > INT_MAX) {
+ Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+ }
+
+ /* Allocate */
+ if (objPtr->bytes == NULL) {
+ /* Allocate only as empty - extend later if bytes copied */
+ objPtr->length = 0;
+ if (numBytes) {
+ objPtr->bytes = attemptckalloc(numBytes + 1);
+ if (objPtr->bytes == NULL) {
+ return NULL;
+ }
+ if (bytes) {
+ /* Copy */
+ memcpy(objPtr->bytes, bytes, numBytes);
+ objPtr->length = (int) numBytes;
+ }
+ } else {
+ TclInitStringRep(objPtr, NULL, 0);
+ }
+ } else {
+ /* objPtr->bytes != NULL bytes == NULL - Truncate */
+ objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1);
+ objPtr->length = (int)numBytes;
+ }
+
+ /* Terminate */
+ objPtr->bytes[objPtr->length] = '\0';
+
+ return objPtr->bytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_InvalidateStringRep --
*
* This function is called to invalidate an object's string
@@ -1726,6 +1836,117 @@ Tcl_InvalidateStringRep(
/*
*----------------------------------------------------------------------
*
+ * Tcl_HasStringRep --
+ *
+ * This function reports whether object has a string representation.
+ *
+ * Results:
+ * Boolean.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_HasStringRep(
+ Tcl_Obj *objPtr) /* Object to test */
+{
+ return TclHasStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StoreIntRep --
+ *
+ * This function is called to set the object's internal
+ * representation to match a particular type.
+ *
+ * It is the caller's responsibility to guarantee that
+ * the value of the submitted IntRep is in agreement with
+ * the value of any existing string rep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ * Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_StoreIntRep(
+ Tcl_Obj *objPtr, /* Object whose internal rep should be set. */
+ const Tcl_ObjType *typePtr, /* New type for the object */
+ const Tcl_ObjIntRep *irPtr) /* New IntRep for the object */
+{
+ /* Clear out any existing IntRep ( "shimmer" ) */
+ TclFreeIntRep(objPtr);
+
+ /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
+ if (irPtr) {
+ /* Copy the new IntRep into place */
+ objPtr->internalRep = *irPtr;
+
+ /* Set the type to match */
+ objPtr->typePtr = typePtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FetchIntRep --
+ *
+ * This function is called to retrieve the object's internal
+ * representation matching a requested type, if any.
+ *
+ * Results:
+ * A read-only pointer to the associated Tcl_ObjIntRep, or
+ * NULL if no such internal representation exists.
+ *
+ * Side effects:
+ * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ * Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ObjIntRep *
+Tcl_FetchIntRep(
+ Tcl_Obj *objPtr, /* Object to fetch from. */
+ const Tcl_ObjType *typePtr) /* Requested type */
+{
+ return TclFetchIntRep(objPtr, typePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeIntRep --
+ *
+ * This function is called to free an object's internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ * Sets typePtr field to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeIntRep(
+ Tcl_Obj *objPtr) /* Object whose internal rep should be freed. */
+{
+ TclFreeIntRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_NewBooleanObj --
*
* This function is normally called when not debugging: i.e., when
@@ -1734,7 +1955,7 @@ Tcl_InvalidateStringRep(
* is coerced to 1.
*
* When TCL_MEM_DEBUG is defined, this function just returns the result
- * of calling the debugging version Tcl_DbNewBooleanObj.
+ * of calling the debugging version Tcl_DbNewLongObj.
*
* Results:
* The newly created object is returned. This object will have an invalid
@@ -1753,7 +1974,7 @@ Tcl_Obj *
Tcl_NewBooleanObj(
register int boolValue) /* Boolean used to initialize new object. */
{
- return Tcl_DbNewBooleanObj(boolValue, "unknown", 0);
+ return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
@@ -1764,7 +1985,7 @@ Tcl_NewBooleanObj(
{
register Tcl_Obj *objPtr;
- TclNewBooleanObj(objPtr, boolValue);
+ TclNewIntObj(objPtr, boolValue!=0);
return objPtr;
}
#endif /* TCL_MEM_DEBUG */
@@ -1795,6 +2016,7 @@ Tcl_NewBooleanObj(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_DbNewBooleanObj
#ifdef TCL_MEM_DEBUG
@@ -1809,9 +2031,10 @@ Tcl_DbNewBooleanObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
+ /* Optimized TclInvalidateStringRep() */
objPtr->bytes = NULL;
- objPtr->internalRep.longValue = (boolValue? 1 : 0);
+ objPtr->internalRep.wideValue = (boolValue != 0);
objPtr->typePtr = &tclIntType;
return objPtr;
}
@@ -1858,8 +2081,9 @@ Tcl_SetBooleanObj(
Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
}
- TclSetBooleanObj(objPtr, boolValue);
+ TclSetIntObj(objPtr, boolValue!=0);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1888,11 +2112,11 @@ Tcl_GetBooleanFromObj(
{
do {
if (objPtr->typePtr == &tclIntType) {
- *boolPtr = (objPtr->internalRep.longValue != 0);
+ *boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
}
if (objPtr->typePtr == &tclBooleanType) {
- *boolPtr = (int) objPtr->internalRep.longValue;
+ *boolPtr = objPtr->internalRep.longValue != 0;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
@@ -1916,12 +2140,6 @@ Tcl_GetBooleanFromObj(
*boolPtr = 1;
return TCL_OK;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- *boolPtr = (objPtr->internalRep.wideValue != 0);
- return TCL_OK;
- }
-#endif
} while ((ParseBoolean(objPtr) == TCL_OK) || (TCL_OK ==
TclParseNumber(interp, objPtr, "boolean value", NULL,-1,NULL,0)));
return TCL_ERROR;
@@ -1942,7 +2160,12 @@ Tcl_GetBooleanFromObj(
*
* Side effects:
* If no error occurs, an integer 1 or 0 is stored as "objPtr"s internal
- * representation and the type of "objPtr" is set to boolean.
+ * representation and the type of "objPtr" is set to boolean or int/wideInt.
+ *
+ * Warning: If the returned type is "wideInt" (32-bit platforms) and your
+ * platform is bigendian, you cannot use internalRep.longValue to distinguish
+ * between false and true. On Windows and most other platforms this still will
+ * work fine, but basically it is non-portable.
*
*----------------------------------------------------------------------
*/
@@ -1960,8 +2183,7 @@ TclSetBooleanFromAny(
if (objPtr->bytes == NULL) {
if (objPtr->typePtr == &tclIntType) {
- switch (objPtr->internalRep.longValue) {
- case 0L: case 1L:
+ if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
return TCL_OK;
}
goto badBoolean;
@@ -1971,12 +2193,6 @@ TclSetBooleanFromAny(
goto badBoolean;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- goto badBoolean;
- }
-#endif
-
if (objPtr->typePtr == &tclDoubleType) {
goto badBoolean;
}
@@ -2005,9 +2221,10 @@ static int
ParseBoolean(
register Tcl_Obj *objPtr) /* The object to parse/convert. */
{
- int i, length, newBool;
+ int newBool;
char lowerCase[6];
- const char *str = TclGetStringFromObj(objPtr, &length);
+ const char *str = TclGetString(objPtr);
+ size_t i, length = objPtr->length;
if ((length == 0) || (length > 5)) {
/*
@@ -2059,25 +2276,25 @@ ParseBoolean(
/*
* Checking the 'y' is redundant, but makes the code clearer.
*/
- if (strncmp(lowerCase, "yes", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "yes", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'n':
- if (strncmp(lowerCase, "no", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "no", length) == 0) {
newBool = 0;
goto goodBoolean;
}
return TCL_ERROR;
case 't':
- if (strncmp(lowerCase, "true", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "true", length) == 0) {
newBool = 1;
goto goodBoolean;
}
return TCL_ERROR;
case 'f':
- if (strncmp(lowerCase, "false", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "false", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2086,10 +2303,10 @@ ParseBoolean(
if (length < 2) {
return TCL_ERROR;
}
- if (strncmp(lowerCase, "on", (size_t) length) == 0) {
+ if (strncmp(lowerCase, "on", length) == 0) {
newBool = 1;
goto goodBoolean;
- } else if (strncmp(lowerCase, "off", (size_t) length) == 0) {
+ } else if (strncmp(lowerCase, "off", length) == 0) {
newBool = 0;
goto goodBoolean;
}
@@ -2112,7 +2329,7 @@ ParseBoolean(
numericBoolean:
TclFreeIntRep(objPtr);
- objPtr->internalRep.longValue = newBool;
+ objPtr->internalRep.wideValue = newBool;
objPtr->typePtr = &tclIntType;
return TCL_OK;
}
@@ -2201,6 +2418,7 @@ Tcl_DbNewDoubleObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
+ /* Optimized TclInvalidateStringRep() */
objPtr->bytes = NULL;
objPtr->internalRep.doubleValue = dblValue;
@@ -2293,7 +2511,7 @@ Tcl_GetDoubleFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
- *dblPtr = objPtr->internalRep.longValue;
+ *dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclBignumType) {
@@ -2303,12 +2521,6 @@ Tcl_GetDoubleFromObj(
*dblPtr = TclBignumToDouble(&big);
return TCL_OK;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- *dblPtr = (double) objPtr->internalRep.wideValue;
- return TCL_OK;
- }
-#endif
} while (SetDoubleFromAny(interp, objPtr) == TCL_OK);
return TCL_ERROR;
}
@@ -2367,15 +2579,12 @@ static void
UpdateStringOfDouble(
register Tcl_Obj *objPtr) /* Double obj with string rep to update. */
{
- char buffer[TCL_DOUBLE_SPACE];
- register int len;
+ char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);
- Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
- len = strlen(buffer);
+ TclOOM(dst, TCL_DOUBLE_SPACE + 1);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
- objPtr->length = len;
+ Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
+ (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
}
/*
@@ -2408,6 +2617,7 @@ UpdateStringOfDouble(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_NewIntObj
#ifdef TCL_MEM_DEBUG
@@ -2415,7 +2625,7 @@ Tcl_Obj *
Tcl_NewIntObj(
register int intValue) /* Int used to initialize the new object. */
{
- return Tcl_DbNewLongObj((long)intValue, "unknown", 0);
+ return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
@@ -2430,6 +2640,7 @@ Tcl_NewIntObj(
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -2448,7 +2659,7 @@ Tcl_NewIntObj(
*
*----------------------------------------------------------------------
*/
-
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_SetIntObj
void
Tcl_SetIntObj(
@@ -2461,32 +2672,30 @@ Tcl_SetIntObj(
TclSetIntObj(objPtr, intValue);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
*
* Tcl_GetIntFromObj --
*
- * Retrieve the integer value of 'objPtr'.
- *
- * Value
- *
- * TCL_OK
+ * Attempt 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.
*
- * Success.
- *
- * TCL_ERROR
- *
- * An error occurred during conversion or the integral value can not
- * be represented as an integer (it might be too large). An error
- * message is left in the interpreter's result if 'interp' is not
- * NULL.
+ * Integer and long integer objects share the same "integer" type
+ * implementation. We store all integers as longs and Tcl_GetIntFromObj
+ * checks whether the current value of the long can be represented by an
+ * int.
*
- * Effect
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion or if the long integer held by the object can not be
+ * represented by an int, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
*
- * 'objPtr' is converted to an integer if necessary if it is not one
- * already. The conversion frees any previously-existing internal
- * representation.
+ * Side effects:
+ * If the object is not already an int, the conversion will free any old
+ * internal representation.
*
*----------------------------------------------------------------------
*/
@@ -2505,7 +2714,7 @@ Tcl_GetIntFromObj(
if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
return TCL_ERROR;
}
- if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
+ if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) {
if (interp != NULL) {
const char *s =
"integer value too large to represent as non-long integer";
@@ -2540,9 +2749,8 @@ SetIntFromAny(
Tcl_Interp *interp, /* Tcl interpreter */
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
- long l;
-
- return TclGetLongFromObj(interp, objPtr, &l);
+ Tcl_WideInt w;
+ return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
/*
@@ -2568,15 +2776,25 @@ static void
UpdateStringOfInt(
register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
{
- char buffer[TCL_INTEGER_SPACE];
- register int len;
+ char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
+
+ TclOOM(dst, TCL_INTEGER_SPACE + 1);
+ (void) Tcl_InitStringRep(objPtr, NULL,
+ TclFormatInt(dst, objPtr->internalRep.wideValue));
+}
- len = TclFormatInt(buffer, objPtr->internalRep.longValue);
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
+static void
+UpdateStringOfOldInt(
+ register Tcl_Obj *objPtr) /* Int object whose string rep to update. */
+{
+ char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
- objPtr->length = len;
+ TclOOM(dst, TCL_INTEGER_SPACE + 1);
+ (void) Tcl_InitStringRep(objPtr, NULL,
+ TclFormatInt(dst, objPtr->internalRep.longValue));
}
+#endif
/*
*----------------------------------------------------------------------
@@ -2608,15 +2826,16 @@ UpdateStringOfInt(
*----------------------------------------------------------------------
*/
-#ifdef TCL_MEM_DEBUG
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_NewLongObj
+#ifdef TCL_MEM_DEBUG
Tcl_Obj *
Tcl_NewLongObj(
register long longValue) /* Long integer used to initialize the
* new object. */
{
- return Tcl_DbNewLongObj(longValue, "unknown", 0);
+ return Tcl_DbNewWideIntObj(longValue, "unknown", 0);
}
#else /* if not TCL_MEM_DEBUG */
@@ -2628,10 +2847,11 @@ Tcl_NewLongObj(
{
register Tcl_Obj *objPtr;
- TclNewLongObj(objPtr, longValue);
+ TclNewIntObj(objPtr, longValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -2665,6 +2885,8 @@ Tcl_NewLongObj(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
+#undef Tcl_DbNewLongObj
#ifdef TCL_MEM_DEBUG
Tcl_Obj *
@@ -2679,9 +2901,10 @@ Tcl_DbNewLongObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
+ /* Optimized TclInvalidateStringRep */
objPtr->bytes = NULL;
- objPtr->internalRep.longValue = longValue;
+ objPtr->internalRep.wideValue = longValue;
objPtr->typePtr = &tclIntType;
return objPtr;
}
@@ -2697,9 +2920,10 @@ Tcl_DbNewLongObj(
int line) /* Line number in the source file; used for
* debugging. */
{
- return Tcl_NewLongObj(longValue);
+ return Tcl_NewWideIntObj(longValue);
}
#endif /* TCL_MEM_DEBUG */
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -2719,6 +2943,8 @@ Tcl_DbNewLongObj(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
+#undef Tcl_SetLongObj
void
Tcl_SetLongObj(
register Tcl_Obj *objPtr, /* Object whose internal rep to init. */
@@ -2729,8 +2955,9 @@ Tcl_SetLongObj(
Tcl_Panic("%s called with shared object", "Tcl_SetLongObj");
}
- TclSetLongObj(objPtr, longValue);
+ TclSetIntObj(objPtr, longValue);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -2760,14 +2987,15 @@ Tcl_GetLongFromObj(
register long *longPtr) /* Place to store resulting long. */
{
do {
+#ifdef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclIntType) {
- *longPtr = objPtr->internalRep.longValue;
+ *longPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
+#else
+ if (objPtr->typePtr == &tclIntType) {
/*
- * We return any integer in the range -ULONG_MAX to ULONG_MAX
+ * We return any integer in the range LONG_MIN to ULONG_MAX
* converted to a long, ignoring overflow. The rule preserves
* existing semantics for conversion of integers on input, but
* avoids inadvertent demotion of wide integers to 32-bit ones in
@@ -2776,9 +3004,9 @@ Tcl_GetLongFromObj(
Tcl_WideInt w = objPtr->internalRep.wideValue;
- if (w >= -(Tcl_WideInt)(ULONG_MAX)
+ if (w >= (Tcl_WideInt)(LONG_MIN)
&& w <= (Tcl_WideInt)(ULONG_MAX)) {
- *longPtr = Tcl_WideAsLong(w);
+ *longPtr = (long) w;
return TCL_OK;
}
goto tooLarge;
@@ -2804,10 +3032,9 @@ Tcl_GetLongFromObj(
mp_int big;
UNPACK_BIGNUM(objPtr, big);
- if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
+ if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1)
/ DIGIT_BIT) {
- unsigned long value = 0, numBytes = sizeof(long);
- long scratch;
+ unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
unsigned char *bytes = (unsigned char *) &scratch;
if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
@@ -2815,11 +3042,16 @@ Tcl_GetLongFromObj(
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
- *longPtr = - (long) value;
+ if (value <= 1 + (unsigned long)LONG_MAX) {
+ *longPtr = - (long) value;
+ return TCL_OK;
+ }
} else {
- *longPtr = (long) value;
+ if (value <= (unsigned long)ULONG_MAX) {
+ *longPtr = (long) value;
+ return TCL_OK;
+ }
}
- return TCL_OK;
}
}
#ifndef TCL_WIDE_INT_IS_LONG
@@ -2838,49 +3070,6 @@ Tcl_GetLongFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
-#ifndef TCL_WIDE_INT_IS_LONG
-
-/*
- *----------------------------------------------------------------------
- *
- * UpdateStringOfWideInt --
- *
- * Update the string representation for a wide integer object. Note: this
- * function 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.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-UpdateStringOfWideInt(
- 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;
-
- /*
- * Note that sprintf will generate a compiler warning under Mingw claiming
- * %I64 is an unknown format specifier. Just ignore this warning. We can't
- * use %L as the format specifier since that gets printed as a 32 bit
- * value.
- */
-
- sprintf(buffer, "%" TCL_LL_MODIFIER "d", wideVal);
- len = strlen(buffer);
- objPtr->bytes = ckalloc(len + 1);
- memcpy(objPtr->bytes, buffer, len + 1);
- objPtr->length = len;
-}
-#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -2930,7 +3119,7 @@ Tcl_NewWideIntObj(
register Tcl_Obj *objPtr;
TclNewObj(objPtr);
- Tcl_SetWideIntObj(objPtr, wideValue);
+ TclSetIntObj(objPtr, wideValue);
return objPtr;
}
#endif /* if TCL_MEM_DEBUG */
@@ -2982,7 +3171,7 @@ Tcl_DbNewWideIntObj(
register Tcl_Obj *objPtr;
TclDbNewObj(objPtr, file, line);
- Tcl_SetWideIntObj(objPtr, wideValue);
+ TclSetIntObj(objPtr, wideValue);
return objPtr;
}
@@ -3031,19 +3220,7 @@ Tcl_SetWideIntObj(
Tcl_Panic("%s called with shared object", "Tcl_SetWideIntObj");
}
- if ((wideValue >= (Tcl_WideInt) LONG_MIN)
- && (wideValue <= (Tcl_WideInt) LONG_MAX)) {
- TclSetLongObj(objPtr, (long) wideValue);
- } else {
-#ifndef TCL_WIDE_INT_IS_LONG
- TclSetWideIntObj(objPtr, wideValue);
-#else
- mp_int big;
-
- TclBNInitBignumFromWideInt(&big, wideValue);
- Tcl_SetBignumObj(objPtr, &big);
-#endif
- }
+ TclSetIntObj(objPtr, wideValue);
}
/*
@@ -3075,14 +3252,8 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- *wideIntPtr = objPtr->internalRep.wideValue;
- return TCL_OK;
- }
-#endif
if (objPtr->typePtr == &tclIntType) {
- *wideIntPtr = (Tcl_WideInt) objPtr->internalRep.longValue;
+ *wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclDoubleType) {
@@ -3115,11 +3286,16 @@ Tcl_GetWideIntFromObj(
value = (value << CHAR_BIT) | *bytes++;
}
if (big.sign) {
- *wideIntPtr = - (Tcl_WideInt) value;
+ if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
+ *wideIntPtr = - (Tcl_WideInt) value;
+ return TCL_OK;
+ }
} else {
- *wideIntPtr = (Tcl_WideInt) value;
+ if (value <= (Tcl_WideUInt)WIDE_MAX) {
+ *wideIntPtr = (Tcl_WideInt) value;
+ return TCL_OK;
+ }
}
- return TCL_OK;
}
}
if (interp != NULL) {
@@ -3135,33 +3311,70 @@ Tcl_GetWideIntFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
-#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
*
- * SetWideIntFromAny --
+ * TclGetWideBitsFromObj --
*
- * Attempts to force the internal representation for a Tcl object to
- * tclWideIntType, specifically.
+ * Attempt to return a wide integer from the Tcl object "objPtr". If the
+ * object is not already a int, double or bignum, an attempt will be made
+ * to convert it to one of these. Out-of-range values don't result in an
+ * error, but only the least significant 64 bits will be returned.
*
* Results:
- * The return value is a standard object Tcl result. If an error occurs
+ * 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, double or bignum object, the
+ * conversion will free any old internal representation.
+ *
*----------------------------------------------------------------------
*/
-static int
-SetWideIntFromAny(
- Tcl_Interp *interp, /* Tcl interpreter */
- Tcl_Obj *objPtr) /* Pointer to the object to convert */
+int
+TclGetWideBitsFromObj(
+ Tcl_Interp *interp, /* Used for error reporting if not NULL. */
+ Tcl_Obj *objPtr, /* Object from which to get a wide int. */
+ Tcl_WideInt *wideIntPtr) /* Place to store resulting wide integer. */
{
- Tcl_WideInt w;
- return Tcl_GetWideIntFromObj(interp, objPtr, &w);
+ do {
+ if (objPtr->typePtr == &tclIntType) {
+ *wideIntPtr = objPtr->internalRep.wideValue;
+ return TCL_OK;
+ }
+ if (objPtr->typePtr == &tclDoubleType) {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ TclGetString(objPtr)));
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (objPtr->typePtr == &tclBignumType) {
+ mp_int big;
+
+ Tcl_WideUInt value = 0, scratch;
+ unsigned long numBytes = sizeof(Tcl_WideInt);
+ unsigned char *bytes = (unsigned char *) &scratch;
+
+ Tcl_GetBignumFromObj(NULL, objPtr, &big);
+ mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
+ mp_to_unsigned_bin_n(&big, bytes, &numBytes);
+ while (numBytes-- > 0) {
+ value = (value << CHAR_BIT) | *bytes++;
+ }
+ *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
+ mp_clear(&big);
+ return TCL_OK;
+ }
+ } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+ TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+ return TCL_ERROR;
}
-#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -3248,12 +3461,10 @@ UpdateStringOfBignum(
{
mp_int bignumVal;
int size;
- int status;
char *stringVal;
UNPACK_BIGNUM(objPtr, bignumVal);
- status = mp_radix_size(&bignumVal, 10, &size);
- if (status != MP_OKAY) {
+ if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
Tcl_Panic("radix size failure in UpdateStringOfBignum");
}
if (size < 2) {
@@ -3268,13 +3479,14 @@ UpdateStringOfBignum(
Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
}
- stringVal = ckalloc(size);
- status = mp_toradix_n(&bignumVal, stringVal, 10, size);
- if (status != MP_OKAY) {
+
+ stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1);
+
+ TclOOM(stringVal, size);
+ if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) {
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
- objPtr->bytes = stringVal;
- objPtr->length = size - 1; /* size includes a trailing NUL byte. */
+ (void) Tcl_InitStringRep(objPtr, NULL, size - 1);
}
/*
@@ -3394,26 +3606,26 @@ GetBignumFromObj(
mp_init_copy(bignumValue, &temp);
} else {
UNPACK_BIGNUM(objPtr, *bignumValue);
+ /* Optimized TclFreeIntRep */
objPtr->internalRep.twoPtrValue.ptr1 = NULL;
objPtr->internalRep.twoPtrValue.ptr2 = NULL;
objPtr->typePtr = NULL;
+ /*
+ * TODO: If objPtr has a string rep, this leaves
+ * it undisturbed. Not clear that's proper. Pure
+ * bignum values are converted to empty string.
+ */
if (objPtr->bytes == NULL) {
- TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ TclInitStringRep(objPtr, NULL, 0);
}
}
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
- TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
- return TCL_OK;
- }
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- TclBNInitBignumFromWideInt(bignumValue,
+ TclInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
return TCL_OK;
}
-#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3523,36 +3735,11 @@ Tcl_SetBignumObj(
Tcl_Panic("%s called with shared object", "Tcl_SetBignumObj");
}
if ((size_t) bignumValue->used
- <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) {
- unsigned long value = 0, numBytes = sizeof(long);
- long scratch;
- unsigned char *bytes = (unsigned char *) &scratch;
-
- if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
- goto tooLargeForLong;
- }
- while (numBytes-- > 0) {
- value = (value << CHAR_BIT) | *bytes++;
- }
- if (value > (((~(unsigned long)0) >> 1) + bignumValue->sign)) {
- goto tooLargeForLong;
- }
- if (bignumValue->sign) {
- TclSetLongObj(objPtr, -(long)value);
- } else {
- TclSetLongObj(objPtr, (long)value);
- }
- mp_clear(bignumValue);
- return;
- }
- tooLargeForLong:
-#ifndef TCL_WIDE_INT_IS_LONG
- if ((size_t) bignumValue->used
- <= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
+ <= (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
Tcl_WideUInt value = 0;
- unsigned long numBytes = sizeof(Tcl_WideInt);
- Tcl_WideInt scratch;
- unsigned char *bytes = (unsigned char *)&scratch;
+ unsigned long numBytes = sizeof(Tcl_WideUInt);
+ Tcl_WideUInt scratch;
+ unsigned char *bytes = (unsigned char *) &scratch;
if (mp_to_unsigned_bin_n(bignumValue, bytes, &numBytes) != MP_OKAY) {
goto tooLargeForWide;
@@ -3560,19 +3747,18 @@ Tcl_SetBignumObj(
while (numBytes-- > 0) {
value = (value << CHAR_BIT) | *bytes++;
}
- if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
+ if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
goto tooLargeForWide;
}
if (bignumValue->sign) {
- TclSetWideIntObj(objPtr, -(Tcl_WideInt)value);
+ TclSetIntObj(objPtr, -(Tcl_WideInt)value);
} else {
- TclSetWideIntObj(objPtr, (Tcl_WideInt)value);
+ TclSetIntObj(objPtr, (Tcl_WideInt)value);
}
mp_clear(bignumValue);
return;
}
tooLargeForWide:
-#endif
TclInvalidateStringRep(objPtr);
TclFreeIntRep(objPtr);
TclSetBignumIntRep(objPtr, bignumValue);
@@ -3654,17 +3840,10 @@ TclGetNumberFromObj(
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
- *typePtr = TCL_NUMBER_LONG;
- *clientDataPtr = &objPtr->internalRep.longValue;
- return TCL_OK;
- }
-#ifndef TCL_WIDE_INT_IS_LONG
- if (objPtr->typePtr == &tclWideIntType) {
- *typePtr = TCL_NUMBER_WIDE;
+ *typePtr = TCL_NUMBER_INT;
*clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
-#endif
if (objPtr->typePtr == &tclBignumType) {
static Tcl_ThreadDataKey bignumKey;
mp_int *bigPtr = Tcl_GetThreadData(&bignumKey,
@@ -3683,6 +3862,71 @@ TclGetNumberFromObj(
/*
*----------------------------------------------------------------------
*
+ * Tcl_IncrRefCount --
+ *
+ * Increments the reference count of the object.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_IncrRefCount
+void
+Tcl_IncrRefCount(
+ Tcl_Obj *objPtr) /* The object we are registering a reference to. */
+{
+ ++(objPtr)->refCount;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DecrRefCount --
+ *
+ * Decrements the reference count of the object.
+ *
+ * Results:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_DecrRefCount
+void
+Tcl_DecrRefCount(
+ Tcl_Obj *objPtr) /* The object we are releasing a reference to. */
+{
+ if (objPtr->refCount-- <= 1) {
+ TclFreeObj(objPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_IsShared --
+ *
+ * Tests if the object has a ref count greater than one.
+ *
+ * Results:
+ * Boolean value that is the result of the test.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#undef Tcl_IsShared
+int
+Tcl_IsShared(
+ Tcl_Obj *objPtr) /* The object to test for being shared. */
+{
+ return ((objPtr)->refCount > 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* Tcl_DbIncrRefCount --
*
* This function is normally called when debugging: i.e., when
@@ -3717,7 +3961,7 @@ Tcl_DbIncrRefCount(
Tcl_Panic("incrementing refCount of previously disposed object");
}
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3780,7 +4024,7 @@ Tcl_DbDecrRefCount(
Tcl_Panic("decrementing refCount of previously disposed object");
}
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -3845,7 +4089,7 @@ Tcl_DbIsShared(
Tcl_Panic("checking whether previously disposed object is shared");
}
-# ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Check to make sure that the Tcl_Obj was allocated by the current
* thread. Don't do this check when shutting down since thread local
@@ -4049,7 +4293,7 @@ TclFreeObjEntry(
*----------------------------------------------------------------------
*/
-unsigned int
+TCL_HASH_TYPE
TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
@@ -4099,7 +4343,7 @@ TclHashObjKey(
result += (result << 3) + UCHAR(*++string);
}
}
- return result;
+ return (TCL_HASH_TYPE) result;
}
/*
@@ -4153,11 +4397,10 @@ Tcl_GetCommandFromObj(
*/
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
+ if (objPtr->typePtr == &tclCmdNameType) {
register Command *cmdPtr = resPtr->cmdPtr;
if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
- && !(cmdPtr->flags & CMD_IS_DELETED)
&& (interp == cmdPtr->nsPtr->interp)
&& !(cmdPtr->nsPtr->flags & NS_DYING)) {
register Namespace *refNsPtr = (Namespace *)
@@ -4177,7 +4420,7 @@ Tcl_GetCommandFromObj(
* had is invalid one way or another.
*/
- /* See [] why we cannot call SetCmdNameFromAny() directly here. */
+ /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
return NULL;
}
@@ -4205,6 +4448,59 @@ Tcl_GetCommandFromObj(
*----------------------------------------------------------------------
*/
+static void
+SetCmdNameObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Command *cmdPtr,
+ ResolvedCmdName *resPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ ResolvedCmdName *fillPtr;
+ const char *name = TclGetString(objPtr);
+
+ if (resPtr) {
+ fillPtr = resPtr;
+ } else {
+ fillPtr = ckalloc(sizeof(ResolvedCmdName));
+ fillPtr->refCount = 1;
+ }
+
+ fillPtr->cmdPtr = cmdPtr;
+ cmdPtr->refCount++;
+ fillPtr->cmdEpoch = cmdPtr->cmdEpoch;
+
+ /* NOTE: relying on NULL termination here. */
+ if ((name[0] == ':') && (name[1] == ':')) {
+ /*
+ * Fully qualified names always resolve to same thing. No need
+ * to record resolution context information.
+ */
+
+ fillPtr->refNsPtr = NULL;
+ fillPtr->refNsId = 0; /* Will not be read */
+ fillPtr->refNsCmdEpoch = 0; /* Will not be read */
+ } else {
+ /*
+ * Record current state of current namespace as the resolution
+ * context of this command name lookup.
+ */
+ Namespace *currNsPtr = iPtr->varFramePtr->nsPtr;
+
+ fillPtr->refNsPtr = currNsPtr;
+ fillPtr->refNsId = currNsPtr->nsId;
+ fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ }
+
+ if (resPtr == NULL) {
+ TclFreeIntRep(objPtr);
+
+ objPtr->internalRep.twoPtrValue.ptr1 = fillPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
+ }
+}
+
void
TclSetCmdNameObj(
Tcl_Interp *interp, /* Points to interpreter containing command
@@ -4214,10 +4510,7 @@ TclSetCmdNameObj(
Command *cmdPtr) /* Points to Command structure that the
* CmdName object should refer to. */
{
- Interp *iPtr = (Interp *) interp;
register ResolvedCmdName *resPtr;
- register Namespace *currNsPtr;
- const char *name;
if (objPtr->typePtr == &tclCmdNameType) {
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
@@ -4226,36 +4519,7 @@ TclSetCmdNameObj(
}
}
- cmdPtr->refCount++;
- resPtr = ckalloc(sizeof(ResolvedCmdName));
- resPtr->cmdPtr = cmdPtr;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- resPtr->refCount = 1;
-
- name = TclGetString(objPtr);
- if ((*name++ == ':') && (*name == ':')) {
- /*
- * The name is fully qualified: set the referring namespace to
- * NULL.
- */
-
- resPtr->refNsPtr = NULL;
- } else {
- /*
- * Get the current namespace.
- */
-
- currNsPtr = iPtr->varFramePtr->nsPtr;
-
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
- }
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
+ SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
}
/*
@@ -4286,13 +4550,12 @@ FreeCmdNameInternalRep(
{
register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if (resPtr != NULL) {
/*
* Decrement the reference count of the ResolvedCmdName structure. If
* there are no more uses, free the ResolvedCmdName structure.
*/
- if (resPtr->refCount-- == 1) {
+ if (resPtr->refCount-- <= 1) {
/*
* Now free the cached command, unless it is still in its hash
* table or if there are other references to it from other cmdName
@@ -4304,7 +4567,6 @@ FreeCmdNameInternalRep(
TclCleanupCommandMacro(cmdPtr);
ckfree(resPtr);
}
- }
objPtr->typePtr = NULL;
}
@@ -4337,9 +4599,7 @@ DupCmdNameInternalRep(
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- if (resPtr != NULL) {
resPtr->refCount++;
- }
copyPtr->typePtr = &tclCmdNameType;
}
@@ -4369,10 +4629,8 @@ SetCmdNameFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
- Interp *iPtr = (Interp *) interp;
const char *name;
register Command *cmdPtr;
- Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
if (interp == NULL) {
@@ -4392,59 +4650,31 @@ SetCmdNameFromAny(
Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
/*
- * Free the old internalRep before setting the new one. Do this after
- * getting the string rep to allow the conversion code (in particular,
- * Tcl_GetStringFromObj) to use that old internalRep.
+ * Stop shimmering and caching nothing when we found nothing. Just
+ * report the failure to find the command as an error.
*/
- if (cmdPtr) {
- cmdPtr->refCount++;
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((objPtr->typePtr == &tclCmdNameType)
- && resPtr && (resPtr->refCount == 1)) {
- /*
- * Reuse the old ResolvedCmdName struct instead of freeing it
- */
-
- Command *oldCmdPtr = resPtr->cmdPtr;
-
- if (--oldCmdPtr->refCount == 0) {
- TclCleanupCommandMacro(oldCmdPtr);
- }
- } else {
- TclFreeIntRep(objPtr);
- resPtr = ckalloc(sizeof(ResolvedCmdName));
- resPtr->refCount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
- }
- resPtr->cmdPtr = cmdPtr;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- if ((*name++ == ':') && (*name == ':')) {
- /*
- * The name is fully qualified: set the referring namespace to
- * NULL.
- */
+ if (cmdPtr == NULL) {
+ return TCL_ERROR;
+ }
- resPtr->refNsPtr = NULL;
- } else {
- /*
- * Get the current namespace.
- */
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {
+ /*
+ * Re-use existing ResolvedCmdName struct when possible.
+ * Cleanup the old fields that need it.
+ */
- currNsPtr = iPtr->varFramePtr->nsPtr;
+ Command *oldCmdPtr = resPtr->cmdPtr;
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ if (oldCmdPtr->refCount-- <= 1) {
+ TclCleanupCommandMacro(oldCmdPtr);
}
} else {
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = NULL;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
+ resPtr = NULL;
}
+
+ SetCmdNameObj(interp, objPtr, cmdPtr, resPtr);
return TCL_OK;
}
@@ -4471,7 +4701,6 @@ Tcl_RepresentationCmd(
int objc,
Tcl_Obj *const objv[])
{
- char ptrBuffer[2*TCL_INTEGER_SPACE+6];
Tcl_Obj *descObj;
if (objc != 2) {
@@ -4485,36 +4714,20 @@ Tcl_RepresentationCmd(
* "1872361827361287"
*/
- sprintf(ptrBuffer, "%p", (void *) objv[1]);
descObj = Tcl_ObjPrintf("value is a %s with a refcount of %d,"
- " object pointer at %s",
- objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
- objv[1]->refCount, ptrBuffer);
-
- /*
- * This is a workaround to silence reports from `make valgrind`
- * on 64-bit systems. The problem is that the test suite
- * includes calling the [represenation] command on values of
- * &tclDoubleType. When these values are created, the "doubleValue"
- * is set, but when the "twoPtrValue" is examined, its "ptr2"
- * field has never been initialized. Since [representation]
- * presents the value of the ptr2 value in its output, valgrind
- * alerts about the read of uninitialized memory.
- *
- * The general problem with [representation], that it can read
- * and report uninitialized fields, is still present. This is
- * just the minimal workaround to silence one particular test.
- */
+ " object pointer at %p",
+ objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+ objv[1]->refCount, objv[1]);
- if ((sizeof(void *) > 4) && objv[1]->typePtr == &tclDoubleType) {
- objv[1]->internalRep.twoPtrValue.ptr2 = NULL;
- }
if (objv[1]->typePtr) {
- sprintf(ptrBuffer, "%p:%p",
- (void *) objv[1]->internalRep.twoPtrValue.ptr1,
- (void *) objv[1]->internalRep.twoPtrValue.ptr2);
- Tcl_AppendPrintfToObj(descObj, ", internal representation %s",
- ptrBuffer);
+ if (objv[1]->typePtr == &tclDoubleType) {
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
+ objv[1]->internalRep.doubleValue);
+ } else {
+ Tcl_AppendPrintfToObj(descObj, ", internal representation %p:%p",
+ (void *) objv[1]->internalRep.twoPtrValue.ptr1,
+ (void *) objv[1]->internalRep.twoPtrValue.ptr2);
+ }
}
if (objv[1]->bytes) {
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index 827d89d..8267a7d 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -233,7 +233,7 @@ ConvertZeroEffectToNOP(
TclGetUInt1AtPtr(currentInstPtr + 1));
int numBytes;
- (void) Tcl_GetStringFromObj(litPtr, &numBytes);
+ (void) TclGetStringFromObj(litPtr, &numBytes);
if (numBytes == 0) {
blank = size + InstLength(nextInst);
}
@@ -248,7 +248,7 @@ ConvertZeroEffectToNOP(
TclGetUInt4AtPtr(currentInstPtr + 1));
int numBytes;
- (void) Tcl_GetStringFromObj(litPtr, &numBytes);
+ (void) TclGetStringFromObj(litPtr, &numBytes);
if (numBytes == 0) {
blank = size + InstLength(nextInst);
}
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index b03ad41..e8c1e7f 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -23,8 +23,8 @@
* procedure.
*/
-#if defined(__CYGWIN__)
-static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
+#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
+static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
@@ -58,6 +58,7 @@ Tcl_SetPanicProc(
else
#endif
panicProc = proc;
+ TclInitSubsystems();
}
/*
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 74b02ce..a31d099 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -19,12 +19,7 @@
/*
* The following table provides parsing information about each possible 8-bit
- * character. The table is designed to be referenced with either signed or
- * unsigned characters, so it has 384 entries. The first 128 entries
- * correspond to negative character values, the next 256 correspond to
- * positive character values. The last 128 entries are identical to the first
- * 128. The table is always indexed with a 128-byte offset (the 128th entry
- * corresponds to a character value of 0).
+ * character. The table is designed to be referenced with unsigned characters.
*
* The macro CHAR_TYPE is used to index into the table and return information
* about its character argument. The following return values are defined.
@@ -44,42 +39,6 @@
*/
const char tclCharTypeTable[] = {
- /*
- * Negative character values, from -128 to -1:
- */
-
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
- TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL, TYPE_NORMAL,
/*
* Positive character values, from 0-127:
@@ -167,6 +126,8 @@ static int ParseTokens(const char *src, int numBytes, int mask,
int flags, Tcl_Parse *parsePtr);
static int ParseWhiteSpace(const char *src, int numBytes,
int *incompletePtr, char *typePtr);
+static int ParseAllWhiteSpace(const char *src, int numBytes,
+ int *incompletePtr);
/*
*----------------------------------------------------------------------
@@ -298,9 +259,43 @@ Tcl_ParseCommand(
*/
parsePtr->commandStart = src;
+ type = CHAR_TYPE(*src);
+ scanned = 1; /* Can't have missing whitepsace before first word. */
while (1) {
int expandWord = 0;
+ /* Are we at command termination? */
+
+ if ((numBytes == 0) || (type & terminators) != 0) {
+ parsePtr->term = src;
+ parsePtr->commandSize = src + (numBytes != 0)
+ - parsePtr->commandStart;
+ return TCL_OK;
+ }
+
+ /* Are we missing white space after previous word? */
+
+ if (scanned == 0) {
+ if (src[-1] == '"') {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-quote", -1));
+ }
+ parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
+ } else {
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "extra characters after close-brace", -1));
+ }
+ parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
+ }
+ parsePtr->term = src;
+ error:
+ Tcl_FreeParse(parsePtr);
+ parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
+ return TCL_ERROR;
+ }
+
/*
* Create the token for the word.
*/
@@ -310,23 +305,6 @@ Tcl_ParseCommand(
tokenPtr = &parsePtr->tokenPtr[wordIndex];
tokenPtr->type = TCL_TOKEN_WORD;
- /*
- * Skip white space before the word. Also skip a backslash-newline
- * sequence: it should be treated just like white space.
- */
-
- scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
- src += scanned;
- numBytes -= scanned;
- if (numBytes == 0) {
- parsePtr->term = src;
- break;
- }
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
- break;
- }
tokenPtr->start = src;
parsePtr->numTokens++;
parsePtr->numWords++;
@@ -546,52 +524,12 @@ Tcl_ParseCommand(
tokenPtr->type = TCL_TOKEN_SIMPLE_WORD;
}
- /*
- * Do two additional checks: (a) make sure we're really at the end of
- * a word (there might have been garbage left after a quoted or braced
- * word), and (b) check for the end of the command.
- */
+ /* Parse the whitespace between words. */
scanned = ParseWhiteSpace(src,numBytes, &parsePtr->incomplete, &type);
- if (scanned) {
- src += scanned;
- numBytes -= scanned;
- continue;
- }
-
- if (numBytes == 0) {
- parsePtr->term = src;
- break;
- }
- if ((type & terminators) != 0) {
- parsePtr->term = src;
- src++;
- break;
- }
- if (src[-1] == '"') {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "extra characters after close-quote", -1));
- }
- parsePtr->errorType = TCL_PARSE_QUOTE_EXTRA;
- } else {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "extra characters after close-brace", -1));
- }
- parsePtr->errorType = TCL_PARSE_BRACE_EXTRA;
- }
- parsePtr->term = src;
- goto error;
+ src += scanned;
+ numBytes -= scanned;
}
-
- parsePtr->commandSize = src - parsePtr->commandStart;
- return TCL_OK;
-
- error:
- Tcl_FreeParse(parsePtr);
- parsePtr->commandSize = parsePtr->end - parsePtr->commandStart;
- return TCL_ERROR;
}
/*
@@ -733,23 +671,32 @@ ParseWhiteSpace(
*----------------------------------------------------------------------
*/
-int
-TclParseAllWhiteSpace(
+static int
+ParseAllWhiteSpace(
const char *src, /* First character to parse. */
- int numBytes) /* Max number of byes to scan */
+ int numBytes, /* Max number of byes to scan */
+ int *incompletePtr) /* Set true if parse is incomplete. */
{
- int dummy;
char type;
const char *p = src;
do {
- int scanned = ParseWhiteSpace(p, numBytes, &dummy, &type);
+ int scanned = ParseWhiteSpace(p, numBytes, incompletePtr, &type);
p += scanned;
numBytes -= scanned;
} while (numBytes && (*p == '\n') && (p++, --numBytes));
return (p-src);
}
+
+int
+TclParseAllWhiteSpace(
+ const char *src, /* First character to parse. */
+ int numBytes) /* Max number of byes to scan */
+{
+ int dummy;
+ return ParseAllWhiteSpace(src, numBytes, &dummy);
+}
/*
*----------------------------------------------------------------------
@@ -902,7 +849,7 @@ TclParseBackslash(
count += TclParseHex(p+1, (numBytes > 3) ? 2 : numBytes-2, &result);
if (count == 2) {
/*
- * No hexadigits -> This is just "x".
+ * No hexdigits -> This is just "x".
*/
result = 'x';
@@ -917,7 +864,7 @@ TclParseBackslash(
count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-2, &result);
if (count == 2) {
/*
- * No hexadigits -> This is just "u".
+ * No hexdigits -> This is just "u".
*/
result = 'u';
}
@@ -926,7 +873,7 @@ TclParseBackslash(
count += TclParseHex(p+1, (numBytes > 9) ? 8 : numBytes-2, &result);
if (count == 2) {
/*
- * No hexadigits -> This is just "U".
+ * No hexdigits -> This is just "U".
*/
result = 'U';
}
@@ -992,11 +939,10 @@ TclParseBackslash(
*readPtr = count;
}
count = Tcl_UniCharToUtf(result, dst);
-#if TCL_UTF_MAX > 3
if (!count) {
+ /* Special case for handling high surrogates. */
count = Tcl_UniCharToUtf(-1, dst);
}
-#endif
return count;
}
@@ -1027,17 +973,12 @@ ParseComment(
* command. */
{
register const char *p = src;
+ int incomplete = parsePtr->incomplete;
while (numBytes) {
- char type;
- int scanned;
-
- do {
- scanned = ParseWhiteSpace(p, numBytes,
- &parsePtr->incomplete, &type);
- p += scanned;
- numBytes -= scanned;
- } while (numBytes && (*p == '\n') && (p++,numBytes--));
+ int scanned = ParseAllWhiteSpace(p, numBytes, &incomplete);
+ p += scanned;
+ numBytes -= scanned;
if ((numBytes == 0) || (*p != '#')) {
break;
@@ -1046,35 +987,28 @@ ParseComment(
parsePtr->commentStart = p;
}
+ p++;
+ numBytes--;
while (numBytes) {
+ if (*p == '\n') {
+ p++;
+ numBytes--;
+ break;
+ }
if (*p == '\\') {
- scanned = ParseWhiteSpace(p, numBytes, &parsePtr->incomplete,
- &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') {
+ if (numBytes == 0) {
break;
}
}
+ incomplete = (*p == '\n');
+ p++;
+ numBytes--;
}
parsePtr->commentSize = p - parsePtr->commentStart;
}
+ parsePtr->incomplete = incomplete;
return (p - src);
}
@@ -2253,7 +2187,7 @@ TclSubstTokens(
if (result == 0) {
clPos = 0;
} else {
- Tcl_GetStringFromObj(result, &clPos);
+ TclGetStringFromObj(result, &clPos);
}
if (numCL >= maxNumCL) {
@@ -2529,7 +2463,7 @@ TclObjCommandComplete(
* check. */
{
int length;
- const char *script = Tcl_GetStringFromObj(objPtr, &length);
+ const char *script = TclGetStringFromObj(objPtr, &length);
return CommandComplete(script, length);
}
diff --git a/generic/tclParse.h b/generic/tclParse.h
index 9247602..5f75c9a 100644
--- a/generic/tclParse.h
+++ b/generic/tclParse.h
@@ -12,6 +12,6 @@
#define TYPE_CLOSE_BRACK 0x20
#define TYPE_BRACE 0x40
-#define CHAR_TYPE(c) (tclCharTypeTable+128)[(unsigned char)(c)]
+#define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]
MODULE_SCOPE const char tclCharTypeTable[];
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index a2a41e4..0532b98 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -36,7 +36,7 @@ static int MakePathFromNormalized(Tcl_Interp *interp,
* internally.
*/
-static const Tcl_ObjType tclFsPathType = {
+static const Tcl_ObjType fsPathType = {
"path", /* name */
FreeFsPathInternalRep, /* freeIntRepProc */
DupFsPathInternalRep, /* dupIntRepProc */
@@ -51,19 +51,14 @@ static const Tcl_ObjType tclFsPathType = {
* represent relative or absolute paths, and has certain optimisations when
* used to represent paths which are already normalized and absolute.
*
- * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular
- * reference to the container Tcl_Obj of this FsPath.
- *
* There are two cases, with the first being the most common:
*
* (i) flags == 0, => Ordinary path.
*
- * translatedPathPtr contains the translated path (which may be a circular
- * reference to the object itself). If it is NULL then the path is pure
- * normalized (and the normPathPtr will be a circular reference). cwdPtr is
- * null for an absolute path, and non-null for a relative path (unless the cwd
- * has never been set, in which case the cwdPtr may also be null for a
- * relative path).
+ * translatedPathPtr contains the translated path. If it is NULL then the path
+ * is pure normalized. cwdPtr is null for an absolute path, and non-null for a
+ * relative path (unless the cwd has never been set, in which case the cwdPtr
+ * may also be null for a relative path).
*
* (ii) flags != 0, => Special path, see TclNewFSPathObj
*
@@ -79,11 +74,7 @@ typedef struct FsPath {
* 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. */
+ * ~user sequences. */
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. */
@@ -110,9 +101,14 @@ typedef struct FsPath {
* fields.
*/
-#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
+#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
#define SETPATHOBJ(pathPtr,fsPathPtr) \
- ((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (void *) (fsPathPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((pathPtr), &fsPathType, &ir); \
+ } while (0)
#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
/*
@@ -232,7 +228,7 @@ TclFSNormalizeAbsolutePath(
retVal = Tcl_NewStringObj(path, dirSep - path);
Tcl_IncrRefCount(retVal);
}
- Tcl_GetStringFromObj(retVal, &curLen);
+ TclGetStringFromObj(retVal, &curLen);
if (curLen == 0) {
Tcl_AppendToObj(retVal, dirSep, 1);
}
@@ -258,7 +254,7 @@ TclFSNormalizeAbsolutePath(
retVal = Tcl_NewStringObj(path, dirSep - path);
Tcl_IncrRefCount(retVal);
}
- Tcl_GetStringFromObj(retVal, &curLen);
+ TclGetStringFromObj(retVal, &curLen);
if (curLen == 0) {
Tcl_AppendToObj(retVal, dirSep, 1);
}
@@ -289,7 +285,7 @@ TclFSNormalizeAbsolutePath(
*/
const char *path =
- Tcl_GetStringFromObj(retVal, &curLen);
+ TclGetStringFromObj(retVal, &curLen);
while (--curLen >= 0) {
if (IsSeparatorOrNull(path[curLen])) {
@@ -304,7 +300,7 @@ TclFSNormalizeAbsolutePath(
Tcl_SetObjLength(retVal, curLen+1);
Tcl_AppendObjToObj(retVal, linkObj);
TclDecrRefCount(linkObj);
- linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+ linkStr = TclGetStringFromObj(retVal, &curLen);
} else {
/*
* Absolute link.
@@ -317,7 +313,7 @@ TclFSNormalizeAbsolutePath(
} else {
retVal = linkObj;
}
- linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+ linkStr = TclGetStringFromObj(retVal, &curLen);
/*
* Convert to forward-slashes on windows.
@@ -334,7 +330,7 @@ TclFSNormalizeAbsolutePath(
}
}
} else {
- linkStr = Tcl_GetStringFromObj(retVal, &curLen);
+ linkStr = TclGetStringFromObj(retVal, &curLen);
}
/*
@@ -405,7 +401,7 @@ TclFSNormalizeAbsolutePath(
if (tclPlatform == TCL_PLATFORM_WINDOWS) {
int len;
- const char *path = Tcl_GetStringFromObj(retVal, &len);
+ const char *path = TclGetStringFromObj(retVal, &len);
if (len == 2 && path[0] != 0 && path[1] == ':') {
if (Tcl_IsShared(retVal)) {
@@ -564,7 +560,9 @@ TclPathPart(
Tcl_Obj *pathPtr, /* Path to take dirname of */
Tcl_PathPart portion) /* Requested portion of name */
{
- if (pathPtr->typePtr == &tclFsPathType) {
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
+
+ if (irPtr) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0) {
@@ -580,7 +578,7 @@ TclPathPart(
int numBytes;
const char *rest =
- Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
+ TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
if (strchr(rest, '/') != NULL) {
goto standardPath;
@@ -618,7 +616,7 @@ TclPathPart(
int numBytes;
const char *rest =
- Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
+ TclGetStringFromObj(fsPathPtr->normPathPtr, &numBytes);
if (strchr(rest, '/') != NULL) {
goto standardPath;
@@ -647,7 +645,7 @@ TclPathPart(
const char *fileName, *extension;
int length;
- fileName = Tcl_GetStringFromObj(fsPathPtr->normPathPtr,
+ fileName = TclGetStringFromObj(fsPathPtr->normPathPtr,
&length);
extension = TclGetExtension(fileName);
if (extension == NULL) {
@@ -699,7 +697,7 @@ TclPathPart(
int length;
const char *fileName, *extension;
- fileName = Tcl_GetStringFromObj(pathPtr, &length);
+ fileName = TclGetStringFromObj(pathPtr, &length);
extension = TclGetExtension(fileName);
if (extension == NULL) {
Tcl_IncrRefCount(pathPtr);
@@ -864,6 +862,7 @@ TclJoinPath(
if (elements == 2) {
Tcl_Obj *elt = objv[0];
+ Tcl_ObjIntRep *eltIr = TclFetchIntRep(elt, &fsPathType);
/*
* This is a special case where we can be much more efficient, where
@@ -877,7 +876,7 @@ TclJoinPath(
* to be an absolute path. Added a check for that elt is absolute.
*/
- if ((elt->typePtr == &tclFsPathType)
+ if ((eltIr)
&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
&& TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
Tcl_Obj *tailObj = objv[1];
@@ -890,7 +889,7 @@ TclJoinPath(
const char *str;
int len;
- str = Tcl_GetStringFromObj(tailObj, &len);
+ str = TclGetStringFromObj(tailObj, &len);
if (len == 0) {
/*
* This happens if we try to handle the root volume '/'.
@@ -961,7 +960,7 @@ TclJoinPath(
Tcl_Obj *driveName = NULL;
Tcl_Obj *elt = objv[i];
- strElt = Tcl_GetStringFromObj(elt, &strEltLen);
+ strElt = TclGetStringFromObj(elt, &strEltLen);
driveNameLength = 0;
/* if forceRelative - all paths excepting first one are relative */
type = (forceRelative && (i > 0)) ? TCL_PATH_RELATIVE :
@@ -1057,10 +1056,8 @@ TclJoinPath(
noQuickReturn:
if (res == NULL) {
res = Tcl_NewObj();
- ptr = Tcl_GetStringFromObj(res, &length);
- } else {
- ptr = Tcl_GetStringFromObj(res, &length);
}
+ ptr = TclGetStringFromObj(res, &length);
/*
* Strip off any './' before a tilde, unless this is the beginning of
@@ -1093,7 +1090,7 @@ TclJoinPath(
if (sep != NULL) {
separator = TclGetString(sep)[0];
- Tcl_DecrRefCount(sep);
+ TclDecrRefCount(sep);
}
/* Safety check in case the VFS driver caused sharing */
if (Tcl_IsShared(res)) {
@@ -1105,7 +1102,7 @@ TclJoinPath(
if (length > 0 && ptr[length -1] != '/') {
Tcl_AppendToObj(res, &separator, 1);
- Tcl_GetStringFromObj(res, &length);
+ TclGetStringFromObj(res, &length);
}
Tcl_SetObjLength(res, length + (int) strlen(strElt));
@@ -1161,6 +1158,8 @@ Tcl_FSConvertToPathType(
Tcl_Obj *pathPtr) /* Object to convert to a valid, current path
* type. */
{
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
+
/*
* 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
@@ -1171,39 +1170,16 @@ Tcl_FSConvertToPathType(
* path.
*/
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
return TCL_OK;
}
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
+ TclGetString(pathPtr);
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
}
return SetFsPathFromAny(interp, pathPtr);
-
- /*
- * We used to have more complex code here:
- *
- * FsPath *fsPathPtr = PATHOBJ(pathPtr);
- * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
- * return TCL_OK;
- * } else {
- * if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
- * return TCL_OK;
- * } else {
- * if (pathPtr->bytes == NULL) {
- * UpdateStringOfFsPath(pathPtr);
- * }
- * FreeFsPathInternalRep(pathPtr);
- * return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
- * }
- * }
- *
- * But we no longer believe this is necessary.
- */
}
/*
@@ -1335,9 +1311,7 @@ TclNewFSPathObj(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
- pathPtr->typePtr = &tclFsPathType;
- pathPtr->bytes = NULL;
- pathPtr->length = 0;
+ TclInvalidateStringRep(pathPtr);
/*
* Look for path components made up of only "."
@@ -1399,7 +1373,7 @@ AppendPath(
* intrep produce the same results; that is, bugward compatibility. If
* we need to fix that bug here, it needs fixing in TclJoinPath() too.
*/
- bytes = Tcl_GetStringFromObj(tail, &numBytes);
+ bytes = TclGetStringFromObj(tail, &numBytes);
if (numBytes == 0) {
Tcl_AppendToObj(copy, "/", 1);
} else {
@@ -1438,8 +1412,9 @@ TclFSMakePathRelative(
{
int cwdLen, len;
const char *tempStr;
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
FsPath *fsPathPtr = PATHOBJ(pathPtr);
if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
@@ -1458,7 +1433,7 @@ TclFSMakePathRelative(
* too little below, leading to wrong answers returned by glob.
*/
- tempStr = Tcl_GetStringFromObj(cwdPtr, &cwdLen);
+ tempStr = TclGetStringFromObj(cwdPtr, &cwdLen);
/*
* Should we perhaps use 'Tcl_FSPathSeparator'? But then what about the
@@ -1478,7 +1453,7 @@ TclFSMakePathRelative(
}
break;
}
- tempStr = Tcl_GetStringFromObj(pathPtr, &len);
+ tempStr = TclGetStringFromObj(pathPtr, &len);
return Tcl_NewStringObj(tempStr + cwdLen, len - cwdLen);
}
@@ -1506,31 +1481,12 @@ MakePathFromNormalized(
Tcl_Obj *pathPtr) /* The object to convert. */
{
FsPath *fsPathPtr;
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
return TCL_OK;
}
- /*
- * Free old representation
- */
-
- if (pathPtr->typePtr != NULL) {
- if (pathPtr->bytes == NULL) {
- if (pathPtr->typePtr->updateStringProc == NULL) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "can't find object string representation", -1));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
- NULL);
- }
- return TCL_ERROR;
- }
- pathPtr->typePtr->updateStringProc(pathPtr);
- }
- TclFreeIntRep(pathPtr);
- }
-
fsPathPtr = ckalloc(sizeof(FsPath));
/*
@@ -1539,11 +1495,7 @@ MakePathFromNormalized(
fsPathPtr->translatedPathPtr = NULL;
- /*
- * Circular reference by design.
- */
-
- fsPathPtr->normPathPtr = pathPtr;
+ Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
@@ -1552,7 +1504,6 @@ MakePathFromNormalized(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
return TCL_OK;
}
@@ -1603,25 +1554,12 @@ Tcl_FSNewNativePath(
* safe.
*/
- if (pathPtr->typePtr != NULL) {
- if (pathPtr->bytes == NULL) {
- if (pathPtr->typePtr->updateStringProc == NULL) {
- return NULL;
- }
- pathPtr->typePtr->updateStringProc(pathPtr);
- }
- TclFreeIntRep(pathPtr);
- }
-
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
fsPathPtr = ckalloc(sizeof(FsPath));
fsPathPtr->translatedPathPtr = NULL;
- /*
- * Circular reference, by design.
- */
-
- fsPathPtr->normPathPtr = pathPtr;
+ Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = clientData;
fsPathPtr->fsPtr = fromFilesystem;
@@ -1629,7 +1567,6 @@ Tcl_FSNewNativePath(
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
return pathPtr;
}
@@ -1676,20 +1613,22 @@ Tcl_FSGetTranslatedPath(
Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
srcFsPathPtr->cwdPtr);
+ Tcl_ObjIntRep *translatedCwdIrPtr;
+
if (translatedCwdPtr == NULL) {
return NULL;
}
retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
&srcFsPathPtr->normPathPtr);
- srcFsPathPtr->translatedPathPtr = retObj;
- if (translatedCwdPtr->typePtr == &tclFsPathType) {
+ Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj);
+ translatedCwdIrPtr = TclFetchIntRep(translatedCwdPtr, &fsPathType);
+ if (translatedCwdIrPtr) {
srcFsPathPtr->filesystemEpoch
= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
} else {
srcFsPathPtr->filesystemEpoch = 0;
}
- Tcl_IncrRefCount(retObj);
Tcl_DecrRefCount(translatedCwdPtr);
} else {
/*
@@ -1742,7 +1681,7 @@ Tcl_FSGetTranslatedStringPath(
if (transPtr != NULL) {
int len;
- const char *orig = Tcl_GetStringFromObj(transPtr, &len);
+ const char *orig = TclGetStringFromObj(transPtr, &len);
char *result = ckalloc(len+1);
memcpy(result, orig, (size_t) len+1);
@@ -1799,11 +1738,9 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
/* TODO: Figure out why this is needed. */
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
+ TclGetString(pathPtr);
- Tcl_GetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
+ TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
if (tailLen) {
copy = AppendPath(dir, fsPathPtr->normPathPtr);
} else {
@@ -1816,7 +1753,7 @@ Tcl_FSGetNormalizedPath(
* We now own a reference on both 'dir' and 'copy'
*/
- (void) Tcl_GetStringFromObj(dir, &cwdLen);
+ (void) TclGetStringFromObj(dir, &cwdLen);
/* Normalize the combined string. */
@@ -1853,7 +1790,7 @@ Tcl_FSGetNormalizedPath(
/*
* NOTE: here we are (dangerously?) assuming that origDir points
- * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The
+ * to a Tcl_Obj with Tcl_ObjType == &fsPathType. The
* pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
* above that set the pathType value should have established that,
* but it's far less clear on what basis we know there's been no
@@ -1871,6 +1808,7 @@ Tcl_FSGetNormalizedPath(
/*
* That's our reference to copy used.
*/
+ copy = NULL;
TclDecrRefCount(dir);
TclDecrRefCount(origDir);
@@ -1883,7 +1821,7 @@ Tcl_FSGetNormalizedPath(
/*
* That's our reference to copy used.
*/
-
+ copy = NULL;
TclDecrRefCount(dir);
}
PATHFLAGS(pathPtr) = 0;
@@ -1895,10 +1833,8 @@ Tcl_FSGetNormalizedPath(
if (fsPathPtr->cwdPtr != NULL) {
if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
+ TclGetString(pathPtr);
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
return NULL;
}
@@ -1909,7 +1845,7 @@ Tcl_FSGetNormalizedPath(
copy = AppendPath(fsPathPtr->cwdPtr, pathPtr);
- (void) Tcl_GetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
+ (void) TclGetStringFromObj(fsPathPtr->cwdPtr, &cwdLen);
cwdLen += (Tcl_GetString(copy)[cwdLen] == '/');
/*
@@ -1924,7 +1860,6 @@ Tcl_FSGetNormalizedPath(
}
if (fsPathPtr->normPathPtr == NULL) {
Tcl_Obj *useThisCwd = NULL;
- int pureNormalized = 1;
/*
* Since normPathPtr is NULL, but this is a valid path object, we know
@@ -1974,7 +1909,6 @@ Tcl_FSGetNormalizedPath(
return NULL;
}
- pureNormalized = 0;
Tcl_DecrRefCount(absolutePath);
absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
Tcl_IncrRefCount(absolutePath);
@@ -1994,7 +1928,6 @@ Tcl_FSGetNormalizedPath(
if (absolutePath == NULL) {
return NULL;
}
- pureNormalized = 0;
#endif /* _WIN32 */
}
}
@@ -2003,35 +1936,12 @@ Tcl_FSGetNormalizedPath(
* Already has refCount incremented.
*/
+ if (fsPathPtr->normPathPtr) {
+ Tcl_DecrRefCount(fsPathPtr->normPathPtr);
+ }
fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
absolutePath);
- /*
- * Check if path is pure normalized (this can only be the case if it
- * is an absolute path).
- */
-
- if (pureNormalized) {
- int normPathLen, pathLen;
- const char *normPath;
-
- path = TclGetStringFromObj(pathPtr, &pathLen);
- normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
- if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
- /*
- * The path was already normalized. Get rid of the duplicate.
- */
-
- TclDecrRefCount(fsPathPtr->normPathPtr);
-
- /*
- * We do *not* increment the refCount for this circular
- * reference.
- */
-
- fsPathPtr->normPathPtr = pathPtr;
- }
- }
if (useThisCwd != NULL) {
/*
* We just need to free an object we allocated above for relative
@@ -2177,8 +2087,9 @@ TclFSEnsureEpochOk(
const Tcl_Filesystem **fsPtrPtr)
{
FsPath *srcFsPathPtr;
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr != &tclFsPathType) {
+ if (irPtr == NULL) {
return TCL_OK;
}
@@ -2194,10 +2105,8 @@ TclFSEnsureEpochOk(
* We have to discard the stale representation and recalculate it.
*/
- if (pathPtr->bytes == NULL) {
- UpdateStringOfFsPath(pathPtr);
- }
- FreeFsPathInternalRep(pathPtr);
+ TclGetString(pathPtr);
+ Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return TCL_ERROR;
}
@@ -2237,12 +2146,13 @@ TclFSSetPathDetails(
ClientData clientData)
{
FsPath *srcFsPathPtr;
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);;
/*
* Make sure pathPtr is of the correct type.
*/
- if (pathPtr->typePtr != &tclFsPathType) {
+ if (irPtr == NULL) {
if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
return;
}
@@ -2340,8 +2250,9 @@ SetFsPathFromAny(
FsPath *fsPathPtr;
Tcl_Obj *transPtr;
char *name;
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
return TCL_OK;
}
@@ -2359,7 +2270,7 @@ SetFsPathFromAny(
* cmdAH.test exercise most of the code).
*/
- name = Tcl_GetStringFromObj(pathPtr, &len);
+ name = TclGetStringFromObj(pathPtr, &len);
/*
* Handle tilde substitutions, if needed.
@@ -2483,27 +2394,21 @@ SetFsPathFromAny(
fsPathPtr = ckalloc(sizeof(FsPath));
- fsPathPtr->translatedPathPtr = transPtr;
- if (transPtr != pathPtr) {
- Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
- /* Redo translation when $env(HOME) changes */
- fsPathPtr->filesystemEpoch = TclFSEpoch();
+ if (transPtr == pathPtr) {
+ transPtr = Tcl_DuplicateObj(pathPtr);
+ fsPathPtr->filesystemEpoch = 0;
} else {
- fsPathPtr->filesystemEpoch = 0;
+ fsPathPtr->filesystemEpoch = TclFSEpoch();
}
+ Tcl_IncrRefCount(transPtr);
+ fsPathPtr->translatedPathPtr = transPtr;
fsPathPtr->normPathPtr = NULL;
fsPathPtr->cwdPtr = NULL;
fsPathPtr->nativePathPtr = NULL;
fsPathPtr->fsPtr = NULL;
- /*
- * Free old representation before installing our new one.
- */
-
- TclFreeIntRep(pathPtr);
SETPATHOBJ(pathPtr, fsPathPtr);
PATHFLAGS(pathPtr) = 0;
- pathPtr->typePtr = &tclFsPathType;
return TCL_OK;
}
@@ -2526,6 +2431,7 @@ FreeFsPathInternalRep(
}
if (fsPathPtr->cwdPtr != NULL) {
TclDecrRefCount(fsPathPtr->cwdPtr);
+ fsPathPtr->cwdPtr = NULL;
}
if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
Tcl_FSFreeInternalRepProc *freeProc =
@@ -2538,7 +2444,6 @@ FreeFsPathInternalRep(
}
ckfree(fsPathPtr);
- pathPtr->typePtr = NULL;
}
static void
@@ -2551,24 +2456,14 @@ DupFsPathInternalRep(
SETPATHOBJ(copyPtr, copyFsPathPtr);
- if (srcFsPathPtr->translatedPathPtr == srcPtr) {
- /* Cycle in src -> make cycle in copy. */
- copyFsPathPtr->translatedPathPtr = copyPtr;
- } else {
- copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
- if (copyFsPathPtr->translatedPathPtr != NULL) {
- Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
- }
+ copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
+ if (copyFsPathPtr->translatedPathPtr != NULL) {
+ Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
}
- if (srcFsPathPtr->normPathPtr == srcPtr) {
- /* Cycle in src -> make cycle in copy. */
- copyFsPathPtr->normPathPtr = copyPtr;
- } else {
- copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
- if (copyFsPathPtr->normPathPtr != NULL) {
- Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
- }
+ copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
+ if (copyFsPathPtr->normPathPtr != NULL) {
+ Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
}
copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
@@ -2594,8 +2489,6 @@ DupFsPathInternalRep(
}
copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
-
- copyPtr->typePtr = &tclFsPathType;
}
/*
@@ -2627,11 +2520,15 @@ UpdateStringOfFsPath(
}
copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
+ if (Tcl_IsShared(copy)) {
+ copy = Tcl_DuplicateObj(copy);
+ }
- pathPtr->bytes = Tcl_GetStringFromObj(copy, &cwdLen);
+ Tcl_IncrRefCount(copy);
+ /* Steal copy's string rep */
+ pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
pathPtr->length = cwdLen;
- copy->bytes = tclEmptyStringRep;
- copy->length = 0;
+ TclInitStringRep(copy, NULL, 0);
TclDecrRefCount(copy);
}
@@ -2661,6 +2558,8 @@ TclNativePathInFilesystem(
Tcl_Obj *pathPtr,
ClientData *clientDataPtr)
{
+ Tcl_ObjIntRep *irPtr = TclFetchIntRep(pathPtr, &fsPathType);
+
/*
* A special case is required to handle the empty path "". This is a valid
* path (i.e. the user should be able to do 'file exists ""' without
@@ -2668,7 +2567,7 @@ TclNativePathInFilesystem(
* semantics of Tcl (at present anyway), so we have to abide by them here.
*/
- if (pathPtr->typePtr == &tclFsPathType) {
+ if (irPtr) {
if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
/*
* We reject the empty path "".
@@ -2683,13 +2582,13 @@ TclNativePathInFilesystem(
} else {
/*
* It is somewhat unusual to reach this code path without the object
- * being of tclFsPathType. However, we do our best to deal with the
+ * being of fsPathType. However, we do our best to deal with the
* situation.
*/
int len;
- (void) Tcl_GetStringFromObj(pathPtr, &len);
+ (void) TclGetStringFromObj(pathPtr, &len);
if (len == 0) {
/*
* We reject the empty path "".
diff --git a/generic/tclPipe.c b/generic/tclPipe.c
index 2ecc5a6..f94fe5c 100644
--- a/generic/tclPipe.c
+++ b/generic/tclPipe.c
@@ -60,7 +60,7 @@ static TclFile FileForRedirect(Tcl_Interp *interp, const char *spec,
static TclFile
FileForRedirect(
- Tcl_Interp *interp, /* Intepreter to use for error reporting. */
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. */
const char *spec, /* Points to character just after redirection
* character. */
int atOK, /* Non-zero means that '@' notation can be
@@ -221,13 +221,13 @@ Tcl_ReapDetachedProcs(void)
{
register Detached *detPtr;
Detached *nextPtr, *prevPtr;
- int status;
- Tcl_Pid pid;
+ int status, code;
Tcl_MutexLock(&pipeMutex);
for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
- pid = Tcl_WaitPid(detPtr->pid, &status, WNOHANG);
- if ((pid == 0) || ((pid == (Tcl_Pid) -1) && (errno != ECHILD))) {
+ status = TclProcessWait(detPtr->pid, WNOHANG, &code, NULL, NULL);
+ if (status == TCL_PROCESS_UNCHANGED || (status == TCL_PROCESS_ERROR
+ && code != ECHILD)) {
prevPtr = detPtr;
detPtr = detPtr->nextPtr;
continue;
@@ -277,38 +277,21 @@ TclCleanupChildren(
{
int result = TCL_OK;
int i, abnormalExit, anyErrorInfo;
- Tcl_Pid pid;
- int waitStatus;
- const char *msg;
- unsigned long resolvedPid;
+ TclProcessWaitStatus waitStatus;
+ int code;
+ Tcl_Obj *msg, *error;
abnormalExit = 0;
for (i = 0; i < numPids; i++) {
- /*
- * We need to get the resolved pid before we wait on it as the windows
- * implementation of Tcl_WaitPid deletes the information such that any
- * following calls to TclpGetPid fail.
- */
-
- resolvedPid = TclpGetPid(pidPtr[i]);
- pid = Tcl_WaitPid(pidPtr[i], &waitStatus, 0);
- if (pid == (Tcl_Pid) -1) {
+ waitStatus = TclProcessWait(pidPtr[i], 0, &code, &msg, &error);
+ if (waitStatus == TCL_PROCESS_ERROR) {
result = TCL_ERROR;
if (interp != NULL) {
- msg = Tcl_PosixError(interp);
- if (errno == ECHILD) {
- /*
- * This changeup in message suggested by Mark Diekhans to
- * remind people that ECHILD errors can occur on some
- * systems if SIGCHLD isn't in its default state.
- */
-
- msg =
- "child process lost (is SIGCHLD ignored or trapped?)";
- }
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "error waiting for process to exit: %s", msg));
+ Tcl_SetObjErrorCode(interp, error);
+ Tcl_SetObjResult(interp, msg);
}
+ Tcl_DecrRefCount(error);
+ Tcl_DecrRefCount(msg);
continue;
}
@@ -319,39 +302,19 @@ TclCleanupChildren(
* removed).
*/
- if (!WIFEXITED(waitStatus) || (WEXITSTATUS(waitStatus) != 0)) {
- char msg1[TCL_INTEGER_SPACE], msg2[TCL_INTEGER_SPACE];
-
+ if (waitStatus != TCL_PROCESS_EXITED || code != 0) {
result = TCL_ERROR;
- sprintf(msg1, "%lu", resolvedPid);
- if (WIFEXITED(waitStatus)) {
+ if (waitStatus == TCL_PROCESS_EXITED) {
if (interp != NULL) {
- sprintf(msg2, "%u", WEXITSTATUS(waitStatus));
- Tcl_SetErrorCode(interp, "CHILDSTATUS", msg1, msg2, NULL);
+ Tcl_SetObjErrorCode(interp, error);
}
abnormalExit = 1;
} else if (interp != NULL) {
- const char *p;
-
- if (WIFSIGNALED(waitStatus)) {
- p = Tcl_SignalMsg(WTERMSIG(waitStatus));
- Tcl_SetErrorCode(interp, "CHILDKILLED", msg1,
- Tcl_SignalId(WTERMSIG(waitStatus)), p, NULL);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "child killed: %s\n", p));
- } else if (WIFSTOPPED(waitStatus)) {
- p = Tcl_SignalMsg(WSTOPSIG(waitStatus));
- Tcl_SetErrorCode(interp, "CHILDSUSP", msg1,
- Tcl_SignalId(WSTOPSIG(waitStatus)), p, NULL);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "child suspended: %s\n", p));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "child wait status didn't make sense\n", -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC",
- "ODDWAITRESULT", msg1, NULL);
- }
+ Tcl_SetObjErrorCode(interp, error);
+ Tcl_SetObjResult(interp, msg);
}
+ Tcl_DecrRefCount(error);
+ Tcl_DecrRefCount(msg);
}
}
@@ -936,6 +899,7 @@ TclCreatePipeline(
pidPtr[numPids] = pid;
numPids++;
+ TclProcessCreated(pid);
/*
* Close off our copies of file descriptors that were set up for this
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index d4080c2..2c16458 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -17,6 +17,10 @@
#include "tclInt.h"
+MODULE_SCOPE char *tclEmptyStringRep;
+
+char *tclEmptyStringRep = &tclEmptyString;
+
/*
* Each invocation of the "package ifneeded" command creates a structure of
* the following type, which is used to load the package into the interpreter
@@ -28,10 +32,22 @@ typedef struct PkgAvail {
char *script; /* Script to invoke to provide this version of
* the package. Malloc'ed and protected by
* Tcl_Preserve and Tcl_Release. */
+ char *pkgIndex; /* Full file name of pkgIndex file */
struct PkgAvail *nextPtr; /* Next in list of available versions of the
* same package. */
} PkgAvail;
+typedef struct PkgName {
+ struct PkgName *nextPtr; /* Next in list of package names being initialized. */
+ char name[1];
+} PkgName;
+
+typedef struct PkgFiles {
+ PkgName *names; /* Package names being initialized. Must be first field*/
+ Tcl_HashTable table; /* Table which contains files for each package */
+} PkgFiles;
+
+
/*
* For each package that is known in any way to an interpreter, there is one
* record of the following type. These records are stored in the
@@ -99,7 +115,7 @@ static int TclNRPackageObjCmdCleanup(ClientData data[], Tcl_Interp *interp, int
((v) = ckalloc(len), memcpy((v),(s),(len)))
#define DupString(v,s) \
do { \
- unsigned local__len = (unsigned) (strlen(s) + 1); \
+ size_t local__len = strlen(s) + 1; \
DupBlock((v),(s),local__len); \
} while (0)
@@ -207,6 +223,63 @@ Tcl_PkgProvideEx(
*----------------------------------------------------------------------
*/
+static void PkgFilesCleanupProc(ClientData clientData,
+ Tcl_Interp *interp)
+{
+ PkgFiles *pkgFiles = (PkgFiles *) clientData;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *entry;
+
+ while (pkgFiles->names) {
+ PkgName *name = pkgFiles->names;
+ pkgFiles->names = name->nextPtr;
+ ckfree(name);
+ }
+ entry = Tcl_FirstHashEntry(&pkgFiles->table, &search);
+ while (entry) {
+ Tcl_Obj *obj = (Tcl_Obj *)Tcl_GetHashValue(entry);
+ Tcl_DecrRefCount(obj);
+ entry = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&pkgFiles->table);
+ ckfree(pkgFiles);
+ return;
+}
+
+void *TclInitPkgFiles(Tcl_Interp *interp)
+{
+ /* If assocdata "tclPkgFiles" doesn't exist yet, create it */
+ PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ if (!pkgFiles) {
+ pkgFiles = ckalloc(sizeof(PkgFiles));
+ pkgFiles->names = NULL;
+ Tcl_InitHashTable(&pkgFiles->table, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, "tclPkgFiles", PkgFilesCleanupProc, pkgFiles);
+ }
+ return pkgFiles;
+}
+
+void TclPkgFileSeen(Tcl_Interp *interp, const char *fileName)
+{
+ PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ if (pkgFiles && pkgFiles->names) {
+ const char *name = pkgFiles->names->name;
+ Tcl_HashTable *table = &pkgFiles->table;
+ int new;
+ Tcl_HashEntry *entry = Tcl_CreateHashEntry(table, name, &new);
+ Tcl_Obj *list;
+
+ if (new) {
+ list = Tcl_NewObj();
+ Tcl_SetHashValue(entry, list);
+ Tcl_IncrRefCount(list);
+ } else {
+ list = Tcl_GetHashValue(entry);
+ }
+ Tcl_ListObjAppendElement(interp, list, Tcl_NewStringObj(fileName, -1));
+ }
+}
+
#undef Tcl_PkgRequire
const char *
Tcl_PkgRequire(
@@ -276,8 +349,8 @@ Tcl_PkgRequireEx(
*
* 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
+ * the definition of tclEmptyStringRep near the top of this file.
+ * 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
@@ -293,18 +366,11 @@ Tcl_PkgRequireEx(
* 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.
+ * that's not fully initialized. Functions in it may not work
+ * reliably, so be very careful about adding any other calls here
+ * without checking how they behave when initialization is incomplete.
*/
- tclEmptyStringRep = &tclEmptyString;
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"Cannot load package \"%s\" in standalone executable:"
" This package is not compiled with stub support", name));
@@ -511,7 +577,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
char *availVersion, *bestVersion, *bestStableVersion;
/* Internal rep. of versions */
- int availStable, satisfies;
+ int availStable, satisfies;
Require *reqPtr = data[0];
int reqc = PTR2INT(data[1]);
Tcl_Obj **const reqv = data[2];
@@ -662,9 +728,21 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
*/
char *versionToProvide = bestPtr->version;
+ PkgFiles *pkgFiles;
+ PkgName *pkgName;
- pkgPtr->clientData = versionToProvide;
Tcl_Preserve(versionToProvide);
+ pkgPtr->clientData = versionToProvide;
+
+ pkgFiles = TclInitPkgFiles(interp);
+ /* Push "ifneeded" package name in "tclPkgFiles" assocdata. */
+ pkgName = ckalloc(sizeof(PkgName) + strlen(name));
+ pkgName->nextPtr = pkgFiles->names;
+ strcpy(pkgName->name, name);
+ pkgFiles->names = pkgName;
+ if (bestPtr->pkgIndex) {
+ TclPkgFileSeen(interp, bestPtr->pkgIndex);
+ }
reqPtr->versionToProvide = versionToProvide;
Tcl_NRAddCallback(interp, SelectPackageFinal, reqPtr, INT2PTR(reqc), (void *)reqv, data[3]);
Tcl_NREvalObj(interp, Tcl_NewStringObj(bestPtr->script, -1), TCL_EVAL_GLOBAL);
@@ -680,6 +758,12 @@ SelectPackageFinal(ClientData data[], Tcl_Interp *interp, int result) {
const char *name = reqPtr->name;
char *versionToProvide = reqPtr->versionToProvide;
+ /* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
+ PkgFiles *pkgFiles = Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ PkgName *pkgName = pkgFiles->names;
+ pkgFiles->names = pkgName->nextPtr;
+ ckfree(pkgName);
+
reqPtr->pkgPtr = FindPackage(interp, name);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
@@ -883,14 +967,14 @@ TclNRPackageObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const pkgOptions[] = {
- "forget", "ifneeded", "names", "prefer", "present",
- "provide", "require", "unknown", "vcompare", "versions",
- "vsatisfies", NULL
+ "files", "forget", "ifneeded", "names", "prefer",
+ "present", "provide", "require", "unknown", "vcompare",
+ "versions", "vsatisfies", NULL
};
enum pkgOptions {
- PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER, PKG_PRESENT,
- PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE, PKG_VERSIONS,
- PKG_VSATISFIES
+ PKG_FILES, PKG_FORGET, PKG_IFNEEDED, PKG_NAMES, PKG_PREFER,
+ PKG_PRESENT, PKG_PROVIDE, PKG_REQUIRE, PKG_UNKNOWN, PKG_VCOMPARE,
+ PKG_VERSIONS, PKG_VSATISFIES
};
Interp *iPtr = (Interp *) interp;
int optionIndex, exact, i, newobjc, satisfies;
@@ -914,11 +998,37 @@ TclNRPackageObjCmd(
return TCL_ERROR;
}
switch ((enum pkgOptions) optionIndex) {
+ case PKG_FILES: {
+ PkgFiles *pkgFiles;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "package");
+ return TCL_ERROR;
+ }
+ pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
+ if (pkgFiles) {
+ Tcl_HashEntry *entry = Tcl_FindHashEntry(&pkgFiles->table, Tcl_GetString(objv[2]));
+ if (entry) {
+ Tcl_SetObjResult(interp, (Tcl_Obj *)Tcl_GetHashValue(entry));
+ }
+ }
+ break;
+ }
case PKG_FORGET: {
const char *keyString;
+ PkgFiles *pkgFiles = (PkgFiles *) Tcl_GetAssocData(interp, "tclPkgFiles", NULL);
for (i = 2; i < objc; i++) {
keyString = TclGetString(objv[i]);
+ if (pkgFiles) {
+ hPtr = Tcl_FindHashEntry(&pkgFiles->table, keyString);
+ if (hPtr) {
+ Tcl_Obj *obj = Tcl_GetHashValue(hPtr);
+ Tcl_DeleteHashEntry(hPtr);
+ Tcl_DecrRefCount(obj);
+ }
+ }
+
hPtr = Tcl_FindHashEntry(&iPtr->packageTable, keyString);
if (hPtr == NULL) {
continue;
@@ -933,6 +1043,10 @@ TclNRPackageObjCmd(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ if (availPtr->pkgIndex) {
+ Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+ availPtr->pkgIndex = NULL;
+ }
ckfree(availPtr);
}
ckfree(pkgPtr);
@@ -962,7 +1076,7 @@ TclNRPackageObjCmd(
} else {
pkgPtr = FindPackage(interp, argv2);
}
- argv3 = Tcl_GetStringFromObj(objv[3], &length);
+ argv3 = TclGetStringFromObj(objv[3], &length);
for (availPtr = pkgPtr->availPtr, prevPtr = NULL; availPtr != NULL;
prevPtr = availPtr, availPtr = availPtr->nextPtr) {
@@ -983,6 +1097,10 @@ TclNRPackageObjCmd(
return TCL_OK;
}
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ if (availPtr->pkgIndex) {
+ Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+ availPtr->pkgIndex = NULL;
+ }
break;
}
}
@@ -993,6 +1111,7 @@ TclNRPackageObjCmd(
}
if (availPtr == NULL) {
availPtr = ckalloc(sizeof(PkgAvail));
+ availPtr->pkgIndex = NULL;
DupBlock(availPtr->version, argv3, (unsigned) length + 1);
if (prevPtr == NULL) {
@@ -1003,7 +1122,11 @@ TclNRPackageObjCmd(
prevPtr->nextPtr = availPtr;
}
}
- argv4 = Tcl_GetStringFromObj(objv[4], &length);
+ if (iPtr->scriptFile) {
+ argv4 = TclGetStringFromObj(iPtr->scriptFile, &length);
+ DupBlock(availPtr->pkgIndex, argv4, (unsigned) length + 1);
+ }
+ argv4 = TclGetStringFromObj(objv[4], &length);
DupBlock(availPtr->script, argv4, (unsigned) length + 1);
break;
}
@@ -1174,7 +1297,7 @@ TclNRPackageObjCmd(
if (iPtr->packageUnknown != NULL) {
ckfree(iPtr->packageUnknown);
}
- argv2 = Tcl_GetStringFromObj(objv[2], &length);
+ argv2 = TclGetStringFromObj(objv[2], &length);
if (argv2[0] == 0) {
iPtr->packageUnknown = NULL;
} else {
@@ -1367,7 +1490,7 @@ FindPackage(
void
TclFreePackageInfo(
- Interp *iPtr) /* Interpereter that is being deleted. */
+ Interp *iPtr) /* Interpreter that is being deleted. */
{
Package *pkgPtr;
Tcl_HashSearch search;
@@ -1385,6 +1508,10 @@ TclFreePackageInfo(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ if (availPtr->pkgIndex) {
+ Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+ availPtr->pkgIndex = NULL;
+ }
ckfree(availPtr);
}
ckfree(pkgPtr);
@@ -1829,7 +1956,7 @@ AddRequirementsToResult(
int i, length;
for (i = 0; i < reqc; i++) {
- const char *v = Tcl_GetStringFromObj(reqv[i], &length);
+ const char *v = TclGetStringFromObj(reqv[i], &length);
if ((length & 0x1) && (v[length/2] == '-')
&& (strncmp(v, v+((length+1)/2), length/2) == 0)) {
@@ -2042,7 +2169,7 @@ Tcl_PkgInitStubsCheck(
{
const char *actualVersion = Tcl_PkgPresent(interp, "Tcl", version, 0);
- if (exact && actualVersion) {
+ if ((exact&1) && actualVersion) {
const char *p = version;
int count = 0;
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index 466d535..96b6962 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -40,7 +40,7 @@
* configuration information.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
# define CFG_THREADED "1"
#else
# define CFG_THREADED "0"
@@ -105,6 +105,8 @@ static Tcl_Config const cfg[] = {
{"scriptdir,runtime", CFG_RUNTIME_SCRDIR},
{"includedir,runtime", CFG_RUNTIME_INCDIR},
{"docdir,runtime", CFG_RUNTIME_DOCDIR},
+ {"dllfile,runtime", CFG_RUNTIME_DLLFILE},
+ {"zipfile,runtime", CFG_RUNTIME_ZIPFILE},
/* Installation paths to various stuff */
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 12a60db..d3f6233 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -24,20 +24,8 @@
#endif
#include "tcl.h"
-#if !defined(LLONG_MIN)
-# ifdef TCL_WIDE_INT_IS_LONG
-# define LLONG_MIN LONG_MIN
-# else
-# 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
-# endif
-/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
-# define LLONG_MAX (~LLONG_MIN)
-#endif
-
+#define UWIDE_MAX ((Tcl_WideUInt)-1)
+#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
+#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))
#endif /* _TCLPORT */
diff --git a/generic/tclPreserve.c b/generic/tclPreserve.c
index cca13e8..5c6097f 100644
--- a/generic/tclPreserve.c
+++ b/generic/tclPreserve.c
@@ -22,7 +22,7 @@
typedef struct {
ClientData clientData; /* Address of preserved block. */
- int refCount; /* Number of Tcl_Preserve calls in effect for
+ size_t refCount; /* Number of Tcl_Preserve calls in effect for
* block. */
int mustFree; /* Non-zero means Tcl_EventuallyFree was
* called while a Tcl_Preserve call was in
@@ -63,7 +63,7 @@ typedef struct HandleStruct {
* ensure that the contents of the handle are
* not changed by anyone else. */
#endif
- int refCount; /* Number of TclHandlePreserve() calls in
+ size_t refCount; /* Number of TclHandlePreserve() calls in
* effect on this handle. */
} HandleStruct;
@@ -155,7 +155,7 @@ Tcl_Preserve(
refPtr->clientData = clientData;
refPtr->refCount = 1;
refPtr->mustFree = 0;
- refPtr->freeProc = TCL_STATIC;
+ refPtr->freeProc = 0;
inUse += 1;
Tcl_MutexUnlock(&preserveMutex);
}
@@ -195,7 +195,7 @@ Tcl_Release(
continue;
}
- if (--refPtr->refCount != 0) {
+ if (refPtr->refCount-- > 1) {
Tcl_MutexUnlock(&preserveMutex);
return;
}
@@ -459,7 +459,7 @@ TclHandleRelease(
handlePtr, handlePtr->ptr2, handlePtr->ptr);
}
#endif
- if ((--handlePtr->refCount == 0) && (handlePtr->ptr == NULL)) {
+ if ((handlePtr->refCount-- <= 1) && (handlePtr->ptr == NULL)) {
ckfree(handlePtr);
}
}
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 03cb0f0..b44e54d 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -15,6 +15,7 @@
#include "tclInt.h"
#include "tclCompile.h"
+#include <assert.h>
/*
* Variables that are part of the [apply] command implementation and which
@@ -67,6 +68,22 @@ const Tcl_ObjType tclProcBodyType = {
* should panic instead. */
};
+#define ProcSetIntRep(objPtr, procPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (procPtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (procPtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir); \
+ } while (0)
+
+#define ProcGetIntRep(objPtr, procPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &tclProcBodyType); \
+ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
* The [upvar]/[uplevel] level reference type. Uses the longValue field
* to remember the integer value of a parsed #<integer> format.
@@ -89,13 +106,31 @@ static const Tcl_ObjType levelReferenceType = {
* will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
*/
-const Tcl_ObjType tclLambdaType = {
+static const Tcl_ObjType lambdaType = {
"lambdaExpr", /* name */
FreeLambdaInternalRep, /* freeIntRepProc */
DupLambdaInternalRep, /* dupIntRepProc */
NULL, /* updateStringProc */
SetLambdaFromAny /* setFromAnyProc */
};
+
+#define LambdaSetIntRep(objPtr, procPtr, nsObjPtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ ir.twoPtrValue.ptr1 = (procPtr); \
+ ir.twoPtrValue.ptr2 = (nsObjPtr); \
+ Tcl_IncrRefCount((nsObjPtr)); \
+ Tcl_StoreIntRep((objPtr), &lambdaType, &ir); \
+ } while (0)
+
+#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &lambdaType); \
+ (procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ (nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \
+ } while (0)
+
/*
*----------------------------------------------------------------------
@@ -294,7 +329,7 @@ Tcl_ProcObjCmd(
* of all procs whose argument list is just _args_
*/
- if (objv[3]->typePtr == &tclProcBodyType) {
+ if (TclFetchIntRep(objv[3], &tclProcBodyType)) {
goto done;
}
@@ -319,7 +354,7 @@ Tcl_ProcObjCmd(
* The argument list is just "args"; check the body
*/
- procBody = Tcl_GetStringFromObj(objv[3], &numBytes);
+ procBody = TclGetStringFromObj(objv[3], &numBytes);
if (TclParseAllWhiteSpace(procBody, numBytes) < numBytes) {
goto done;
}
@@ -370,13 +405,14 @@ TclCreateProc(
{
Interp *iPtr = (Interp *) interp;
- register Proc *procPtr;
+ register Proc *procPtr = NULL;
int i, result, numArgs;
register CompiledLocal *localPtr = NULL;
Tcl_Obj **argArray;
int precompiled = 0;
- if (bodyPtr->typePtr == &tclProcBodyType) {
+ ProcGetIntRep(bodyPtr, procPtr);
+ if (procPtr != NULL) {
/*
* Because the body is a TclProProcBody, the actual body is already
* compiled, and it is not shared with anyone else, so it's OK not to
@@ -389,7 +425,6 @@ TclCreateProc(
* will be holding a reference to it.
*/
- procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
procPtr->iPtr = iPtr;
procPtr->refCount++;
precompiled = 1;
@@ -566,11 +601,10 @@ TclCreateProc(
*/
if (localPtr->defValuePtr != NULL) {
- int tmpLength, valueLength;
- const char *tmpPtr = TclGetStringFromObj(localPtr->defValuePtr,
- &tmpLength);
- const char *value = TclGetStringFromObj(fieldValues[1],
- &valueLength);
+ const char *tmpPtr = TclGetString(localPtr->defValuePtr);
+ size_t tmpLength = localPtr->defValuePtr->length;
+ const char *value = TclGetString(fieldValues[1]);
+ size_t valueLength = fieldValues[1]->length;
if ((valueLength != tmpLength)
|| memcmp(value, tmpPtr, tmpLength) != 0
@@ -684,51 +718,15 @@ TclGetFrame(
CallFrame **framePtrPtr) /* Store pointer to frame here (or NULL if
* global frame indicated). */
{
- register Interp *iPtr = (Interp *) interp;
- int curLevel, level, result;
- CallFrame *framePtr;
-
- /*
- * Parse string to figure out which level number to go to.
- */
-
- result = 1;
- curLevel = iPtr->varFramePtr->level;
- if (*name== '#') {
- if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
- goto levelError;
- }
- } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
- if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
- goto levelError;
- }
- level = curLevel - level;
- } else {
- level = curLevel - 1;
- result = 0;
- }
-
- /*
- * Figure out which frame to use, and return it to the caller.
- */
-
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
- }
- }
- if (framePtr == NULL) {
- goto levelError;
- }
-
- *framePtrPtr = framePtr;
- return result;
-
- levelError:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
- return -1;
+ int result;
+ Tcl_Obj obj;
+
+ obj.bytes = (char *) name;
+ obj.length = strlen(name);
+ obj.typePtr = NULL;
+ result = TclObjGetFrame(interp, &obj, framePtrPtr);
+ TclFreeIntRep(&obj);
+ return result;
}
/*
@@ -765,7 +763,9 @@ TclObjGetFrame(
{
register Interp *iPtr = (Interp *) interp;
int curLevel, level, result;
+ const Tcl_ObjIntRep *irPtr;
const char *name = NULL;
+ Tcl_WideInt w;
/*
* Parse object to figure out which level number to go to.
@@ -781,25 +781,34 @@ TclObjGetFrame(
if (objPtr == NULL) {
/* Do nothing */
- } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
- && (level >= 0)) {
- level = curLevel - level;
- result = 1;
- } else if (objPtr->typePtr == &levelReferenceType) {
- level = (int) objPtr->internalRep.longValue;
+ } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
+ Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+ if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
+ result = -1;
+ } else {
+ level = curLevel - level;
+ result = 1;
+ }
+ } else if ((irPtr = TclFetchIntRep(objPtr, &levelReferenceType))) {
+ level = irPtr->wideValue;
result = 1;
} else {
name = TclGetString(objPtr);
if (name[0] == '#') {
- if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &levelReferenceType;
- objPtr->internalRep.longValue = level;
- result = 1;
+ if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
+ if (level < 0 || (level > 0 && name[1] == '-')) {
+ result = -1;
+ } else {
+ Tcl_ObjIntRep ir;
+
+ ir.wideValue = level;
+ Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir);
+ result = 1;
+ }
} else {
result = -1;
}
- } else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
+ } else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) {
/*
* If this were an integer, we'd have succeeded already.
* Docs say we have to treat this as a 'bad level' error.
@@ -810,7 +819,6 @@ TclObjGetFrame(
if (result == 0) {
level = curLevel - 1;
- name = "1";
}
if (result != -1) {
if (level >= 0) {
@@ -823,11 +831,11 @@ TclObjGetFrame(
}
}
}
- if (name == NULL) {
- name = TclGetString(objPtr);
- }
}
+ if (name == NULL) {
+ name = TclGetString(objPtr);
+ }
Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
return -1;
@@ -1118,10 +1126,10 @@ TclInitCompiledLocals(
ByteCode *codePtr;
bodyPtr = framePtr->procPtr->bodyPtr;
- if (bodyPtr->typePtr != &tclByteCodeType) {
+ ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
+ if (codePtr == NULL) {
Tcl_Panic("body object for proc attached to frame is not a byte code type");
}
- codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
if (framePtr->numCompiledLocals) {
if (!codePtr->localCachePtr) {
@@ -1284,7 +1292,7 @@ InitLocalCache(
Proc *procPtr)
{
Interp *iPtr = procPtr->iPtr;
- ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
int localCt = procPtr->numCompiledLocals;
int numArgs = procPtr->numArgs, i = 0;
@@ -1294,6 +1302,8 @@ InitLocalCache(
CompiledLocal *localPtr;
int new;
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+
/*
* Cache the names and initial values of local variables; store the
* cache in both the framePtr for this execution and in the codePtr
@@ -1361,11 +1371,13 @@ InitArgsAndLocals(
{
CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
register Proc *procPtr = framePtr->procPtr;
- ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
register Var *varPtr, *defPtr;
int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
Tcl_Obj *const *argObjs;
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+
/*
* Make sure that the local cache of variable names and initial values has
* been initialised properly .
@@ -1540,7 +1552,8 @@ TclPushProcCallFrame(
* local variables are found while compiling.
*/
- if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+ if (codePtr != NULL) {
Interp *iPtr = (Interp *) interp;
/*
@@ -1552,7 +1565,6 @@ TclPushProcCallFrame(
* commands and/or resolver changes are considered).
*/
- codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
if (((Interp *) *codePtr->interpHandle != iPtr)
|| (codePtr->compileEpoch != iPtr->compileEpoch)
|| (codePtr->nsPtr != nsPtr)
@@ -1750,7 +1762,7 @@ TclNRInterpProcCore(
*/
procPtr->refCount++;
- codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
NULL, NULL);
@@ -1884,7 +1896,9 @@ TclProcCompileProc(
{
Interp *iPtr = (Interp *) interp;
Tcl_CallFrame *framePtr;
- ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
+ ByteCode *codePtr;
+
+ ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
/*
* If necessary, compile the procedure's body. The compiler will allocate
@@ -1900,7 +1914,7 @@ TclProcCompileProc(
* are not recompiled, even if things have changed.
*/
- if (bodyPtr->typePtr == &tclByteCodeType) {
+ if (codePtr != NULL) {
if (((Interp *) *codePtr->interpHandle == iPtr)
&& (codePtr->compileEpoch == iPtr->compileEpoch)
&& (codePtr->nsPtr == nsPtr)
@@ -1919,11 +1933,12 @@ TclProcCompileProc(
codePtr->compileEpoch = iPtr->compileEpoch;
codePtr->nsPtr = nsPtr;
} else {
- TclFreeIntRep(bodyPtr);
+ Tcl_StoreIntRep(bodyPtr, &tclByteCodeType, NULL);
+ codePtr = NULL;
}
}
- if (bodyPtr->typePtr != &tclByteCodeType) {
+ if (codePtr == NULL) {
Tcl_HashEntry *hePtr;
#ifdef TCL_COMPILE_DEBUG
@@ -2045,7 +2060,7 @@ MakeProcError(
* messages and trace information. */
{
int overflow, limit = 60, nameLen;
- const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
+ const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
@@ -2272,10 +2287,7 @@ TclNewProcBodyObj(
TclNewObj(objPtr);
if (objPtr) {
- objPtr->typePtr = &tclProcBodyType;
- objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-
- procPtr->refCount++;
+ ProcSetIntRep(objPtr, procPtr);
}
return objPtr;
@@ -2303,11 +2315,10 @@ ProcBodyDup(
Tcl_Obj *srcPtr, /* Object to copy. */
Tcl_Obj *dupPtr) /* Target object for the duplication. */
{
- Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ Proc *procPtr;
+ ProcGetIntRep(srcPtr, procPtr);
- dupPtr->typePtr = &tclProcBodyType;
- dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
- procPtr->refCount++;
+ ProcSetIntRep(dupPtr, procPtr);
}
/*
@@ -2333,7 +2344,9 @@ static void
ProcBodyFree(
Tcl_Obj *objPtr) /* The object to clean up. */
{
- Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ Proc *procPtr;
+
+ ProcGetIntRep(objPtr, procPtr);
if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
@@ -2359,15 +2372,15 @@ DupLambdaInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
register Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;
+ Proc *procPtr;
+ Tcl_Obj *nsObjPtr;
- copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
- copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+ LambdaGetIntRep(srcPtr, procPtr, nsObjPtr);
+ assert(procPtr != NULL);
procPtr->refCount++;
- Tcl_IncrRefCount(nsObjPtr);
- copyPtr->typePtr = &tclLambdaType;
+
+ LambdaSetIntRep(copyPtr, procPtr, nsObjPtr);
}
static void
@@ -2375,14 +2388,16 @@ FreeLambdaInternalRep(
register Tcl_Obj *objPtr) /* CmdName object with internal representation
* to free. */
{
- Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
+ Proc *procPtr;
+ Tcl_Obj *nsObjPtr;
+
+ LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+ assert(procPtr != NULL);
- if (procPtr->refCount-- == 1) {
+ if (procPtr->refCount-- <= 1) {
TclProcCleanupProc(procPtr);
}
TclDecrRefCount(nsObjPtr);
- objPtr->typePtr = NULL;
}
static int
@@ -2403,7 +2418,7 @@ SetLambdaFromAny(
/*
* Convert objPtr to list type first; if it cannot be converted, or if its
- * length is not 2, then it cannot be converted to tclLambdaType.
+ * length is not 2, then it cannot be converted to lambdaType.
*/
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
@@ -2544,21 +2559,42 @@ SetLambdaFromAny(
}
}
- Tcl_IncrRefCount(nsObjPtr);
-
/*
* Free the list internalrep of objPtr - this will free argsPtr, but
* bodyPtr retains a reference from the Proc structure. Then finish the
- * conversion to tclLambdaType.
+ * conversion to lambdaType.
*/
- TclFreeIntRep(objPtr);
-
- objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
- objPtr->typePtr = &tclLambdaType;
+ LambdaSetIntRep(objPtr, procPtr, nsObjPtr);
return TCL_OK;
}
+
+Proc *
+TclGetLambdaFromObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Tcl_Obj **nsObjPtrPtr)
+{
+ Proc *procPtr;
+ Tcl_Obj *nsObjPtr;
+
+ LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+
+ if (procPtr == NULL) {
+ if (SetLambdaFromAny(interp, objPtr) != TCL_OK) {
+ return NULL;
+ }
+ LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+ }
+
+ assert(procPtr != NULL);
+ if (procPtr->iPtr != (Interp *)interp) {
+ return NULL;
+ }
+
+ *nsObjPtrPtr = nsObjPtr;
+ return procPtr;
+}
/*
*----------------------------------------------------------------------
@@ -2594,7 +2630,6 @@ TclNRApplyObjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Interp *iPtr = (Interp *) interp;
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
int result;
@@ -2612,48 +2647,17 @@ TclNRApplyObjCmd(
*/
lambdaPtr = objv[1];
- if (lambdaPtr->typePtr == &tclLambdaType) {
- procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
- }
+ procPtr = TclGetLambdaFromObj(interp, lambdaPtr, &nsObjPtr);
-#define JOE_EXTENSION 0
-/*
- * Note: this code is NOT FUNCTIONAL due to the NR implementation; DO NOT
- * ENABLE! Leaving here as reminder to (a) TIP the suggestion, and (b) adapt
- * the code. (MS)
- */
-
-#if JOE_EXTENSION
- else {
- /*
- * Joe English's suggestion to allow cmdNames to function as lambdas.
- */
-
- Tcl_Obj *elemPtr;
- int numElem;
-
- if ((lambdaPtr->typePtr == &tclCmdNameType) ||
- (TclListObjGetElements(interp, lambdaPtr, &numElem,
- &elemPtr) == TCL_OK && numElem == 1)) {
- return Tcl_EvalObjv(interp, objc-1, objv+1, 0);
- }
- }
-#endif
-
- if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
- result = SetLambdaFromAny(interp, lambdaPtr);
- if (result != TCL_OK) {
- return result;
- }
- procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+ if (procPtr == NULL) {
+ return TCL_ERROR;
}
/*
- * Find the namespace where this lambda should run, and push a call frame
- * for that namespace. Note that TclObjInterpProc() will pop it.
+ * Push a call frame for the lambda namespace.
+ * Note that TclObjInterpProc() will pop it.
*/
- nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
if (result != TCL_OK) {
return TCL_ERROR;
@@ -2726,7 +2730,7 @@ MakeLambdaError(
* messages and trace information. */
{
int overflow, limit = 60, nameLen;
- const char *procName = Tcl_GetStringFromObj(procNameObj, &nameLen);
+ const char *procName = TclGetStringFromObj(procNameObj, &nameLen);
overflow = (nameLen > limit);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
diff --git a/generic/tclProcess.c b/generic/tclProcess.c
new file mode 100644
index 0000000..a781386
--- /dev/null
+++ b/generic/tclProcess.c
@@ -0,0 +1,957 @@
+/*
+ * tclProcess.c --
+ *
+ * This file implements the "tcl::process" ensemble for subprocess
+ * management as defined by TIP #462.
+ *
+ * Copyright (c) 2017 Frederic Bonnet.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+
+/*
+ * Autopurge flag. Process-global because of the way Tcl manages child
+ * processes (see tclPipe.c).
+ */
+
+static int autopurge = 1; /* Autopurge flag. */
+
+/*
+ * Hash tables that keeps track of all child process statuses. Keys are the
+ * child process ids and resolved pids, values are (ProcessInfo *).
+ */
+
+typedef struct ProcessInfo {
+ Tcl_Pid pid; /* Process id. */
+ int resolvedPid; /* Resolved process id. */
+ int purge; /* Purge eventualy. */
+ TclProcessWaitStatus status;/* Process status. */
+ int code; /* Error code, exit status or signal
+ number. */
+ Tcl_Obj *msg; /* Error message. */
+ Tcl_Obj *error; /* Error code. */
+} ProcessInfo;
+static Tcl_HashTable infoTablePerPid;
+static Tcl_HashTable infoTablePerResolvedPid;
+static int infoTablesInitialized = 0; /* 0 means not yet initialized. */
+TCL_DECLARE_MUTEX(infoTablesMutex)
+
+ /*
+ * Prototypes for functions defined later in this file:
+ */
+
+static void InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
+ int resolvedPid);
+static void FreeProcessInfo(ProcessInfo *info);
+static int RefreshProcessInfo(ProcessInfo *info, int options);
+static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
+ int options, int *codePtr, Tcl_Obj **msgPtr,
+ Tcl_Obj **errorObjPtr);
+static Tcl_Obj * BuildProcessStatusObj(ProcessInfo *info);
+static int ProcessListObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ProcessStatusObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ProcessPurgeObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int ProcessAutopurgeObjCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitProcessInfo --
+ *
+ * Initializes the ProcessInfo structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory written.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+InitProcessInfo(
+ ProcessInfo *info, /* Structure to initialize. */
+ Tcl_Pid pid, /* Process id. */
+ int resolvedPid) /* Resolved process id. */
+{
+ info->pid = pid;
+ info->resolvedPid = resolvedPid;
+ info->purge = 0;
+ info->status = TCL_PROCESS_UNCHANGED;
+ info->code = 0;
+ info->msg = NULL;
+ info->error = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeProcessInfo --
+ *
+ * Free the ProcessInfo structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory deallocated, Tcl_Obj refcount decreased.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+FreeProcessInfo(
+ ProcessInfo *info) /* Structure to free. */
+{
+ /*
+ * Free stored Tcl_Objs.
+ */
+
+ if (info->msg) {
+ Tcl_DecrRefCount(info->msg);
+ }
+ if (info->error) {
+ Tcl_DecrRefCount(info->error);
+ }
+
+ /*
+ * Free allocated structure.
+ */
+
+ ckfree(info);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefreshProcessInfo --
+ *
+ * Refresh process info.
+ *
+ * Results:
+ * Nonzero if state changed, else zero.
+ *
+ * Side effects:
+ * May call WaitProcessStatus, which can block if WNOHANG option is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+RefreshProcessInfo(
+ ProcessInfo *info, /* Structure to refresh. */
+ int options /* Options passed to WaitProcessStatus. */
+)
+{
+ if (info->status == TCL_PROCESS_UNCHANGED) {
+ /*
+ * Refresh & store status.
+ */
+
+ info->status = WaitProcessStatus(info->pid, info->resolvedPid,
+ options, &info->code, &info->msg, &info->error);
+ if (info->msg) Tcl_IncrRefCount(info->msg);
+ if (info->error) Tcl_IncrRefCount(info->error);
+ return (info->status != TCL_PROCESS_UNCHANGED);
+ } else {
+ /*
+ * No change.
+ */
+
+ return 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitProcessStatus --
+ *
+ * Wait for process status to change.
+ *
+ * Results:
+ * TclProcessWaitStatus enum value.
+ *
+ * Side effects:
+ * May call WaitProcessStatus, which can block if WNOHANG option is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclProcessWaitStatus
+WaitProcessStatus(
+ Tcl_Pid pid, /* Process id. */
+ int resolvedPid, /* Resolved process id. */
+ int options, /* Options passed to Tcl_WaitPid. */
+ int *codePtr, /* If non-NULL, will receive either:
+ * - 0 for normal exit.
+ * - errno in case of error.
+ * - non-zero exit code for abormal exit.
+ * - signal number if killed or suspended.
+ * - Tcl_WaitPid status in all other cases.
+ */
+ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */
+ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */
+{
+ int waitStatus;
+ Tcl_Obj *errorStrings[5];
+ const char *msg;
+
+ pid = Tcl_WaitPid(pid, &waitStatus, options);
+ if (pid == 0) {
+ /*
+ * No change.
+ */
+
+ return TCL_PROCESS_UNCHANGED;
+ }
+
+ /*
+ * Get process status.
+ */
+
+ if (pid == (Tcl_Pid) -1) {
+ /*
+ * POSIX errName msg
+ */
+
+ msg = Tcl_ErrnoMsg(errno);
+ if (errno == ECHILD) {
+ /*
+ * This changeup in message suggested by Mark Diekhans to
+ * remind people that ECHILD errors can occur on some
+ * systems if SIGCHLD isn't in its default state.
+ */
+
+ msg = "child process lost (is SIGCHLD ignored or trapped?)";
+ }
+ if (codePtr) *codePtr = errno;
+ if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
+ "error waiting for process to exit: %s", msg);
+ if (errorObjPtr) {
+ errorStrings[0] = Tcl_NewStringObj("POSIX", -1);
+ errorStrings[1] = Tcl_NewStringObj(Tcl_ErrnoId(), -1);
+ errorStrings[2] = Tcl_NewStringObj(msg, -1);
+ *errorObjPtr = Tcl_NewListObj(3, errorStrings);
+ }
+ return TCL_PROCESS_ERROR;
+ } else if (WIFEXITED(waitStatus)) {
+ if (codePtr) *codePtr = WEXITSTATUS(waitStatus);
+ if (!WEXITSTATUS(waitStatus)) {
+ /*
+ * Normal exit.
+ */
+
+ if (msgObjPtr) *msgObjPtr = NULL;
+ if (errorObjPtr) *errorObjPtr = NULL;
+ } else {
+ /*
+ * CHILDSTATUS pid code
+ *
+ * Child exited with a non-zero exit status.
+ */
+
+ if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
+ "child process exited abnormally", -1);
+ if (errorObjPtr) {
+ errorStrings[0] = Tcl_NewStringObj("CHILDSTATUS", -1);
+ errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+ errorStrings[2] = Tcl_NewIntObj(WEXITSTATUS(waitStatus));
+ *errorObjPtr = Tcl_NewListObj(3, errorStrings);
+ }
+ }
+ return TCL_PROCESS_EXITED;
+ } else if (WIFSIGNALED(waitStatus)) {
+ /*
+ * CHILDKILLED pid sigName msg
+ *
+ * Child killed because of a signal.
+ */
+
+ msg = Tcl_SignalMsg(WTERMSIG(waitStatus));
+ if (codePtr) *codePtr = WTERMSIG(waitStatus);
+ if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
+ "child killed: %s", msg);
+ if (errorObjPtr) {
+ errorStrings[0] = Tcl_NewStringObj("CHILDKILLED", -1);
+ errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+ errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WTERMSIG(waitStatus)), -1);
+ errorStrings[3] = Tcl_NewStringObj(msg, -1);
+ *errorObjPtr = Tcl_NewListObj(4, errorStrings);
+ }
+ return TCL_PROCESS_SIGNALED;
+ } else if (WIFSTOPPED(waitStatus)) {
+ /*
+ * CHILDSUSP pid sigName msg
+ *
+ * Child suspended because of a signal.
+ */
+
+ msg = Tcl_SignalMsg(WSTOPSIG(waitStatus));
+ if (codePtr) *codePtr = WSTOPSIG(waitStatus);
+ if (msgObjPtr) *msgObjPtr = Tcl_ObjPrintf(
+ "child suspended: %s", msg);
+ if (errorObjPtr) {
+ errorStrings[0] = Tcl_NewStringObj("CHILDSUSP", -1);
+ errorStrings[1] = Tcl_NewIntObj(resolvedPid);
+ errorStrings[2] = Tcl_NewStringObj(Tcl_SignalId(WSTOPSIG(waitStatus)), -1);
+ errorStrings[3] = Tcl_NewStringObj(msg, -1);
+ *errorObjPtr = Tcl_NewListObj(4, errorStrings);
+ }
+ return TCL_PROCESS_STOPPED;
+ } else {
+ /*
+ * TCL OPERATION EXEC ODDWAITRESULT
+ *
+ * Child wait status didn't make sense.
+ */
+
+ if (codePtr) *codePtr = waitStatus;
+ if (msgObjPtr) *msgObjPtr = Tcl_NewStringObj(
+ "child wait status didn't make sense\n", -1);
+ if (errorObjPtr) {
+ errorStrings[0] = Tcl_NewStringObj("TCL", -1);
+ errorStrings[1] = Tcl_NewStringObj("OPERATION", -1);
+ errorStrings[2] = Tcl_NewStringObj("EXEC", -1);
+ errorStrings[3] = Tcl_NewStringObj("ODDWAITRESULT", -1);
+ errorStrings[4] = Tcl_NewIntObj(resolvedPid);
+ *errorObjPtr = Tcl_NewListObj(5, errorStrings);
+ }
+ return TCL_PROCESS_UNKNOWN_STATUS;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BuildProcessStatusObj --
+ *
+ * Build a list object with process status. The first element is always
+ * a standard Tcl return value, which can be either TCL_OK or TCL_ERROR.
+ * In the latter case, the second element is the error message and the
+ * third element is a Tcl error code (see tclvars).
+ *
+ * Results:
+ * A list object.
+ *
+ * Side effects:
+ * Tcl_Objs are created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+BuildProcessStatusObj(
+ ProcessInfo *info)
+{
+ Tcl_Obj *resultObjs[3];
+
+ if (info->status == TCL_PROCESS_UNCHANGED) {
+ /*
+ * Process still running, return empty obj.
+ */
+
+ return Tcl_NewObj();
+ }
+ if (info->status == TCL_PROCESS_EXITED && info->code == 0) {
+ /*
+ * Normal exit, return TCL_OK.
+ */
+
+ return Tcl_NewIntObj(TCL_OK);
+ }
+
+ /*
+ * Abnormal exit, return {TCL_ERROR msg error}
+ */
+
+ resultObjs[0] = Tcl_NewIntObj(TCL_ERROR);
+ resultObjs[1] = info->msg;
+ resultObjs[2] = info->error;
+ return Tcl_NewListObj(3, resultObjs);
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ProcessListObjCmd --
+ *
+ * This function implements the 'tcl::process list' Tcl command.
+ * Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Access to the internal structures is protected by infoTablesMutex.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcessListObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *list;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch search;
+ ProcessInfo *info;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Return the list of all chid process ids.
+ */
+
+ list = Tcl_NewListObj(0, NULL);
+ Tcl_MutexLock(&infoTablesMutex);
+ for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ Tcl_ListObjAppendElement(interp, list,
+ Tcl_NewIntObj(info->resolvedPid));
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ Tcl_SetObjResult(interp, list);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ProcessStatusObjCmd --
+ *
+ * This function implements the 'tcl::process status' Tcl command.
+ * Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Access to the internal structures is protected by infoTablesMutex.
+ * Calls RefreshProcessInfo, which can block if -wait switch is given.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcessStatusObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Obj *dict;
+ int index, options = WNOHANG;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch search;
+ ProcessInfo *info;
+ int numPids;
+ Tcl_Obj **pidObjs;
+ int result;
+ int i;
+ int pid;
+ Tcl_Obj *const *savedobjv = objv;
+ static const char *const switches[] = {
+ "-wait", "--", NULL
+ };
+ enum switches {
+ STATUS_WAIT, STATUS_LAST
+ };
+
+ while (objc > 1) {
+ if (TclGetString(objv[1])[0] != '-') {
+ break;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], switches, "switches", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ++objv; --objc;
+ if (STATUS_WAIT == (enum switches) index) {
+ options = 0;
+ } else {
+ break;
+ }
+ }
+
+ if (objc != 1 && objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, savedobjv, "?switches? ?pids?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 1) {
+ /*
+ * Return a dict with all child process statuses.
+ */
+
+ dict = Tcl_NewDictObj();
+ Tcl_MutexLock(&infoTablesMutex);
+ for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ RefreshProcessInfo(info, options);
+
+ if (info->purge && autopurge) {
+ /*
+ * Purge entry.
+ */
+
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+ Tcl_DeleteHashEntry(entry);
+ FreeProcessInfo(info);
+ } else {
+ /*
+ * Add to result.
+ */
+
+ Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
+ BuildProcessStatusObj(info));
+ }
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ } else {
+ /*
+ * Only return statuses of provided processes.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ dict = Tcl_NewDictObj();
+ Tcl_MutexLock(&infoTablesMutex);
+ for (i = 0; i < numPids; i++) {
+ result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
+ if (result != TCL_OK) {
+ Tcl_MutexUnlock(&infoTablesMutex);
+ Tcl_DecrRefCount(dict);
+ return result;
+ }
+
+ entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
+ if (!entry) {
+ /*
+ * Skip unknown process.
+ */
+
+ continue;
+ }
+
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ RefreshProcessInfo(info, options);
+
+ if (info->purge && autopurge) {
+ /*
+ * Purge entry.
+ */
+
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+ Tcl_DeleteHashEntry(entry);
+ FreeProcessInfo(info);
+ } else {
+ /*
+ * Add to result.
+ */
+
+ Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
+ BuildProcessStatusObj(info));
+ }
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ }
+ Tcl_SetObjResult(interp, dict);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ProcessPurgeObjCmd --
+ *
+ * This function implements the 'tcl::process purge' Tcl command.
+ * Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Frees all ProcessInfo structures with their purge flag set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcessPurgeObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch search;
+ ProcessInfo *info;
+ int numPids;
+ Tcl_Obj **pidObjs;
+ int result;
+ int i;
+ int pid;
+
+ if (objc != 1 && objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pids?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * First reap detached procs so that their purge flag is up-to-date.
+ */
+
+ Tcl_ReapDetachedProcs();
+
+ if (objc == 1) {
+ /*
+ * Purge all terminated processes.
+ */
+
+ Tcl_MutexLock(&infoTablesMutex);
+ for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
+ entry != NULL; entry = Tcl_NextHashEntry(&search)) {
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ if (info->purge) {
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+ Tcl_DeleteHashEntry(entry);
+ FreeProcessInfo(info);
+ }
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ } else {
+ /*
+ * Purge only provided processes.
+ */
+
+ result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
+ if (result != TCL_OK) {
+ return result;
+ }
+ Tcl_MutexLock(&infoTablesMutex);
+ for (i = 0; i < numPids; i++) {
+ result = Tcl_GetIntFromObj(interp, pidObjs[i], (int *) &pid);
+ if (result != TCL_OK) {
+ Tcl_MutexUnlock(&infoTablesMutex);
+ return result;
+ }
+
+ entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, INT2PTR(pid));
+ if (!entry) {
+ /*
+ * Skip unknown process.
+ */
+
+ continue;
+ }
+
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ if (info->purge) {
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
+ Tcl_DeleteHashEntry(entry);
+ FreeProcessInfo(info);
+ }
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * ProcessAutopurgeObjCmd --
+ *
+ * This function implements the 'tcl::process autopurge' Tcl command.
+ * Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * Alters detached process handling by Tcl_ReapDetachedProcs().
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ProcessAutopurgeObjCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc != 1 && objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?flag?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 2) {
+ /*
+ * Set given value.
+ */
+
+ int flag;
+ int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ autopurge = !!flag;
+ }
+
+ /*
+ * Return current value.
+ */
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitProcessCmd --
+ *
+ * This procedure creates the "tcl::process" Tcl command. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Command
+TclInitProcessCmd(
+ Tcl_Interp *interp) /* Current interpreter. */
+{
+ static const EnsembleImplMap processImplMap[] = {
+ {"list", ProcessListObjCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
+ {"status", ProcessStatusObjCmd, TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
+ {"purge", ProcessPurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
+ {"autopurge", ProcessAutopurgeObjCmd, TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+ };
+ Tcl_Command processCmd;
+
+ if (infoTablesInitialized == 0) {
+ Tcl_MutexLock(&infoTablesMutex);
+ if (infoTablesInitialized == 0) {
+ Tcl_InitHashTable(&infoTablePerPid, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&infoTablePerResolvedPid, TCL_ONE_WORD_KEYS);
+ infoTablesInitialized = 1;
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ }
+
+ processCmd = TclMakeEnsemble(interp, "::tcl::process", processImplMap);
+ Tcl_Export(interp, Tcl_FindNamespace(interp, "::tcl", NULL, 0),
+ "process", 0);
+ return processCmd;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcessCreated --
+ *
+ * Called when a child process has been created by Tcl.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal structures are updated with a new ProcessInfo.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclProcessCreated(
+ Tcl_Pid pid) /* Process id. */
+{
+ int resolvedPid;
+ Tcl_HashEntry *entry, *entry2;
+ int isNew;
+ ProcessInfo *info;
+
+ /*
+ * Get resolved pid first.
+ */
+
+ resolvedPid = TclpGetPid(pid);
+
+ Tcl_MutexLock(&infoTablesMutex);
+
+ /*
+ * Create entry in pid table.
+ */
+
+ entry = Tcl_CreateHashEntry(&infoTablePerPid, pid, &isNew);
+ if (!isNew) {
+ /*
+ * Pid was reused, free old info and reuse structure.
+ */
+
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
+ INT2PTR(resolvedPid));
+ if (entry2) Tcl_DeleteHashEntry(entry2);
+ FreeProcessInfo(info);
+ }
+
+ /*
+ * Allocate and initialize info structure.
+ */
+
+ info = (ProcessInfo *) ckalloc(sizeof(ProcessInfo));
+ InitProcessInfo(info, pid, resolvedPid);
+
+ /*
+ * Add entry to tables.
+ */
+
+ Tcl_SetHashValue(entry, info);
+ entry = Tcl_CreateHashEntry(&infoTablePerResolvedPid, INT2PTR(resolvedPid),
+ &isNew);
+ Tcl_SetHashValue(entry, info);
+
+ Tcl_MutexUnlock(&infoTablesMutex);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclProcessWait --
+ *
+ * Wait for process status to change.
+ *
+ * Results:
+ * TclProcessWaitStatus enum value.
+ *
+ * Side effects:
+ * Completed process info structures are purged immediately (autopurge on)
+ * or eventually (autopurge off).
+ *
+ *----------------------------------------------------------------------
+ */
+
+TclProcessWaitStatus
+TclProcessWait(
+ Tcl_Pid pid, /* Process id. */
+ int options, /* Options passed to WaitProcessStatus. */
+ int *codePtr, /* If non-NULL, will receive either:
+ * - 0 for normal exit.
+ * - errno in case of error.
+ * - non-zero exit code for abormal exit.
+ * - signal number if killed or suspended.
+ * - Tcl_WaitPid status in all other cases.
+ */
+ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */
+ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */
+{
+ Tcl_HashEntry *entry;
+ ProcessInfo *info;
+ TclProcessWaitStatus result;
+
+ /*
+ * First search for pid in table.
+ */
+
+ Tcl_MutexLock(&infoTablesMutex);
+ entry = Tcl_FindHashEntry(&infoTablePerPid, pid);
+ if (!entry) {
+ /*
+ * Unknown process, just call WaitProcessStatus and return.
+ */
+
+ result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
+ msgObjPtr, errorObjPtr);
+ if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
+ if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
+ Tcl_MutexUnlock(&infoTablesMutex);
+ return result;
+ }
+
+ info = (ProcessInfo *) Tcl_GetHashValue(entry);
+ if (info->purge) {
+ /*
+ * Process has completed but TclProcessWait has already been called,
+ * so report no change.
+ */
+ Tcl_MutexUnlock(&infoTablesMutex);
+
+ return TCL_PROCESS_UNCHANGED;
+ }
+
+ RefreshProcessInfo(info, options);
+ if (info->status == TCL_PROCESS_UNCHANGED) {
+ /*
+ * No change, stop there.
+ */
+ Tcl_MutexUnlock(&infoTablesMutex);
+
+ return TCL_PROCESS_UNCHANGED;
+ }
+
+ /*
+ * Set return values.
+ */
+
+ result = info->status;
+ if (codePtr) *codePtr = info->code;
+ if (msgObjPtr) *msgObjPtr = info->msg;
+ if (errorObjPtr) *errorObjPtr = info->error;
+ if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
+ if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
+
+ if (autopurge) {
+ /*
+ * Purge now.
+ */
+
+ Tcl_DeleteHashEntry(entry);
+ entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
+ INT2PTR(info->resolvedPid));
+ Tcl_DeleteHashEntry(entry);
+ FreeProcessInfo(info);
+ } else {
+ /*
+ * Eventually purge. Subsequent calls will return
+ * TCL_PROCESS_UNCHANGED.
+ */
+
+ info->purge = 1;
+ }
+ Tcl_MutexUnlock(&infoTablesMutex);
+ return result;
+}
diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c
index cfe6388..ce53ced 100644
--- a/generic/tclRegexp.c
+++ b/generic/tclRegexp.c
@@ -13,6 +13,7 @@
#include "tclInt.h"
#include "tclRegexp.h"
+#include <assert.h>
/*
*----------------------------------------------------------------------
@@ -64,7 +65,7 @@
#define NUM_REGEXPS 30
-typedef struct ThreadSpecificData {
+typedef struct {
int initialized; /* Set to 1 when the module is initialized. */
char *patterns[NUM_REGEXPS];/* Strings corresponding to compiled regular
* expression patterns. NULL means that this
@@ -107,6 +108,23 @@ const Tcl_ObjType tclRegexpType = {
NULL, /* updateStringProc */
SetRegexpFromAny /* setFromAnyProc */
};
+
+#define RegexpSetIntRep(objPtr, rePtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ (rePtr)->refCount++; \
+ ir.twoPtrValue.ptr1 = (rePtr); \
+ ir.twoPtrValue.ptr2 = NULL; \
+ Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir); \
+ } while (0)
+
+#define RegexpGetIntRep(objPtr, rePtr) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &tclRegexpType); \
+ (rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ } while (0)
+
/*
*----------------------------------------------------------------------
@@ -510,9 +528,9 @@ Tcl_RegExpMatchObj(
*/
if (!(re = Tcl_GetRegExpFromObj(interp, patternObj,
- TCL_REG_ADVANCED | TCL_REG_NOSUB))
+ TCL_REG_ADVANCED | TCL_REG_NOSUB))
&& !(re = Tcl_GetRegExpFromObj(interp, patternObj, TCL_REG_ADVANCED))) {
- return -1;
+ return -1;
}
return Tcl_RegExpExecObj(interp, re, textObj, 0 /* offset */,
0 /* nmatches */, 0 /* flags */);
@@ -580,14 +598,9 @@ Tcl_GetRegExpFromObj(
TclRegexp *regexpPtr;
const char *pattern;
- /*
- * This is OK because we only actually interpret this value properly as a
- * TclRegexp* when the type is tclRegexpType.
- */
+ RegexpGetIntRep(objPtr, regexpPtr);
- regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
- if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+ if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
pattern = TclGetStringFromObj(objPtr, &length);
regexpPtr = CompileRegexp(interp, pattern, length, flags);
@@ -595,21 +608,7 @@ Tcl_GetRegExpFromObj(
return NULL;
}
- /*
- * Add a reference to the regexp so it will persist even if it is
- * pushed out of the current thread's regexp cache. This reference
- * will be removed when the object's internal rep is freed.
- */
-
- regexpPtr->refCount++;
-
- /*
- * Free the old representation and set our type.
- */
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
- objPtr->typePtr = &tclRegexpType;
+ RegexpSetIntRep(objPtr, regexpPtr);
}
return (Tcl_RegExp) regexpPtr;
}
@@ -679,7 +678,7 @@ TclRegAbout(
resultObj = Tcl_NewObj();
Tcl_ListObjAppendElement(NULL, resultObj,
- Tcl_NewIntObj((int) regexpPtr->re.re_nsub));
+ Tcl_NewWideIntObj((Tcl_WideInt) regexpPtr->re.re_nsub));
/*
* Now append a list of all the bit-flags set for the RE.
@@ -756,7 +755,11 @@ static void
FreeRegexpInternalRep(
Tcl_Obj *objPtr) /* Regexp object with internal rep to free. */
{
- TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ TclRegexp *regexpRepPtr;
+
+ RegexpGetIntRep(objPtr, regexpRepPtr);
+
+ assert(regexpRepPtr != NULL);
/*
* If this is the last reference to the regexp, free it.
@@ -765,7 +768,6 @@ FreeRegexpInternalRep(
if (regexpRepPtr->refCount-- <= 1) {
FreeRegexp(regexpRepPtr);
}
- objPtr->typePtr = NULL;
}
/*
@@ -790,11 +792,13 @@ DupRegexpInternalRep(
Tcl_Obj *srcPtr, /* Object with internal rep to copy. */
Tcl_Obj *copyPtr) /* Object with internal rep to set. */
{
- TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ TclRegexp *regexpPtr;
+
+ RegexpGetIntRep(srcPtr, regexpPtr);
+
+ assert(regexpPtr != NULL);
- regexpPtr->refCount++;
- copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
- copyPtr->typePtr = &tclRegexpType;
+ RegexpSetIntRep(copyPtr, regexpPtr);
}
/*
diff --git a/generic/tclRegexp.h b/generic/tclRegexp.h
index 3b2433e..a263dfd 100644
--- a/generic/tclRegexp.h
+++ b/generic/tclRegexp.h
@@ -37,7 +37,7 @@ typedef struct TclRegexp {
* of subexpressions. */
rm_detail_t details; /* Detailed information on match (currently
* used only for REG_EXPECT). */
- int refCount; /* Count of number of references to this
+ size_t refCount; /* Count of number of references to this
* compiled regexp. */
} TclRegexp;
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 9d0714c..a5ec4be 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -27,7 +27,9 @@ enum returnKeys {
static Tcl_Obj ** GetKeys(void);
static void ReleaseKeys(ClientData clientData);
static void ResetObjResult(Interp *iPtr);
+#ifndef TCL_NO_DEPRECATED
static void SetupAppendBuffer(Interp *iPtr, int newSpace);
+#endif /* !TCL_NO_DEPRECATED */
/*
* This structure is used to take a snapshot of the interpreter state in
@@ -35,7 +37,7 @@ static void SetupAppendBuffer(Interp *iPtr, int newSpace);
* then back up to the result or the error that was previously in progress.
*/
-typedef struct InterpState {
+typedef struct {
int status; /* return code status */
int flags; /* Each remaining field saves the */
int returnLevel; /* corresponding field of the Interp */
@@ -230,6 +232,7 @@ Tcl_DiscardInterpState(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_SaveResult
void
Tcl_SaveResult(
@@ -461,6 +464,7 @@ Tcl_SetResult(
ResetObjResult(iPtr);
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -483,18 +487,21 @@ const char *
Tcl_GetStringResult(
register Tcl_Interp *interp)/* Interpreter whose result to return. */
{
+ Interp *iPtr = (Interp *) interp;
+#ifdef TCL_NO_DEPRECATED
+ return Tcl_GetString(iPtr->objResultPtr);
+#else
/*
* If the string result is empty, move the object result to the string
* result, then reset the object result.
*/
- Interp *iPtr = (Interp *) interp;
-
if (*(iPtr->result) == 0) {
Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
TCL_VOLATILE);
}
return iPtr->result;
+#endif
}
/*
@@ -536,6 +543,7 @@ Tcl_SetObjResult(
TclDecrRefCount(oldObjResult);
+#ifndef TCL_NO_DEPRECATED
/*
* Reset the string result since we just set the result object.
*/
@@ -550,6 +558,7 @@ Tcl_SetObjResult(
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif
}
/*
@@ -578,6 +587,7 @@ Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
Tcl_Obj *objResultPtr;
int length;
@@ -604,6 +614,7 @@ Tcl_GetObjResult(
iPtr->result = iPtr->resultSpace;
iPtr->result[0] = 0;
}
+#endif /* !TCL_NO_DEPRECATED */
return iPtr->objResultPtr;
}
@@ -640,23 +651,6 @@ Tcl_AppendResultVA(
}
Tcl_AppendStringsToObjVA(objPtr, argList);
Tcl_SetObjResult(interp, objPtr);
-
- /*
- * Strictly we should call Tcl_GetStringResult(interp) here to make sure
- * that interp->result is correct according to the old contract, but that
- * makes the performance of much code (e.g. in Tk) absolutely awful. So we
- * leave it out; code that really wants interp->result can just insert the
- * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
- */
-
-#ifdef USE_INTERP_RESULT
- /*
- * Ensure that the interp->result is legal so old Tcl 7.* code still
- * works. There's still embarrasingly much of it about...
- */
-
- (void) Tcl_GetStringResult(interp);
-#endif /* USE_INTERP_RESULT */
}
/*
@@ -722,6 +716,21 @@ Tcl_AppendElement(
* to result. */
{
Interp *iPtr = (Interp *) interp;
+#ifdef TCL_NO_DEPRECATED
+ Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
+ Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
+ const char *bytes;
+
+ if (Tcl_IsShared(iPtr->objResultPtr)) {
+ Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
+ }
+ bytes = TclGetString(iPtr->objResultPtr);
+ if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) {
+ Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
+ }
+ Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
+ Tcl_DecrRefCount(listPtr);
+#else
char *dst;
int size;
int flags;
@@ -765,6 +774,7 @@ Tcl_AppendElement(
flags |= TCL_DONT_QUOTE_HASH;
}
iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
+#endif /* !TCL_NO_DEPRECATED */
}
/*
@@ -786,6 +796,7 @@ Tcl_AppendElement(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
static void
SetupAppendBuffer(
Interp *iPtr, /* Interpreter whose result is being set up. */
@@ -846,6 +857,7 @@ SetupAppendBuffer(
Tcl_FreeResult((Tcl_Interp *) iPtr);
iPtr->result = iPtr->appendResult;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -875,6 +887,7 @@ Tcl_FreeResult(
{
register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -884,6 +897,7 @@ Tcl_FreeResult(
iPtr->freeProc = 0;
}
+#endif /* !TCL_NO_DEPRECATED */
ResetObjResult(iPtr);
}
@@ -913,6 +927,7 @@ Tcl_ResetResult(
register Interp *iPtr = (Interp *) interp;
ResetObjResult(iPtr);
+#ifndef TCL_NO_DEPRECATED
if (iPtr->freeProc != NULL) {
if (iPtr->freeProc == TCL_DYNAMIC) {
ckfree(iPtr->result);
@@ -923,6 +938,7 @@ Tcl_ResetResult(
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
if (iPtr->errorCode) {
/* Legacy support */
if (iPtr->flags & ERR_LEGACY_COPY) {
@@ -982,11 +998,11 @@ ResetObjResult(
Tcl_IncrRefCount(objResultPtr);
iPtr->objResultPtr = objResultPtr;
} else {
- if (objResultPtr->bytes != tclEmptyStringRep) {
+ if (objResultPtr->bytes != &tclEmptyString) {
if (objResultPtr->bytes) {
ckfree(objResultPtr->bytes);
}
- objResultPtr->bytes = tclEmptyStringRep;
+ objResultPtr->bytes = &tclEmptyString;
objResultPtr->length = 0;
}
TclFreeIntRep(objResultPtr);
@@ -1276,10 +1292,8 @@ TclProcessReturn(
Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
&valuePtr);
if (valuePtr != NULL) {
- int infoLen;
-
- (void) TclGetStringFromObj(valuePtr, &infoLen);
- if (infoLen) {
+ (void) TclGetString(valuePtr);
+ if (valuePtr->length) {
iPtr->errorInfo = valuePtr;
Tcl_IncrRefCount(iPtr->errorInfo);
iPtr->flags |= ERR_ALREADY_LOGGED;
@@ -1382,13 +1396,11 @@ TclMergeReturnOptions(
Tcl_Obj **keys = GetKeys();
for (; objc > 1; objv += 2, objc -= 2) {
- int optLen;
- const char *opt = TclGetStringFromObj(objv[0], &optLen);
- int compareLen;
- const char *compare =
- TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
+ const char *opt = TclGetString(objv[0]);
+ const char *compare = TclGetString(keys[KEY_OPTIONS]);
- if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) {
+ if ((objv[0]->length == keys[KEY_OPTIONS]->length)
+ && (memcmp(opt, compare, objv[0]->length) == 0)) {
Tcl_DictSearch search;
int done = 0;
Tcl_Obj *keyPtr;
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 3dae3b3..fbfba2d 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -10,6 +10,7 @@
*/
#include "tclInt.h"
+#include "tommath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -415,14 +416,7 @@ ValidateFormat(
case 'x':
case 'X':
case 'b':
- break;
case 'u':
- if (flags & SCAN_BIG) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unsigned bignum scans are invalid", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
- goto error;
- }
break;
/*
* Bracket terms need special checking
@@ -725,7 +719,7 @@ Tcl_ScanObjCmd(
switch (ch) {
case 'n':
if (!(flags & SCAN_SUPPRESS)) {
- objPtr = Tcl_NewIntObj(string - baseString);
+ objPtr = Tcl_NewWideIntObj(string - baseString);
Tcl_IncrRefCount(objPtr);
CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
@@ -889,13 +883,13 @@ Tcl_ScanObjCmd(
i = (int)sch;
#if TCL_UTF_MAX == 4
if (!offset) {
- offset = Tcl_UtfToUniChar(string, &sch);
+ offset = TclUtfToUniChar(string, &sch);
i = (((i<<10) & 0x0FFC00) + 0x10000) + (sch & 0x3FF);
}
#endif
string += offset;
if (!(flags & SCAN_SUPPRESS)) {
- objPtr = Tcl_NewIntObj(i);
+ objPtr = Tcl_NewWideIntObj(i);
Tcl_IncrRefCount(objPtr);
CLANG_ASSERT(objs);
objs[objIndex++] = objPtr;
@@ -906,7 +900,7 @@ Tcl_ScanObjCmd(
/*
* Scan an unsigned or signed integer.
*/
- objPtr = Tcl_NewLongObj(0);
+ objPtr = Tcl_NewWideIntObj(0);
Tcl_IncrRefCount(objPtr);
if (width == 0) {
width = ~0;
@@ -932,19 +926,42 @@ Tcl_ScanObjCmd(
}
if (flags & SCAN_LONGER) {
if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
- wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */
+ wideValue = WIDE_MAX;
if (TclGetString(objPtr)[0] == '-') {
- wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */
+ wideValue = WIDE_MIN;
}
}
if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
- sprintf(buf, "%" TCL_LL_MODIFIER "u",
- (Tcl_WideUInt)wideValue);
+ sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue);
Tcl_SetStringObj(objPtr, buf, -1);
} else {
- Tcl_SetWideIntObj(objPtr, wideValue);
+ TclSetIntObj(objPtr, wideValue);
}
- } else if (!(flags & SCAN_BIG)) {
+ } else if (flags & SCAN_BIG) {
+ if (flags & SCAN_UNSIGNED) {
+ mp_int big;
+ int code = Tcl_GetBignumFromObj(interp, objPtr, &big);
+
+ if (code == TCL_OK) {
+ if (mp_isneg(&big)) {
+ code = TCL_ERROR;
+ }
+ mp_clear(&big);
+ }
+
+ if (code == TCL_ERROR) {
+ if (objs != NULL) {
+ ckfree(objs);
+ }
+ Tcl_DecrRefCount(objPtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT",
+ "BADUNSIGNED",NULL);
+ return TCL_ERROR;
+ }
+ }
+ } else {
if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
@@ -956,7 +973,7 @@ Tcl_ScanObjCmd(
sprintf(buf, "%lu", value); /* INTL: ISO digit */
Tcl_SetStringObj(objPtr, buf, -1);
} else {
- Tcl_SetLongObj(objPtr, value);
+ TclSetIntObj(objPtr, value);
}
}
objs[objIndex++] = objPtr;
@@ -992,8 +1009,10 @@ Tcl_ScanObjCmd(
double dvalue;
if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
#ifdef ACCEPT_NAN
- if (objPtr->typePtr == &tclDoubleType) {
- dvalue = objPtr->internalRep.doubleValue;
+ const Tcl_ObjIntRep *irPtr
+ = TclFetchIntRep(objPtr, &tclDoubleType);
+ if (irPtr) {
+ dvalue = irPtr->doubleValue;
} else
#endif
{
@@ -1062,7 +1081,7 @@ Tcl_ScanObjCmd(
if (code == TCL_OK) {
if (underflow && (nconversions == 0)) {
if (numVars) {
- objPtr = Tcl_NewIntObj(-1);
+ objPtr = Tcl_NewWideIntObj(-1);
} else {
if (objPtr) {
Tcl_SetListObj(objPtr, 0, NULL);
@@ -1071,7 +1090,7 @@ Tcl_ScanObjCmd(
}
}
} else if (numVars) {
- objPtr = Tcl_NewIntObj(result);
+ objPtr = Tcl_NewWideIntObj(result);
}
Tcl_SetObjResult(interp, objPtr);
}
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 5d601e4..a46b29a 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -18,13 +18,6 @@
#include <math.h>
/*
- * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
- * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
- */
-
-#undef KILL_OCTAL
-
-/*
* This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
* floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
* uniquely determined by radix and by the widths of significand and exponent.
@@ -489,7 +482,7 @@ TclParseNumber(
{
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
- ZERO_O, ZERO_B, BINARY,
+ ZERO_O, ZERO_B, ZERO_D, BINARY,
HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
LEADING_RADIX_POINT, FRACTION,
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
@@ -546,6 +539,20 @@ TclParseNumber(
*/
if (bytes == NULL) {
+ if (interp == NULL && endPtrPtr == NULL) {
+ if (objPtr->typePtr == &tclDictType) {
+ /* A dict can never be a (single) number */
+ return TCL_ERROR;
+ }
+ if (objPtr->typePtr == &tclListType) {
+ int length;
+ /* A list can only be a (single) number if its length == 1 */
+ TclListObjLength(NULL, objPtr, &length);
+ if (length != 1) {
+ return TCL_ERROR;
+ }
+ }
+ }
bytes = TclGetString(objPtr);
}
@@ -657,7 +664,11 @@ TclParseNumber(
state = ZERO_O;
break;
}
-#ifdef KILL_OCTAL
+ if (c == 'd' || c == 'D') {
+ state = ZERO_D;
+ break;
+ }
+#ifdef TCL_NO_DEPRECATED
goto decimal;
#endif
/* FALLTHROUGH */
@@ -700,7 +711,7 @@ TclParseNumber(
|| (octalSignificandWide >
(~(Tcl_WideUInt)0 >> shift)))) {
octalSignificandOverflow = 1;
- TclBNInitBignumFromWideUInt(&octalSignificandBig,
+ TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
}
}
@@ -740,7 +751,7 @@ TclParseNumber(
goto endgame;
}
-#ifndef KILL_OCTAL
+#ifndef TCL_NO_DEPRECATED
/*
* Scanned a number with a leading zero that contains an 8, 9,
@@ -817,7 +828,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (~(Tcl_WideUInt)0 >> shift))) {
significandOverflow = 1;
- TclBNInitBignumFromWideUInt(&significandBig,
+ TclInitBignumFromWideUInt(&significandBig,
significandWide);
}
}
@@ -858,7 +869,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (~(Tcl_WideUInt)0 >> shift))) {
significandOverflow = 1;
- TclBNInitBignumFromWideUInt(&significandBig,
+ TclInitBignumFromWideUInt(&significandBig,
significandWide);
}
}
@@ -873,13 +884,23 @@ TclParseNumber(
state = BINARY;
break;
+ case ZERO_D:
+ if (c == '0') {
+ numTrailZeros++;
+ } else if ( ! isdigit(UCHAR(c))) {
+ goto endgame;
+ }
+ state = DECIMAL;
+ flags |= TCL_PARSE_INTEGER_ONLY;
+ /* FALLTHROUGH */
+
case DECIMAL:
/*
* Scanned an optional + or - followed by a string of decimal
* digits.
*/
-#ifdef KILL_OCTAL
+#ifdef TCL_NO_DEPRECATED
decimal:
#endif
acceptState = state;
@@ -1169,6 +1190,7 @@ TclParseNumber(
case ZERO_X:
case ZERO_O:
case ZERO_B:
+ case ZERO_D:
case LEADING_RADIX_POINT:
case EXPONENT_START:
case EXPONENT_SIGNUM:
@@ -1192,7 +1214,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
- TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+ TclInitBignumFromWideUInt(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
@@ -1213,7 +1235,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
significandWide > (MOST_BITS + signum) >> shift)) {
significandOverflow = 1;
- TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+ TclInitBignumFromWideUInt(&significandBig, significandWide);
}
if (shift) {
if (!significandOverflow) {
@@ -1234,7 +1256,7 @@ TclParseNumber(
((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
octalSignificandWide > (MOST_BITS + signum) >> shift)) {
octalSignificandOverflow = 1;
- TclBNInitBignumFromWideUInt(&octalSignificandBig,
+ TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
}
if (shift) {
@@ -1246,32 +1268,18 @@ TclParseNumber(
}
}
if (!octalSignificandOverflow) {
- if (octalSignificandWide >
- (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
-#ifndef TCL_WIDE_INT_IS_LONG
- if (octalSignificandWide <= (MOST_BITS + signum)) {
- objPtr->typePtr = &tclWideIntType;
- if (signum) {
- objPtr->internalRep.wideValue =
- - (Tcl_WideInt) octalSignificandWide;
- } else {
- objPtr->internalRep.wideValue =
- (Tcl_WideInt) octalSignificandWide;
- }
- break;
- }
-#endif
- TclBNInitBignumFromWideUInt(&octalSignificandBig,
+ if (octalSignificandWide > (MOST_BITS + signum)) {
+ TclInitBignumFromWideUInt(&octalSignificandBig,
octalSignificandWide);
octalSignificandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
- objPtr->internalRep.longValue =
- - (long) octalSignificandWide;
+ objPtr->internalRep.wideValue =
+ - (Tcl_WideInt) octalSignificandWide;
} else {
- objPtr->internalRep.longValue =
- (long) octalSignificandWide;
+ objPtr->internalRep.wideValue =
+ (Tcl_WideInt) octalSignificandWide;
}
}
}
@@ -1289,36 +1297,22 @@ TclParseNumber(
&significandWide, &significandBig, significandOverflow);
if (!significandOverflow && (significandWide > MOST_BITS+signum)){
significandOverflow = 1;
- TclBNInitBignumFromWideUInt(&significandBig, significandWide);
+ TclInitBignumFromWideUInt(&significandBig, significandWide);
}
returnInteger:
if (!significandOverflow) {
- if (significandWide >
- (Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
-#ifndef TCL_WIDE_INT_IS_LONG
- if (significandWide <= MOST_BITS+signum) {
- objPtr->typePtr = &tclWideIntType;
- if (signum) {
- objPtr->internalRep.wideValue =
- - (Tcl_WideInt) significandWide;
- } else {
- objPtr->internalRep.wideValue =
- (Tcl_WideInt) significandWide;
- }
- break;
- }
-#endif
- TclBNInitBignumFromWideUInt(&significandBig,
+ if (significandWide > MOST_BITS+signum) {
+ TclInitBignumFromWideUInt(&significandBig,
significandWide);
significandOverflow = 1;
} else {
objPtr->typePtr = &tclIntType;
if (signum) {
- objPtr->internalRep.longValue =
- - (long) significandWide;
+ objPtr->internalRep.wideValue =
+ - (Tcl_WideInt) significandWide;
} else {
- objPtr->internalRep.longValue =
- (long) significandWide;
+ objPtr->internalRep.wideValue =
+ (Tcl_WideInt) significandWide;
}
}
}
@@ -1463,7 +1457,7 @@ AccumulateDecimalDigit(
* bignum and fall through into the bignum case.
*/
- TclBNInitBignumFromWideUInt(bignumRepPtr, w);
+ TclInitBignumFromWideUInt(bignumRepPtr, w);
} else {
/*
* Wide multiplication.
@@ -1606,7 +1600,7 @@ MakeLowPrecisionDouble(
* call MakeHighPrecisionDouble to do it the hard way.
*/
- TclBNInitBignumFromWideUInt(&significandBig, significand);
+ TclInitBignumFromWideUInt(&significandBig, significand);
retval = MakeHighPrecisionDouble(0, &significandBig, numSigDigs,
exponent);
mp_clear(&significandBig);
@@ -3293,7 +3287,7 @@ ShorteningBignumConversionPowD(
* mminus = 5**m5
*/
- TclBNInitBignumFromWideUInt(&b, bw);
+ TclInitBignumFromWideUInt(&b, bw);
mp_init_set_int(&mminus, 1);
MulPow5(&b, b5, &b);
mp_mul_2d(&b, b2, &b);
@@ -3480,7 +3474,7 @@ StrictBignumConversionPowD(
* b = bw * 2**b2 * 5**b5
*/
- TclBNInitBignumFromWideUInt(&b, bw);
+ TclInitBignumFromWideUInt(&b, bw);
MulPow5(&b, b5, &b);
mp_mul_2d(&b, b2, &b);
@@ -3688,7 +3682,7 @@ ShorteningBignumConversion(
* S = 2**s2 * 5*s5
*/
- TclBNInitBignumFromWideUInt(&b, bw);
+ TclInitBignumFromWideUInt(&b, bw);
mp_mul_2d(&b, b2, &b);
mp_init_set_int(&S, 1);
MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
@@ -3901,7 +3895,7 @@ StrictBignumConversion(
*/
mp_init_multi(&temp, &dig, NULL);
- TclBNInitBignumFromWideUInt(&b, bw);
+ TclInitBignumFromWideUInt(&b, bw);
mp_mul_2d(&b, b2, &b);
mp_init_set_int(&S, 1);
MulPow5(&S, s5, &S); mp_mul_2d(&S, s2, &S);
@@ -4549,7 +4543,7 @@ Tcl_InitBignumFromDouble(
return TCL_ERROR;
}
- fract = frexp(d,&expt);
+ fract = frexp(d, &expt);
if (expt <= 0) {
mp_init(b);
mp_zero(b);
@@ -4557,7 +4551,7 @@ Tcl_InitBignumFromDouble(
Tcl_WideInt w = (Tcl_WideInt) ldexp(fract, mantBits);
int shift = expt - mantBits;
- TclBNInitBignumFromWideInt(b, w);
+ TclInitBignumFromWideInt(b, w);
if (shift < 0) {
mp_div_2d(b, -shift, b, NULL);
} else if (shift > 0) {
@@ -4703,7 +4697,7 @@ TclCeil(
mp_int b;
mp_init(&b);
- if (mp_cmp_d(a, 0) == MP_LT) {
+ if (mp_isneg(a)) {
mp_neg(a, &b);
r = -TclFloor(&b);
} else {
@@ -4760,7 +4754,7 @@ TclFloor(
mp_int b;
mp_init(&b);
- if (mp_cmp_d(a, 0) == MP_LT) {
+ if (mp_isneg(a)) {
mp_neg(a, &b);
r = -TclCeil(&b);
} else {
@@ -4889,7 +4883,7 @@ Pow10TimesFrExp(
* Multiply by 10**exponent.
*/
- retval = frexp(retval * pow10vals[exponent&0xf], &j);
+ retval = frexp(retval * pow10vals[exponent & 0xf], &j);
expt += j;
for (i=4; i<9; ++i) {
if (exponent & (1<<i)) {
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 72e4a3d..b6fa5fa 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -38,15 +38,7 @@
#include "tommath.h"
#include "tclStringRep.h"
-/*
- * Set COMPAT to 1 to restore the shimmering patterns to those of Tcl 8.5.
- * This is an escape hatch in case the changes have some unexpected unwelcome
- * impact on performance. If things go well, this mechanism can go away when
- * post-8.6 development begins.
- */
-
-#define COMPAT 0
-
+#include "assert.h"
/*
* Prototypes for functions defined later in this file:
*/
@@ -145,12 +137,12 @@ GrowStringBuffer(
char *ptr = NULL;
int attempt;
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
- attempt = 2 * needed;
- if (attempt >= 0) {
+ if (needed <= INT_MAX / 2) {
+ attempt = 2 * needed;
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
@@ -199,8 +191,8 @@ GrowUnicodeBuffer(
* Subsequent appends - apply the growth algorithm.
*/
- attempt = 2 * needed;
- if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
+ if (needed <= STRING_MAXCHARS / 2) {
+ attempt = 2 * needed;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
@@ -418,23 +410,32 @@ Tcl_GetCharLength(
int numChars;
/*
+ * Quick, no-shimmer return for short string reps.
+ */
+
+ if ((objPtr->bytes) && (objPtr->length < 2)) {
+ /* 0 bytes -> 0 chars; 1 byte -> 1 char */
+ return objPtr->length;
+ }
+
+ /*
* Optimize the case where we're really dealing with a bytearray object;
* we don't need to convert to a string to perform the get-length operation.
*
- * NOTE that we do not need the bytearray to be "pure". A ByteArray value
- * with a string rep cannot be trusted to represent the same value as the
- * string rep, but it *can* be trusted to have the same character length
- * as the string rep, which is all this routine cares about.
+ * Starting in Tcl 8.7, we check for a "pure" bytearray, because the
+ * machinery behind that test is using a proper bytearray ObjType. We
+ * could also compute length of an improper bytearray without shimmering
+ * but there's no value in that. We *want* to shimmer an improper bytearray
+ * because improper bytearrays have worthless internal reps.
*/
- if (objPtr->typePtr == &tclByteArrayType) {
+ if (TclIsPureByteArray(objPtr)) {
int length;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
return length;
}
-
/*
* OK, need to work with the object as a string.
*/
@@ -450,23 +451,9 @@ Tcl_GetCharLength(
if (numChars == -1) {
TclNumUtfChars(numChars, objPtr->bytes, objPtr->length);
stringPtr->numChars = numChars;
-
-#if COMPAT
- if (numChars < objPtr->length) {
- /*
- * Since we've just computed the number of chars, and not all UTF
- * chars are 1-byte long, go ahead and populate the unicode
- * string.
- */
-
- FillUnicodeRep(objPtr);
- }
-#endif
}
return numChars;
}
-
-
/*
*----------------------------------------------------------------------
@@ -485,16 +472,16 @@ Tcl_GetCharLength(
*----------------------------------------------------------------------
*/
int
-TclCheckEmptyString (
- Tcl_Obj *objPtr
-) {
+TclCheckEmptyString(
+ Tcl_Obj *objPtr)
+{
int length = -1;
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
return TCL_EMPTYSTRING_YES;
}
- if (TclIsPureList(objPtr)) {
+ if (TclListObjIsCanonical(objPtr)) {
Tcl_ListObjLength(NULL, objPtr, &length);
return length == 0;
}
@@ -503,7 +490,7 @@ TclCheckEmptyString (
Tcl_DictObjSize(NULL, objPtr, &length);
return length == 0;
}
-
+
if (objPtr->bytes == NULL) {
return TCL_EMPTYSTRING_UNKNOWN;
}
@@ -515,8 +502,9 @@ TclCheckEmptyString (
*
* Tcl_GetUniChar --
*
- * Get the index'th Unicode character from the String object. The index
- * is assumed to be in the appropriate range.
+ * Get the index'th Unicode character from the String object. If index
+ * is out of range or it references a low surrogate preceded by a high
+ * surrogate, the result = -1;
*
* Results:
* Returns the index'th Unicode character in the Object.
@@ -527,24 +515,31 @@ TclCheckEmptyString (
*----------------------------------------------------------------------
*/
-Tcl_UniChar
+int
Tcl_GetUniChar(
Tcl_Obj *objPtr, /* The object to get the Unicode charater
* from. */
int index) /* Get the index'th Unicode character. */
{
String *stringPtr;
+ int ch, length;
+
+ if (index < 0) {
+ return -1;
+ }
/*
* Optimize the case where we're really dealing with a bytearray object
- * without string representation; we don't need to convert to a string to
- * perform the indexing operation.
+ * we don't need to convert to a string to perform the indexing operation.
*/
if (TclIsPureByteArray(objPtr)) {
- unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
+ if (index >= length) {
+ return -1;
+ }
- return (Tcl_UniChar) bytes[index];
+ return (int) bytes[index];
}
/*
@@ -568,7 +563,28 @@ Tcl_GetUniChar(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
- return stringPtr->unicode[index];
+
+ if (index >= stringPtr->numChars) {
+ return -1;
+ }
+ ch = stringPtr->unicode[index];
+#if TCL_UTF_MAX <= 4
+ /* See: bug [11ae2be95dac9417] */
+ if ((ch & 0xF800) == 0xD800) {
+ if (ch & 0x400) {
+ if ((index > 0)
+ && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
+ ch = -1; /* low surrogate preceded by high surrogate */
+ }
+ } else if ((++index < stringPtr->numChars)
+ && ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
+ /* high surrogate followed by low surrogate */
+ ch = (((ch & 0x3FF) << 10) |
+ (stringPtr->unicode[index] & 0x3FF)) + 0x10000;
+ }
+ }
+#endif
+ return ch;
}
/*
@@ -590,6 +606,8 @@ Tcl_GetUniChar(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
+#undef Tcl_GetUnicode
Tcl_UniChar *
Tcl_GetUnicode(
Tcl_Obj *objPtr) /* The object to find the unicode string
@@ -597,6 +615,7 @@ Tcl_GetUnicode(
{
return Tcl_GetUnicodeFromObj(objPtr, NULL);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -668,17 +687,27 @@ Tcl_GetRange(
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
+ int length;
+
+ if (first < 0) {
+ first = 0;
+ }
/*
* Optimize the case where we're really dealing with a bytearray object
- * without string representation; we don't need to convert to a string to
- * perform the substring operation.
+ * we don't need to convert to a string to perform the substring operation.
*/
if (TclIsPureByteArray(objPtr)) {
- unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, NULL);
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
- return Tcl_NewByteArrayObj(bytes+first, last-first+1);
+ if (last >= length) {
+ last = length - 1;
+ }
+ if (last < first) {
+ return Tcl_NewObj();
+ }
+ return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
}
/*
@@ -697,6 +726,12 @@ Tcl_GetRange(
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
+ if (last >= stringPtr->numChars) {
+ last = stringPtr->numChars - 1;
+ }
+ if (last < first) {
+ return Tcl_NewObj();
+ }
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
/*
@@ -711,19 +746,25 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
-
-#if TCL_UTF_MAX == 4
- /* See: bug [11ae2be95dac9417] */
- if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
- && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
- ++first;
- }
- if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
- && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
- ++last;
- }
+ if (last > stringPtr->numChars) {
+ last = stringPtr->numChars;
+ }
+ if (last < first) {
+ return Tcl_NewObj();
+ }
+#if TCL_UTF_MAX <= 4
+ /* See: bug [11ae2be95dac9417] */
+ if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
+ && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
+ ++first;
+ }
+ if ((last + 1 < stringPtr->numChars)
+ && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
+ && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
+ ++last;
+ }
#endif
- return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
+ return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
}
/*
@@ -839,7 +880,7 @@ Tcl_SetObjLength(
/*
* Need to enlarge the buffer.
*/
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
objPtr->bytes = ckalloc(length + 1);
} else {
objPtr->bytes = ckrealloc(objPtr->bytes, length + 1);
@@ -945,7 +986,7 @@ Tcl_AttemptSetObjLength(
char *newBytes;
- if (objPtr->bytes == tclEmptyStringRep) {
+ if (objPtr->bytes == &tclEmptyString) {
newBytes = attemptckalloc(length + 1);
} else {
newBytes = attemptckrealloc(objPtr->bytes, length + 1);
@@ -1233,11 +1274,7 @@ Tcl_AppendUnicodeToObj(
* objPtr's string rep.
*/
- if (stringPtr->hasUnicode
-#if COMPAT
- && stringPtr->numChars > 0
-#endif
- ) {
+ if (stringPtr->hasUnicode) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -1278,52 +1315,58 @@ Tcl_AppendObjToObj(
* that appending nothing to anything leaves that starting anything...
*/
- if (appendObjPtr->bytes == tclEmptyStringRep) {
+ if (appendObjPtr->bytes == &tclEmptyString) {
return;
}
/*
* Handle append of one bytearray object to another as a special case.
- * Note that we only do this when the objects don't have string reps; if
- * it did, then appending the byte arrays together could well lose
- * information; this is a special-case optimization only.
+ * Note that we only do this when the objects are pure so that the
+ * bytearray faithfully represent the true value; Otherwise appending the
+ * byte arrays together could lose information;
*/
- if ((TclIsPureByteArray(objPtr) || objPtr->bytes == tclEmptyStringRep)
+ if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
&& TclIsPureByteArray(appendObjPtr)) {
-
/*
* You might expect the code here to be
*
* bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
* TclAppendBytesToByteArray(objPtr, bytes, length);
*
- * and essentially all of the time that would be fine. However,
- * it would run into trouble in the case where objPtr and
- * appendObjPtr point to the same thing. That may never be a
- * good idea. It seems to violate Copy On Write, and we don't
- * have any tests for the situation, since making any Tcl commands
- * that call Tcl_AppendObjToObj() do that appears impossible
- * (They honor Copy On Write!). For the sake of extensions that
- * go off into that realm, though, here's a more complex approach
- * that can handle all the cases.
+ * and essentially all of the time that would be fine. However, it
+ * would run into trouble in the case where objPtr and appendObjPtr
+ * point to the same thing. That may never be a good idea. It seems to
+ * violate Copy On Write, and we don't have any tests for the
+ * situation, since making any Tcl commands that call
+ * Tcl_AppendObjToObj() do that appears impossible (They honor Copy On
+ * Write!). For the sake of extensions that go off into that realm,
+ * though, here's a more complex approach that can handle all the
+ * cases.
+ *
+ * First, get the lengths.
*/
- /* Get lengths */
int lengthSrc;
(void) Tcl_GetByteArrayFromObj(objPtr, &length);
(void) Tcl_GetByteArrayFromObj(appendObjPtr, &lengthSrc);
- /* Grow buffer enough for the append */
+ /*
+ * Grow buffer enough for the append.
+ */
+
TclAppendBytesToByteArray(objPtr, NULL, lengthSrc);
- /* Reset objPtr back to the original value */
+ /*
+ * Reset objPtr back to the original value.
+ */
+
Tcl_SetByteArrayLength(objPtr, length);
/*
- * Now do the append knowing that buffer growth cannot cause
- * any trouble.
+ * Now do the append knowing that buffer growth cannot cause any
+ * trouble.
*/
TclAppendBytesToByteArray(objPtr,
@@ -1343,11 +1386,7 @@ Tcl_AppendObjToObj(
* appendObjPtr and append it.
*/
- if (stringPtr->hasUnicode
-#if COMPAT
- && stringPtr->numChars > 0
-#endif
- ) {
+ if (stringPtr->hasUnicode) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
@@ -1375,16 +1414,13 @@ Tcl_AppendObjToObj(
numChars = stringPtr->numChars;
if ((numChars >= 0) && (appendObjPtr->typePtr == &tclStringType)) {
String *appendStringPtr = GET_STRING(appendObjPtr);
+
appendNumChars = appendStringPtr->numChars;
}
AppendUtfToUtfRep(objPtr, bytes, length);
- if (numChars >= 0 && appendNumChars >= 0
-#if COMPAT
- && appendNumChars == length
-#endif
- ) {
+ if (numChars >= 0 && appendNumChars >= 0) {
stringPtr->numChars = numChars + appendNumChars;
}
}
@@ -1508,14 +1544,6 @@ AppendUnicodeToUtfRep(
if (stringPtr->numChars != -1) {
stringPtr->numChars += numChars;
}
-
-#if COMPAT
- /*
- * Invalidate the unicode rep.
- */
-
- stringPtr->hasUnicode = 0;
-#endif
}
/*
@@ -1963,6 +1991,25 @@ Tcl_AppendFormatToObj(
useWide = 1;
#endif
}
+ } else if (ch == 'I') {
+ if ((format[1] == '6') && (format[2] == '4')) {
+ format += (step + 2);
+ step = TclUtfToUniChar(format, &ch);
+#ifndef TCL_WIDE_INT_IS_LONG
+ useWide = 1;
+#endif
+ } else if ((format[1] == '3') && (format[2] == '2')) {
+ format += (step + 2);
+ step = TclUtfToUniChar(format, &ch);
+ } else {
+ format += step;
+ step = TclUtfToUniChar(format, &ch);
+ }
+ } else if ((ch == 't') || (ch == 'z') || (ch == 'q') || (ch == 'j')
+ || (ch == 'L')) {
+ format += step;
+ step = TclUtfToUniChar(format, &ch);
+ useBig = 1;
}
format += step;
@@ -1994,19 +2041,17 @@ Tcl_AppendFormatToObj(
}
break;
case 'c': {
- char buf[TCL_UTF_MAX];
+ char buf[4];
int code, length;
if (TclGetIntFromObj(interp, segment, &code) != TCL_OK) {
goto error;
}
length = Tcl_UniCharToUtf(code, buf);
-#if TCL_UTF_MAX > 3
if (!length) {
/* Special case for handling high surrogates. */
length = Tcl_UniCharToUtf(-1, buf);
}
-#endif
segment = Tcl_NewStringObj(buf, length);
Tcl_IncrRefCount(segment);
allocSegment = 1;
@@ -2014,13 +2059,9 @@ Tcl_AppendFormatToObj(
}
case 'u':
- if (useBig) {
- msg = "unsigned bignum format is invalid";
- errCode = "BADUNSIGNED";
- goto errorMsg;
- }
case 'd':
case 'o':
+ case 'p':
case 'x':
case 'X':
case 'b': {
@@ -2031,53 +2072,58 @@ Tcl_AppendFormatToObj(
mp_int big;
int toAppend, isNegative = 0;
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (ch == 'p') {
+ useWide = 1;
+ }
+#endif
if (useBig) {
+ int cmpResult;
if (Tcl_GetBignumFromObj(interp, segment, &big) != TCL_OK) {
goto error;
}
- isNegative = (mp_cmp_d(&big, 0) == MP_LT);
+ cmpResult = mp_cmp_d(&big, 0);
+ isNegative = (cmpResult == MP_LT);
+ if (cmpResult == MP_EQ) gotHash = 0;
+ if (ch == 'u') {
+ if (isNegative) {
+ mp_clear(&big);
+ msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
+ goto errorMsg;
+ } else {
+ ch = 'd';
+ }
+ }
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
- if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
- Tcl_Obj *objPtr;
-
- if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
- goto error;
- }
- mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
- objPtr = Tcl_NewBignumObj(&big);
- Tcl_IncrRefCount(objPtr);
- Tcl_GetWideIntFromObj(NULL, objPtr, &w);
- Tcl_DecrRefCount(objPtr);
+ if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
+ goto error;
}
isNegative = (w < (Tcl_WideInt) 0);
+ if (w == (Tcl_WideInt) 0) gotHash = 0;
#endif
} else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
- if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
- Tcl_Obj *objPtr;
-
- if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
- goto error;
- }
- mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
- objPtr = Tcl_NewBignumObj(&big);
- Tcl_IncrRefCount(objPtr);
- TclGetLongFromObj(NULL, objPtr, &l);
- Tcl_DecrRefCount(objPtr);
+ if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
+ goto error;
} else {
- l = Tcl_WideAsLong(w);
+ l = (long) w;
}
if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
+ if (s == (short) 0) gotHash = 0;
} else {
isNegative = (l < (long) 0);
+ if (l == (long) 0) gotHash = 0;
}
} else if (useShort) {
s = (short) l;
isNegative = (s < (short) 0);
+ if (s == (short) 0) gotHash = 0;
} else {
isNegative = (l < (long) 0);
+ if (l == (long) 0) gotHash = 0;
}
segment = Tcl_NewObj();
@@ -2091,18 +2137,15 @@ Tcl_AppendFormatToObj(
segmentLimit -= 1;
}
- if (gotHash) {
+ if (gotHash || (ch == 'p')) {
switch (ch) {
case 'o':
- Tcl_AppendToObj(segment, "0", 1);
- segmentLimit -= 1;
- precision--;
- break;
- case 'X':
- Tcl_AppendToObj(segment, "0X", 2);
+ Tcl_AppendToObj(segment, "0o", 2);
segmentLimit -= 2;
break;
+ case 'p':
case 'x':
+ case 'X':
Tcl_AppendToObj(segment, "0x", 2);
segmentLimit -= 2;
break;
@@ -2110,6 +2153,14 @@ Tcl_AppendFormatToObj(
Tcl_AppendToObj(segment, "0b", 2);
segmentLimit -= 2;
break;
+#if TCL_MAJOR_VERSION < 9
+ case 'd':
+ if (gotZero) {
+ Tcl_AppendToObj(segment, "0d", 2);
+ segmentLimit -= 2;
+ }
+ break;
+#endif
}
}
@@ -2120,7 +2171,7 @@ Tcl_AppendFormatToObj(
const char *bytes;
if (useShort) {
- pure = Tcl_NewIntObj((int) s);
+ pure = Tcl_NewWideIntObj(s);
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
pure = Tcl_NewWideIntObj(w);
@@ -2128,7 +2179,7 @@ Tcl_AppendFormatToObj(
} else if (useBig) {
pure = Tcl_NewBignumObj(&big);
} else {
- pure = Tcl_NewLongObj(l);
+ pure = Tcl_NewWideIntObj(l);
}
Tcl_IncrRefCount(pure);
bytes = TclGetStringFromObj(pure, &length);
@@ -2181,6 +2232,7 @@ Tcl_AppendFormatToObj(
case 'u':
case 'o':
+ case 'p':
case 'x':
case 'X':
case 'b': {
@@ -2246,7 +2298,7 @@ Tcl_AppendFormatToObj(
* Need to be sure zero becomes "0", not "".
*/
- if ((numDigits == 0) && !((ch == 'o') && gotHash)) {
+ if (numDigits == 0) {
numDigits = 1;
}
pure = Tcl_NewObj();
@@ -2313,6 +2365,8 @@ Tcl_AppendFormatToObj(
break;
}
+ case 'a':
+ case 'A':
case 'e':
case 'E':
case 'f':
@@ -2381,6 +2435,12 @@ Tcl_AppendFormatToObj(
errCode = "OVERFLOW";
goto errorMsg;
}
+ if (ch == 'A') {
+ char *p = TclGetString(segment) + 1;
+ *p = 'x';
+ p = strchr(p, 'P');
+ if (p) *p = 'p';
+ }
break;
}
default:
@@ -2457,7 +2517,7 @@ Tcl_AppendFormatToObj(
/*
*---------------------------------------------------------------------------
*
- * Tcl_Format--
+ * Tcl_Format --
*
* Results:
* A refcount zero Tcl_Obj.
@@ -2568,33 +2628,49 @@ AppendPrintfToObjVA(
case 'u':
case 'd':
case 'o':
+ case 'p':
case 'x':
case 'X':
seekingConversion = 0;
switch (size) {
case -1:
case 0:
- Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
- (long) va_arg(argList, int)));
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
+ va_arg(argList, int)));
break;
case 1:
- Tcl_ListObjAppendElement(NULL, list, Tcl_NewLongObj(
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
va_arg(argList, long)));
break;
+ case 2:
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(
+ va_arg(argList, Tcl_WideInt)));
+ break;
+ case 3:
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewBignumObj(
+ va_arg(argList, mp_int *)));
+ break;
}
break;
+ case 'a':
+ case 'A':
case 'e':
case 'E':
case 'f':
case 'g':
case 'G':
+ if (size > 0) {
Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
- va_arg(argList, double)));
+ (double)va_arg(argList, long double)));
+ } else {
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewDoubleObj(
+ va_arg(argList, double)));
+ }
seekingConversion = 0;
break;
case '*':
lastNum = (int) va_arg(argList, int);
- Tcl_ListObjAppendElement(NULL, list, Tcl_NewIntObj(lastNum));
+ Tcl_ListObjAppendElement(NULL, list, Tcl_NewWideIntObj(lastNum));
p++;
break;
case '0': case '1': case '2': case '3': case '4':
@@ -2609,9 +2685,35 @@ AppendPrintfToObjVA(
gotPrecision = 1;
p++;
break;
- /* TODO: support for wide (and bignum?) arguments */
case 'l':
- size = 1;
+ ++size;
+ p++;
+ break;
+ case 't':
+ case 'z':
+ if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
+ size = 2;
+ }
+ p++;
+ break;
+ case 'j':
+ case 'q':
+ size = 2;
+ p++;
+ break;
+ case 'I':
+ if (p[1]=='6' && p[2]=='4') {
+ p += 2;
+ size = 2;
+ } else if (p[1]=='3' && p[2]=='2') {
+ p += 2;
+ } else if (sizeof(size_t) == sizeof(Tcl_WideInt)) {
+ size = 2;
+ }
+ p++;
+ break;
+ case 'L':
+ size = 3;
p++;
break;
case 'h':
@@ -2718,17 +2820,909 @@ TclGetStringStorage(
*sizePtr = stringPtr->allocated;
return objPtr->bytes;
}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringRepeat --
+ *
+ * Performs the [string repeat] function.
+ *
+ * Results:
+ * A (Tcl_Obj *) pointing to the result value, or NULL in case of an
+ * error.
+ *
+ * Side effects:
+ * On error, when interp is not NULL, error information is left in it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclStringRepeat(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ int count,
+ int flags)
+{
+ Tcl_Obj *objResultPtr;
+ int inPlace = flags & TCL_STRING_IN_PLACE;
+ int length = 0, unichar = 0, done = 1;
+ int binary = TclIsPureByteArray(objPtr);
+
+ /* assert (count >= 2) */
+
+ /*
+ * Analyze to determine what representation result should be.
+ * GOALS: Avoid shimmering & string rep generation.
+ * Produce pure bytearray when possible.
+ * Error on overflow.
+ */
+
+ if (!binary) {
+ if (objPtr->typePtr == &tclStringType) {
+ String *stringPtr = GET_STRING(objPtr);
+ if (stringPtr->hasUnicode) {
+ unichar = 1;
+ }
+ }
+ }
+
+ if (binary) {
+ /* Result will be pure byte array. Pre-size it */
+ Tcl_GetByteArrayFromObj(objPtr, &length);
+ } else if (unichar) {
+ /* Result will be pure Tcl_UniChar array. Pre-size it. */
+ Tcl_GetUnicodeFromObj(objPtr, &length);
+ } else {
+ /* Result will be concat of string reps. Pre-size it. */
+ Tcl_GetStringFromObj(objPtr, &length);
+ }
+
+ if (length == 0) {
+ /* Any repeats of empty is empty. */
+ return objPtr;
+ }
+
+ if (count > INT_MAX/length) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+
+ if (binary) {
+ /* Efficiently produce a pure byte array result */
+ objResultPtr = (!inPlace || Tcl_IsShared(objPtr)) ?
+ Tcl_DuplicateObj(objPtr) : objPtr;
+
+ Tcl_SetByteArrayLength(objResultPtr, count*length); /* PANIC? */
+ Tcl_SetByteArrayLength(objResultPtr, length);
+ while (count - done > done) {
+ Tcl_AppendObjToObj(objResultPtr, objResultPtr);
+ done *= 2;
+ }
+ TclAppendBytesToByteArray(objResultPtr,
+ Tcl_GetByteArrayFromObj(objResultPtr, NULL),
+ (count - done) * length);
+ } else if (unichar) {
+ /*
+ * Efficiently produce a pure Tcl_UniChar array result.
+ */
+
+ if (!inPlace || Tcl_IsShared(objPtr)) {
+ objResultPtr = Tcl_NewUnicodeObj(Tcl_GetUnicode(objPtr), length);
+ } else {
+ TclInvalidateStringRep(objPtr);
+ objResultPtr = objPtr;
+ }
+
+ if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "string size overflow: unable to alloc %"
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(count*length)));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ Tcl_SetObjLength(objResultPtr, length);
+ while (count - done > done) {
+ Tcl_AppendObjToObj(objResultPtr, objResultPtr);
+ done *= 2;
+ }
+ Tcl_AppendUnicodeToObj(objResultPtr, Tcl_GetUnicode(objResultPtr),
+ (count - done) * length);
+ } else {
+ /*
+ * Efficiently concatenate string reps.
+ */
+
+ if (!inPlace || Tcl_IsShared(objPtr)) {
+ objResultPtr = Tcl_NewStringObj(Tcl_GetString(objPtr), length);
+ } else {
+ TclFreeIntRep(objPtr);
+ objResultPtr = objPtr;
+ }
+ if (0 == Tcl_AttemptSetObjLength(objResultPtr, count*length)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "string size overflow: unable to alloc %u bytes",
+ count*length));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ Tcl_SetObjLength(objResultPtr, length);
+ while (count - done > done) {
+ Tcl_AppendObjToObj(objResultPtr, objResultPtr);
+ done *= 2;
+ }
+ Tcl_AppendToObj(objResultPtr, Tcl_GetString(objResultPtr),
+ (count - done) * length);
+ }
+ return objResultPtr;
+}
+
/*
*---------------------------------------------------------------------------
*
- * TclStringObjReverse --
+ * TclStringCat --
+ *
+ * Performs the [string cat] function.
+ *
+ * Results:
+ * A (Tcl_Obj *) pointing to the result value, or NULL in case of an
+ * error.
+ *
+ * Side effects:
+ * On error, when interp is not NULL, error information is left in it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclStringCat(
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj * const objv[],
+ int flags)
+{
+ Tcl_Obj *objResultPtr, * const *ov;
+ int oc, length = 0, binary = 1;
+ int allowUniChar = 1, requestUniChar = 0;
+ int first = objc - 1; /* Index of first value possibly not empty */
+ int last = 0; /* Index of last value possibly not empty */
+ int inPlace = flags & TCL_STRING_IN_PLACE;
+
+ /* assert ( objc >= 0 ) */
+
+ if (objc <= 1) {
+ /* Only one or no objects; return first or empty */
+ return objc ? objv[0] : Tcl_NewObj();
+ }
+
+ /* assert ( objc >= 2 ) */
+
+ /*
+ * Analyze to determine what representation result should be.
+ * GOALS: Avoid shimmering & string rep generation.
+ * Produce pure bytearray when possible.
+ * Error on overflow.
+ */
+
+ ov = objv, oc = objc;
+ do {
+ Tcl_Obj *objPtr = *ov++;
+
+ if (TclIsPureByteArray(objPtr)) {
+ allowUniChar = 0;
+ } else if (objPtr->bytes) {
+ /* Value has a string rep. */
+ if (objPtr->length) {
+ /*
+ * Non-empty string rep. Not a pure bytearray, so we won't
+ * create a pure bytearray.
+ */
+
+ binary = 0;
+ if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
+ /* Prevent shimmer of non-string types. */
+ allowUniChar = 0;
+ }
+ }
+ } else {
+ /* assert (objPtr->typePtr != NULL) -- stork! */
+ binary = 0;
+ if (objPtr->typePtr == &tclStringType) {
+ /* Have a pure Unicode value; ask to preserve it */
+ requestUniChar = 1;
+ } else {
+ /* Have another type; prevent shimmer */
+ allowUniChar = 0;
+ }
+ }
+ } while (--oc && (binary || allowUniChar));
+
+ if (binary) {
+ /*
+ * Result will be pure byte array. Pre-size it
+ */
+
+ int numBytes;
+ ov = objv;
+ oc = objc;
+ do {
+ Tcl_Obj *objPtr = *ov++;
+
+ /*
+ * Every argument is either a bytearray with a ("pure")
+ * value we know we can safely use, or it is an empty string.
+ * We don't need to count bytes for the empty strings.
+ */
+
+ if (TclIsPureByteArray(objPtr)) {
+ Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */
+
+ if (numBytes) {
+ last = objc - oc;
+ if (length == 0) {
+ first = last;
+ } else if (numBytes > INT_MAX - length) {
+ goto overflow;
+ }
+ length += numBytes;
+ }
+ }
+ } while (--oc);
+ } else if (allowUniChar && requestUniChar) {
+ /*
+ * Result will be pure Tcl_UniChar array. Pre-size it.
+ */
+
+ ov = objv;
+ oc = objc;
+ do {
+ Tcl_Obj *objPtr = *ov++;
+
+ if ((objPtr->bytes == NULL) || (objPtr->length)) {
+ int numChars;
+
+ Tcl_GetUnicodeFromObj(objPtr, &numChars); /* PANIC? */
+ if (numChars) {
+ last = objc - oc;
+ if (length == 0) {
+ first = last;
+ } else if (numChars > INT_MAX - length) {
+ goto overflow;
+ }
+ length += numChars;
+ }
+ }
+ } while (--oc);
+ } else {
+ /* Result will be concat of string reps. Pre-size it. */
+ ov = objv; oc = objc;
+ do {
+ Tcl_Obj *pendingPtr = NULL;
+
+ /*
+ * Loop until a possibly non-empty value is reached.
+ * Keep string rep generation pending when possible.
+ */
+
+ do {
+ /* assert ( pendingPtr == NULL ) */
+ /* assert ( length == 0 ) */
+
+ Tcl_Obj *objPtr = *ov++;
+
+ if (objPtr->bytes == NULL) {
+ /* No string rep; Take the chance we can avoid making it */
+ pendingPtr = objPtr;
+ } else {
+ Tcl_GetStringFromObj(objPtr, &length); /* PANIC? */
+ }
+ } while (--oc && (length == 0) && (pendingPtr == NULL));
+
+ /*
+ * Either we found a possibly non-empty value, and we remember
+ * this index as the first and last such value so far seen,
+ * or (oc == 0) and all values are known empty,
+ * so first = last = objc - 1 signals the right quick return.
+ */
+
+ first = last = objc - oc - 1;
+
+ if (oc && (length == 0)) {
+ int numBytes;
+
+ /* assert ( pendingPtr != NULL ) */
+
+ /*
+ * There's a pending value followed by more values. Loop over
+ * remaining values generating strings until a non-empty value
+ * is found, or the pending value gets its string generated.
+ */
+
+ do {
+ Tcl_Obj *objPtr = *ov++;
+ Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
+ } while (--oc && numBytes == 0 && pendingPtr->bytes == NULL);
+
+ if (numBytes) {
+ last = objc -oc -1;
+ }
+ if (oc || numBytes) {
+ Tcl_GetStringFromObj(pendingPtr, &length);
+ }
+ if (length == 0) {
+ if (numBytes) {
+ first = last;
+ }
+ } else if (numBytes > INT_MAX - length) {
+ goto overflow;
+ }
+ length += numBytes;
+ }
+ } while (oc && (length == 0));
+
+ while (oc) {
+ int numBytes;
+ Tcl_Obj *objPtr = *ov++;
+
+ /* assert ( length > 0 && pendingPtr == NULL ) */
+
+ Tcl_GetStringFromObj(objPtr, &numBytes); /* PANIC? */
+ if (numBytes) {
+ last = objc - oc;
+ if (numBytes > INT_MAX - length) {
+ goto overflow;
+ }
+ length += numBytes;
+ }
+ --oc;
+ }
+ }
+
+ if (last <= first /*|| length == 0 */) {
+ /* Only one non-empty value or zero length; return first */
+ /* NOTE: (length == 0) implies (last <= first) */
+ return objv[first];
+ }
+
+ objv += first; objc = (last - first + 1);
+
+ if (binary) {
+ /* Efficiently produce a pure byte array result */
+ unsigned char *dst;
+
+ /*
+ * Broken interface! Byte array value routines offer no way to handle
+ * failure to allocate enough space. Following stanza may panic.
+ */
+
+ if (inPlace && !Tcl_IsShared(*objv)) {
+ int start;
+
+ objResultPtr = *objv++; objc--;
+ Tcl_GetByteArrayFromObj(objResultPtr, &start);
+ dst = Tcl_SetByteArrayLength(objResultPtr, length) + start;
+ } else {
+ objResultPtr = Tcl_NewByteArrayObj(NULL, length);
+ dst = Tcl_SetByteArrayLength(objResultPtr, length);
+ }
+ while (objc--) {
+ Tcl_Obj *objPtr = *objv++;
+
+ /*
+ * Every argument is either a bytearray with a ("pure")
+ * value we know we can safely use, or it is an empty string.
+ * We don't need to copy bytes from the empty strings.
+ */
+
+ if (TclIsPureByteArray(objPtr)) {
+ int more;
+ unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
+ memcpy(dst, src, (size_t) more);
+ dst += more;
+ }
+ }
+ } else if (allowUniChar && requestUniChar) {
+ /* Efficiently produce a pure Tcl_UniChar array result */
+ Tcl_UniChar *dst;
+
+ if (inPlace && !Tcl_IsShared(*objv)) {
+ int start;
+
+ objResultPtr = *objv++; objc--;
+
+ /* Ugly interface! Force resize of the unicode array. */
+ Tcl_GetUnicodeFromObj(objResultPtr, &start);
+ Tcl_InvalidateStringRep(objResultPtr);
+ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "concatenation failed: unable to alloc %"
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(length)));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ dst = Tcl_GetUnicode(objResultPtr) + start;
+ } else {
+ Tcl_UniChar ch = 0;
+
+ /* Ugly interface! No scheme to init array size. */
+ objResultPtr = Tcl_NewUnicodeObj(&ch, 0); /* PANIC? */
+ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
+ Tcl_DecrRefCount(objResultPtr);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "concatenation failed: unable to alloc %"
+ TCL_Z_MODIFIER "u bytes",
+ STRING_SIZE(length)));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ dst = Tcl_GetUnicode(objResultPtr);
+ }
+ while (objc--) {
+ Tcl_Obj *objPtr = *objv++;
+
+ if ((objPtr->bytes == NULL) || (objPtr->length)) {
+ int more;
+ Tcl_UniChar *src = Tcl_GetUnicodeFromObj(objPtr, &more);
+ memcpy(dst, src, more * sizeof(Tcl_UniChar));
+ dst += more;
+ }
+ }
+ } else {
+ /* Efficiently concatenate string reps */
+ char *dst;
+
+ if (inPlace && !Tcl_IsShared(*objv)) {
+ int start;
+
+ objResultPtr = *objv++; objc--;
+
+ Tcl_GetStringFromObj(objResultPtr, &start);
+ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "concatenation failed: unable to alloc %u bytes",
+ length));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ dst = Tcl_GetString(objResultPtr) + start;
+
+ /* assert ( length > start ) */
+ TclFreeIntRep(objResultPtr);
+ } else {
+ objResultPtr = Tcl_NewObj(); /* PANIC? */
+ if (0 == Tcl_AttemptSetObjLength(objResultPtr, length)) {
+ Tcl_DecrRefCount(objResultPtr);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "concatenation failed: unable to alloc %u bytes",
+ length));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ dst = Tcl_GetString(objResultPtr);
+ }
+ while (objc--) {
+ Tcl_Obj *objPtr = *objv++;
+
+ if ((objPtr->bytes == NULL) || (objPtr->length)) {
+ int more;
+ char *src = Tcl_GetStringFromObj(objPtr, &more);
+
+ memcpy(dst, src, (size_t) more);
+ dst += more;
+ }
+ }
+ /* Must NUL-terminate! */
+ *dst = '\0';
+ }
+ return objResultPtr;
+
+ overflow:
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max size for a Tcl value (%d bytes) exceeded", INT_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringCmp --
+ * Compare two Tcl_Obj values as strings.
+ *
+ * Results:
+ * Like memcmp, return -1, 0, or 1.
+ *
+ * Side effects:
+ * String representations may be generated. Internal representation may
+ * be changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclStringCmp(
+ Tcl_Obj *value1Ptr,
+ Tcl_Obj *value2Ptr,
+ int checkEq, /* comparison is only for equality */
+ int nocase, /* comparison is not case sensitive */
+ int reqlength) /* requested length */
+{
+ char *s1, *s2;
+ int empty, length, match, s1len, s2len;
+ memCmpFn_t memCmpFn;
+
+ if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
+ /*
+ * Always match at 0 chars of if it is the same obj.
+ */
+ match = 0;
+ } else {
+ if (!nocase && TclIsPureByteArray(value1Ptr)
+ && TclIsPureByteArray(value2Ptr)) {
+ /*
+ * 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... :^)
+ */
+
+ s1 = (char *) Tcl_GetByteArrayFromObj(value1Ptr, &s1len);
+ s2 = (char *) Tcl_GetByteArrayFromObj(value2Ptr, &s2len);
+ memCmpFn = memcmp;
+ } else if ((value1Ptr->typePtr == &tclStringType)
+ && (value2Ptr->typePtr == &tclStringType)) {
+ /*
+ * Do a unicode-specific comparison if both of the args are of
+ * String type. If the char length == byte length, we can do a
+ * memcmp. In benchmark testing this proved the most efficient
+ * check between the unicode and string comparison operations.
+ */
+
+ if (nocase) {
+ s1 = (char *) Tcl_GetUnicodeFromObj(value1Ptr, &s1len);
+ s2 = (char *) Tcl_GetUnicodeFromObj(value2Ptr, &s2len);
+ memCmpFn = (memCmpFn_t)Tcl_UniCharNcasecmp;
+ } else {
+ s1len = Tcl_GetCharLength(value1Ptr);
+ s2len = Tcl_GetCharLength(value2Ptr);
+ if ((s1len == value1Ptr->length)
+ && (value1Ptr->bytes != NULL)
+ && (s2len == value2Ptr->length)
+ && (value2Ptr->bytes != NULL)) {
+ s1 = value1Ptr->bytes;
+ s2 = value2Ptr->bytes;
+ memCmpFn = memcmp;
+ } else {
+ s1 = (char *) Tcl_GetUnicode(value1Ptr);
+ s2 = (char *) Tcl_GetUnicode(value2Ptr);
+ if (
+#ifdef WORDS_BIGENDIAN
+ 1
+#else
+ checkEq
+#endif
+ ) {
+ memCmpFn = memcmp;
+ s1len *= sizeof(Tcl_UniChar);
+ s2len *= sizeof(Tcl_UniChar);
+ } else {
+ memCmpFn = (memCmpFn_t) Tcl_UniCharNcmp;
+ }
+ }
+ }
+ } else {
+ empty = TclCheckEmptyString(value1Ptr);
+ if (empty > 0) {
+ switch (TclCheckEmptyString(value2Ptr)) {
+ case -1:
+ s1 = 0;
+ s1len = 0;
+ s2 = TclGetStringFromObj(value2Ptr, &s2len);
+ break;
+ case 0:
+ match = -1;
+ goto matchdone;
+ case 1:
+ default: /* avoid warn: `s2` may be used uninitialized */
+ match = 0;
+ goto matchdone;
+ }
+ } else if (TclCheckEmptyString(value2Ptr) > 0) {
+ switch (empty) {
+ case -1:
+ s2 = 0;
+ s2len = 0;
+ s1 = TclGetStringFromObj(value1Ptr, &s1len);
+ break;
+ case 0:
+ match = 1;
+ goto matchdone;
+ case 1:
+ default: /* avoid warn: `s1` may be used uninitialized */
+ match = 0;
+ goto matchdone;
+ }
+ } else {
+ s1 = TclGetStringFromObj(value1Ptr, &s1len);
+ s2 = TclGetStringFromObj(value2Ptr, &s2len);
+ }
+ if (!nocase && checkEq) {
+ /*
+ * When we have equal-length we can check only for
+ * (in)equality. We can use memcmp in all (n)eq cases because
+ * we don't need to worry about lexical LE/BE variance.
+ */
+
+ memCmpFn = memcmp;
+ } else {
+ /*
+ * As a catch-all we will work with UTF-8. We cannot use
+ * memcmp() as that is unsafe with any string containing NUL
+ * (\xC0\x80 in Tcl's utf rep). We can use the more efficient
+ * TclpUtfNcmp2 if we are case-sensitive and no specific
+ * length was requested.
+ */
+
+ if ((reqlength < 0) && !nocase) {
+ memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
+ } else {
+ s1len = Tcl_NumUtfChars(s1, s1len);
+ s2len = Tcl_NumUtfChars(s2, s2len);
+ memCmpFn = (memCmpFn_t)
+ (nocase ? Tcl_UtfNcasecmp : Tcl_UtfNcmp);
+ }
+ }
+ }
+
+ length = (s1len < s2len) ? s1len : s2len;
+ if (reqlength > 0 && reqlength < length) {
+ length = reqlength;
+ } else if (reqlength < 0) {
+ /*
+ * The requested length is negative, so we ignore it by setting it
+ * to length + 1 so we correct the match var.
+ */
+
+ reqlength = length + 1;
+ }
+
+ if (checkEq && (s1len != s2len)) {
+ match = 1; /* This will be reversed below. */
+ } else {
+ /*
+ * The comparison function should compare up to the minimum byte
+ * length only.
+ */
+
+ match = memCmpFn(s1, s2, (size_t) length);
+ }
+ if ((match == 0) && (reqlength > length)) {
+ match = s1len - s2len;
+ }
+ match = (match > 0) ? 1 : (match < 0) ? -1 : 0;
+ }
+ matchdone:
+ return match;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringFirst --
+ *
+ * Implements the [string first] operation.
+ *
+ * Results:
+ * If needle is found as a substring of haystack, the index of the
+ * first instance of such a find is returned. If needle is not present
+ * as a substring of haystack, -1 is returned.
+ *
+ * Side effects:
+ * needle and haystack may have their Tcl_ObjType changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclStringFirst(
+ Tcl_Obj *needle,
+ Tcl_Obj *haystack,
+ int start)
+{
+ int lh, ln = Tcl_GetCharLength(needle);
+
+ if (start < 0) {
+ start = 0;
+ }
+ if (ln == 0) {
+ /* We don't find empty substrings. Bizarre!
+ * Whenever this routine is turned into a proper substring
+ * finder, change to `return start` after limits imposed. */
+ return -1;
+ }
+
+ if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
+ unsigned char *end, *try, *bh;
+ unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);
+
+ /* Find bytes in bytes */
+ bh = Tcl_GetByteArrayFromObj(haystack, &lh);
+ if ((lh < ln) || (start > lh - ln)) {
+ /* Don't start the loop if there cannot be a valid answer */
+ return -1;
+ }
+ end = bh + lh;
+
+ try = bh + start;
+ while (try + ln <= end) {
+ /*
+ * Look for the leading byte of the needle in the haystack
+ * starting at try and stopping when there's not enough room
+ * for the needle left.
+ */
+ try = memchr(try, bn[0], (end + 1 - ln) - try);
+ if (try == NULL) {
+ /* Leading byte not found -> needle cannot be found. */
+ return -1;
+ }
+ /* Leading byte found, check rest of needle. */
+ if (0 == memcmp(try+1, bn+1, ln-1)) {
+ /* Checks! Return the successful index. */
+ return (try - bh);
+ }
+ /* Rest of needle match failed; Iterate to continue search. */
+ try++;
+ }
+ return -1;
+ }
+
+ /*
+ * TODO: It might be nice to support some cases where it is not
+ * necessary to shimmer to &tclStringType to compute the result,
+ * and instead operate just on the objPtr->bytes values directly.
+ * However, we also do not want the answer to change based on the
+ * code pathway, or if it does we want that to be for some values
+ * we explicitly decline to support. Getting there will involve
+ * locking down in practice more firmly just what encodings produce
+ * what supported results for the objPtr->bytes values. For now,
+ * do only the well-defined Tcl_UniChar array search.
+ */
+
+ {
+ Tcl_UniChar *try, *end, *uh;
+ Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
+
+ uh = Tcl_GetUnicodeFromObj(haystack, &lh);
+ if ((lh < ln) || (start > lh - ln)) {
+ /* Don't start the loop if there cannot be a valid answer */
+ return -1;
+ }
+ end = uh + lh;
+
+ for (try = uh + start; try + ln <= end; try++) {
+ if ((*try == *un) && (0 ==
+ memcmp(try + 1, un + 1, (ln-1) * sizeof(Tcl_UniChar)))) {
+ return (try - uh);
+ }
+ }
+ return -1;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringLast --
+ *
+ * Implements the [string last] operation.
+ *
+ * Results:
+ * If needle is found as a substring of haystack, the index of the
+ * last instance of such a find is returned. If needle is not present
+ * as a substring of haystack, -1 is returned.
+ *
+ * Side effects:
+ * needle and haystack may have their Tcl_ObjType changed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclStringLast(
+ Tcl_Obj *needle,
+ Tcl_Obj *haystack,
+ int last)
+{
+ int lh, ln = Tcl_GetCharLength(needle);
+
+ if (ln == 0) {
+ /*
+ * We don't find empty substrings. Bizarre!
+ *
+ * TODO: When we one day make this a true substring
+ * finder, change this to "return last", after limitation.
+ */
+ return -1;
+ }
+
+ if (TclIsPureByteArray(needle) && TclIsPureByteArray(haystack)) {
+ unsigned char *try, *bh = Tcl_GetByteArrayFromObj(haystack, &lh);
+ unsigned char *bn = Tcl_GetByteArrayFromObj(needle, &ln);
+
+ if (last >= lh) {
+ last = lh - 1;
+ }
+ if (last + 1 < ln) {
+ /* Don't start the loop if there cannot be a valid answer */
+ return -1;
+ }
+ try = bh + last + 1 - ln;
+
+ while (try >= bh) {
+ if ((*try == bn[0])
+ && (0 == memcmp(try+1, bn+1, ln-1))) {
+ return (try - bh);
+ }
+ try--;
+ }
+ return -1;
+ }
+
+ {
+ Tcl_UniChar *try, *uh = Tcl_GetUnicodeFromObj(haystack, &lh);
+ Tcl_UniChar *un = Tcl_GetUnicodeFromObj(needle, &ln);
+
+ if (last >= lh) {
+ last = lh - 1;
+ }
+ if (last + 1 < ln) {
+ /* Don't start the loop if there cannot be a valid answer */
+ return -1;
+ }
+ try = uh + last + 1 - ln;
+ while (try >= uh) {
+ if ((*try == un[0])
+ && (0 == memcmp(try+1, un+1, (ln-1)*sizeof(Tcl_UniChar)))) {
+ return (try - uh);
+ }
+ try--;
+ }
+ return -1;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TclStringReverse --
*
* Implements the [string reverse] operation.
*
* Results:
- * An unshared Tcl value which is the [string reverse] of the argument
- * supplied. When sharing rules permit, the returned value might be the
- * argument with modifications done in place.
+ * A Tcl value which is the [string reverse] of the argument supplied.
+ * When sharing rules permit and the caller requests, the returned value
+ * might be the argument with modifications done in place.
*
* Side effects:
* May allocate a new Tcl_Obj.
@@ -2740,18 +3734,20 @@ static void
ReverseBytes(
unsigned char *to, /* Copy bytes into here... */
unsigned char *from, /* ...from here... */
- int count) /* Until this many are copied, */
+ int count) /* Until this many are copied, */
/* reversing as you go. */
{
unsigned char *src = from + count;
+
if (to == from) {
/* Reversing in place */
while (--src > to) {
unsigned char c = *src;
+
*src = *to;
*to++ = c;
}
- } else {
+ } else {
while (--src >= from) {
*to++ = *src;
}
@@ -2759,17 +3755,19 @@ ReverseBytes(
}
Tcl_Obj *
-TclStringObjReverse(
- Tcl_Obj *objPtr)
+TclStringReverse(
+ Tcl_Obj *objPtr,
+ int flags)
{
String *stringPtr;
Tcl_UniChar ch = 0;
+ int inPlace = flags & TCL_STRING_IN_PLACE;
if (TclIsPureByteArray(objPtr)) {
int numBytes;
unsigned char *from = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewByteArrayObj(NULL, numBytes);
}
ReverseBytes(Tcl_GetByteArrayFromObj(objPtr, NULL), from, numBytes);
@@ -2783,7 +3781,7 @@ TclStringObjReverse(
Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
Tcl_UniChar *src = from + stringPtr->numChars;
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
Tcl_UniChar *to;
/*
@@ -2798,7 +3796,10 @@ TclStringObjReverse(
*to++ = *src;
}
} else {
- /* Reversing in place */
+ /*
+ * Reversing in place.
+ */
+
while (--src > from) {
ch = *src;
*src = *from;
@@ -2812,7 +3813,7 @@ TclStringObjReverse(
int numBytes = objPtr->length;
char *to, *from = objPtr->bytes;
- if (Tcl_IsShared(objPtr)) {
+ if (!inPlace || Tcl_IsShared(objPtr)) {
objPtr = Tcl_NewObj();
Tcl_SetObjLength(objPtr, numBytes);
}
@@ -2822,20 +3823,22 @@ TclStringObjReverse(
/*
* Either numChars == -1 and we don't know how many chars are
* represented by objPtr->bytes and we need Pass 1 just in case,
- * or numChars >= 0 and we know we have fewer chars than bytes,
- * so we know there's a multibyte character needing Pass 1.
+ * or numChars >= 0 and we know we have fewer chars than bytes, so
+ * we know there's a multibyte character needing Pass 1.
*
* Pass 1. Reverse the bytes of each multi-byte character.
*/
+
int charCount = 0;
int bytesLeft = numBytes;
while (bytesLeft) {
/*
- * NOTE: We know that the from buffer is NUL-terminated.
- * It's part of the contract for objPtr->bytes values.
- * Thus, we can skip calling Tcl_UtfCharComplete() here.
+ * NOTE: We know that the from buffer is NUL-terminated. It's
+ * part of the contract for objPtr->bytes values. Thus, we can
+ * skip calling Tcl_UtfCharComplete() here.
*/
+
int bytesInChar = TclUtfToUniChar(from, &ch);
ReverseBytes((unsigned char *)to, (unsigned char *)from,
@@ -2859,6 +3862,150 @@ TclStringObjReverse(
/*
*---------------------------------------------------------------------------
*
+ * TclStringReplace --
+ *
+ * Implements the inner engine of the [string replace] command.
+ *
+ * The result is a concatenation of a prefix from objPtr, characters
+ * 0 through first-1, the insertPtr string value, and a suffix from
+ * objPtr, characters from first + count to the end. The effect is as if
+ * the inner substring of characters first through first+count-1 are
+ * removed and replaced with insertPtr. If insertPtr is NULL, it is
+ * treated as an empty string. When passed the flag TCL_STRING_IN_PLACE,
+ * this routine will try to do the work within objPtr, so long as no
+ * sharing forbids it. Without that request, or as needed, a new Tcl
+ * value will be allocated to be the result.
+ *
+ * Results:
+ * A Tcl value that is the result of the substring replacement. May
+ * return NULL in case of an error. When NULL is returned and interp is
+ * non-NULL, error information is left in interp
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclStringReplace(
+ Tcl_Interp *interp, /* For error reporting, may be NULL */
+ Tcl_Obj *objPtr, /* String to act upon */
+ int first, /* First index to replace */
+ int count, /* How many chars to replace */
+ Tcl_Obj *insertPtr, /* Replacement string, may be NULL */
+ int flags) /* TCL_STRING_IN_PLACE => attempt in-place */
+{
+ int inPlace = flags & TCL_STRING_IN_PLACE;
+ Tcl_Obj *result;
+
+ /* Caller is expected to pass sensible arguments */
+ assert ( count >= 0 ) ;
+ assert ( first >= 0 ) ;
+
+ /* Replace nothing with nothing */
+ if ((insertPtr == NULL) && (count == 0)) {
+ if (inPlace) {
+ return objPtr;
+ } else {
+ return Tcl_DuplicateObj(objPtr);
+ }
+ }
+
+ /*
+ * The caller very likely had to call Tcl_GetCharLength() or similar
+ * to be able to process index values. This means it is like that
+ * objPtr is either a proper "bytearray" or a "string" or else it has
+ * a known and short string rep.
+ */
+
+ if (TclIsPureByteArray(objPtr)) {
+ int numBytes;
+ unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &numBytes);
+
+ if (insertPtr == NULL) {
+ /* Replace something with nothing. */
+
+ assert ( first <= numBytes ) ;
+ assert ( count <= numBytes ) ;
+ assert ( first + count <= numBytes ) ;
+
+ result = Tcl_NewByteArrayObj(NULL, numBytes - count);/* PANIC? */
+ TclAppendBytesToByteArray(result, bytes, first);
+ TclAppendBytesToByteArray(result, bytes + first + count,
+ numBytes - count - first);
+ return result;
+ }
+
+ /* Replace everything */
+ if ((first == 0) && (count == numBytes)) {
+ return insertPtr;
+ }
+
+ if (TclIsPureByteArray(insertPtr)) {
+ int newBytes;
+ unsigned char *iBytes
+ = Tcl_GetByteArrayFromObj(insertPtr, &newBytes);
+
+ if (count == newBytes && inPlace && !Tcl_IsShared(objPtr)) {
+ /*
+ * Removal count and replacement count are equal.
+ * Other conditions permit. Do in-place splice.
+ */
+
+ memcpy(bytes + first, iBytes, count);
+ Tcl_InvalidateStringRep(objPtr);
+ return objPtr;
+ }
+
+ if (newBytes > INT_MAX - (numBytes - count)) {
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "max size for a Tcl value (%d bytes) exceeded",
+ INT_MAX));
+ Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+ }
+ return NULL;
+ }
+ result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
+ /* PANIC? */
+ Tcl_SetByteArrayLength(result, 0);
+ TclAppendBytesToByteArray(result, bytes, first);
+ TclAppendBytesToByteArray(result, iBytes, newBytes);
+ TclAppendBytesToByteArray(result, bytes + first + count,
+ numBytes - count - first);
+ return result;
+ }
+
+ /* Flow through to try other approaches below */
+ }
+
+ /*
+ * TODO: Figure out how not to generate a Tcl_UniChar array rep
+ * when it can be determined objPtr->bytes points to a string of
+ * all single-byte characters so we can index it directly.
+ */
+
+ /* The traditional implementation... */
+ {
+ int numChars;
+ Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);
+
+ /* TODO: Is there an in-place option worth pursuing here? */
+
+ result = Tcl_NewUnicodeObj(ustring, first);
+ if (insertPtr) {
+ Tcl_AppendObjToObj(result, insertPtr);
+ }
+ if (first + count < numChars) {
+ Tcl_AppendUnicodeToObj(result, ustring + first + count,
+ numChars - first - count);
+ }
+
+ return result;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
* FillUnicodeRep --
*
* Populate the Unicode internal rep with the Unicode form of its string
@@ -2950,7 +4097,6 @@ DupStringInternalRep(
String *srcStringPtr = GET_STRING(srcPtr);
String *copyStringPtr = NULL;
-#if COMPAT==0
if (srcStringPtr->numChars == -1) {
/*
* The String struct in the source value holds zero useful data. Don't
@@ -2993,41 +4139,6 @@ DupStringInternalRep(
*/
copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0;
-#else /* COMPAT!=0 */
- /*
- * If the src obj is a string of 1-byte Utf chars, then copy the string
- * rep of the source object and create an "empty" Unicode internal rep for
- * the new object. Otherwise, copy Unicode internal rep, and invalidate
- * the string rep of the new object.
- */
-
- if (srcStringPtr->hasUnicode && srcStringPtr->numChars > 0) {
- /*
- * Copy the full allocation for the Unicode buffer.
- */
-
- copyStringPtr = stringAlloc(srcStringPtr->maxChars);
- copyStringPtr->maxChars = srcStringPtr->maxChars;
- memcpy(copyStringPtr->unicode, srcStringPtr->unicode,
- srcStringPtr->numChars * sizeof(Tcl_UniChar));
- copyStringPtr->unicode[srcStringPtr->numChars] = 0;
- copyStringPtr->allocated = 0;
- } else {
- copyStringPtr = stringAlloc(0);
- copyStringPtr->unicode[0] = 0;
- copyStringPtr->maxChars = 0;
-
- /*
- * Tricky point: the string value was copied by generic object
- * management code, so it doesn't contain any extra bytes that might
- * exist in the source object.
- */
-
- copyStringPtr->allocated = copyPtr->length;
- }
- copyStringPtr->numChars = srcStringPtr->numChars;
- copyStringPtr->hasUnicode = srcStringPtr->hasUnicode;
-#endif /* COMPAT==0 */
SET_STRING(copyPtr, copyStringPtr);
copyPtr->typePtr = &tclStringType;
@@ -3115,7 +4226,7 @@ UpdateStringOfString(
stringPtr->allocated = 0;
if (stringPtr->numChars == 0) {
- TclInitStringRep(objPtr, tclEmptyStringRep, 0);
+ TclInitStringRep(objPtr, NULL, 0);
} else {
(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
stringPtr->numChars);
@@ -3133,7 +4244,7 @@ ExtendStringRepWithUnicode(
*/
int i, origLength, size = 0;
- char *dst, buf[TCL_UTF_MAX];
+ char *dst;
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {
@@ -3159,7 +4270,7 @@ ExtendStringRepWithUnicode(
}
for (i = 0; i < numChars && size >= 0; i++) {
- size += Tcl_UniCharToUtf((int) unicode[i], buf);
+ size += TclUtfCount(unicode[i]);
}
if (size < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h
index 227e6bc..fc5a713 100644
--- a/generic/tclStringRep.h
+++ b/generic/tclStringRep.h
@@ -46,7 +46,7 @@
* tcl.h, but do not do that unless you are sure what you're doing!
*/
-typedef struct String {
+typedef struct {
int numChars; /* The number of chars in the string. -1 means
* this value has not been calculated. >= 0
* means that there is a valid Unicode rep, or
@@ -72,20 +72,21 @@ typedef struct String {
do { \
if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \
Tcl_Panic("max length for a Tcl unicode value (%d chars) exceeded", \
- STRING_MAXCHARS); \
+ (int)STRING_MAXCHARS); \
} \
} while (0)
#define stringAttemptAlloc(numChars) \
- (String *) attemptckalloc((unsigned) STRING_SIZE(numChars))
+ (String *) attemptckalloc(STRING_SIZE(numChars))
#define stringAlloc(numChars) \
- (String *) ckalloc((unsigned) STRING_SIZE(numChars))
+ (String *) ckalloc(STRING_SIZE(numChars))
#define stringRealloc(ptr, numChars) \
- (String *) ckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+ (String *) ckrealloc((ptr), STRING_SIZE(numChars))
#define stringAttemptRealloc(ptr, numChars) \
- (String *) attemptckrealloc((ptr), (unsigned) STRING_SIZE(numChars))
+ (String *) attemptckrealloc((ptr), STRING_SIZE(numChars))
#define GET_STRING(objPtr) \
((String *) (objPtr)->internalRep.twoPtrValue.ptr1)
#define SET_STRING(objPtr, stringPtr) \
+ ((objPtr)->internalRep.twoPtrValue.ptr2 = NULL), \
((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (stringPtr))
/*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 690e801..66bb305 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -35,25 +35,32 @@
#undef Tcl_NewIntObj
#undef Tcl_NewListObj
#undef Tcl_NewLongObj
+#undef Tcl_DbNewLongObj
#undef Tcl_NewObj
#undef Tcl_NewStringObj
+#undef Tcl_GetUnicode
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
+#undef Tcl_SetExitProc
+#undef Tcl_SetPanicProc
#undef TclpGetPid
#undef TclSockMinimumBuffers
-#define TclBackgroundException Tcl_BackgroundException
#undef Tcl_SetIntObj
+#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt
#undef TclWinSetSockOpt
+#undef TclWinNToHS
+#undef TclStaticPackage
+#define TclStaticPackage Tcl_StaticPackage
/* See bug 510001: TclSockMinimumBuffers needs plat imp */
-#ifdef _WIN64
+#if defined(_WIN64) || defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
# define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
@@ -63,6 +70,39 @@ static int TclSockMinimumBuffersOld(int sock, int size)
}
#endif
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
+# define TclSetStartupScriptPath 0
+# define TclGetStartupScriptPath 0
+# define TclSetStartupScriptFileName 0
+# define TclGetStartupScriptFileName 0
+# define TclPrecTraceProc 0
+# define TclpInetNtoa 0
+# define TclWinGetServByName 0
+# define TclWinGetSockOpt 0
+# define TclWinSetSockOpt 0
+# define TclWinNToHS 0
+# define TclWinGetPlatformId 0
+# define TclWinResetInterfaces 0
+# define TclWinSetInterfaces 0
+# define TclWinGetPlatformId 0
+# define TclBNInitBignumFromWideUInt 0
+# define TclBNInitBignumFromWideInt 0
+# define TclBNInitBignumFromLong 0
+# define Tcl_Backslash 0
+# define Tcl_GetDefaultEncodingDir 0
+# define Tcl_SetDefaultEncodingDir 0
+# define Tcl_EvalTokens 0
+# define Tcl_CreateMathFunc 0
+# define Tcl_GetMathFuncInfo 0
+# define Tcl_ListMathFuncs 0
+# define Tcl_SetIntObj 0
+# define Tcl_SetLongObj 0
+# define Tcl_NewIntObj 0
+# define Tcl_NewLongObj 0
+# define Tcl_DbNewLongObj 0
+# define Tcl_BackgroundError 0
+
+#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
@@ -88,14 +128,33 @@ static const char *TclGetStartupScriptFileName(void)
}
return Tcl_GetString(path);
}
-
#if defined(_WIN32) || defined(__CYGWIN__)
#undef TclWinNToHS
+#undef TclWinGetPlatformId
+#undef TclWinResetInterfaces
+#undef TclWinSetInterfaces
+static void
+doNothing(void)
+{
+ /* dummy implementation, no need to do anything */
+}
#define TclWinNToHS winNToHS
static unsigned short TclWinNToHS(unsigned short ns) {
return ntohs(ns);
}
+#define TclWinGetPlatformId winGetPlatformId
+static int
+TclWinGetPlatformId(void)
+{
+ return 2; /* VER_PLATFORM_WIN32_NT */;
+}
+#define TclWinResetInterfaces doNothing
+#define TclWinSetInterfaces (void (*) (int)) doNothing
#endif
+# define TclBNInitBignumFromWideUInt TclInitBignumFromWideUInt
+# define TclBNInitBignumFromWideInt TclInitBignumFromWideInt
+# define TclBNInitBignumFromLong TclInitBignumFromLong
+#endif /* TCL_NO_DEPRECATED */
#ifdef _WIN32
# define TclUnixWaitForFile 0
@@ -105,10 +164,15 @@ static unsigned short TclWinNToHS(unsigned short ns) {
# define TclpIsAtty 0
#elif defined(__CYGWIN__)
# define TclpIsAtty TclPlatIsAtty
-# define TclWinSetInterfaces (void (*) (int)) doNothing
+#if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8
+static void
+doNothing(void)
+{
+ /* dummy implementation, no need to do anything */
+}
+#endif
# define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
# define TclWinFlushDirtyChannels doNothing
-# define TclWinResetInterfaces doNothing
static int
TclpIsAtty(int fd)
@@ -116,15 +180,6 @@ TclpIsAtty(int fd)
return isatty(fd);
}
-#define TclWinGetPlatformId winGetPlatformId
-static int
-TclWinGetPlatformId()
-{
- /* Don't bother to determine the real platform on cygwin,
- * because VER_PLATFORM_WIN32_NT is the only supported platform */
- return 2; /* VER_PLATFORM_WIN32_NT */;
-}
-
void *TclWinGetTclInstance()
{
void *hInstance = NULL;
@@ -133,6 +188,7 @@ void *TclWinGetTclInstance()
return hInstance;
}
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
@@ -155,6 +211,7 @@ TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
+#endif /* TCL_NO_DEPRECATED */
#define TclWinNoBackslash winNoBackslash
static char *
@@ -176,12 +233,6 @@ TclpGetPid(Tcl_Pid pid)
return (int) (size_t) pid;
}
-static void
-doNothing(void)
-{
- /* dummy implementation, no need to do anything */
-}
-
char *
Tcl_WinUtfToTChar(
const char *string,
@@ -307,33 +358,11 @@ Tcl_WinTCharToUtf(
* signature. Tcl 9 must find a better solution, but that cannot be done
* without introducing a binary incompatibility.
*/
-#define Tcl_DbNewLongObj ((Tcl_Obj*(*)(long,const char*,int))dbNewLongObj)
-static Tcl_Obj *dbNewLongObj(
- int intValue,
- const char *file,
- int line
-) {
-#ifdef TCL_MEM_DEBUG
- register Tcl_Obj *objPtr;
-
- TclDbNewObj(objPtr, file, line);
- objPtr->bytes = NULL;
-
- objPtr->internalRep.longValue = (long) intValue;
- objPtr->typePtr = &tclIntType;
- return objPtr;
-#else
- return Tcl_NewIntObj(intValue);
-#endif
-}
-#define Tcl_GetLongFromObj (int(*)(Tcl_Interp*,Tcl_Obj*,long*))Tcl_GetIntFromObj
-#define Tcl_NewLongObj (Tcl_Obj*(*)(long))Tcl_NewIntObj
-#define Tcl_SetLongObj (void(*)(Tcl_Obj*,long))Tcl_SetIntObj
static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
long longValue;
int result = Tcl_ExprLong(interp, expr, &longValue);
if (result == TCL_OK) {
- if ((longValue >= -(long)(UINT_MAX))
+ if ((longValue >= (long)(INT_MIN))
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
@@ -349,7 +378,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
long longValue;
int result = Tcl_ExprLongObj(interp, expr, &longValue);
if (result == TCL_OK) {
- if ((longValue >= -(long)(UINT_MAX))
+ if ((longValue >= (long)(INT_MIN))
&& (longValue <= (long)(UINT_MAX))) {
*ptr = (int)longValue;
} else {
@@ -377,17 +406,137 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
return Tcl_UniCharNcasecmp(ucs, uct, (unsigned long)n);
}
#define Tcl_UniCharNcasecmp (int(*)(const Tcl_UniChar*,const Tcl_UniChar*,unsigned long))uniCharNcasecmp
-static int formatInt(char *buffer, int n){
- return TclFormatInt(buffer, (long)n);
-}
-#define TclFormatInt (int(*)(char *, long))formatInt
-#endif
+#endif /* TCL_WIDE_INT_IS_LONG */
-#else /* UNIX and MAC */
+#endif /* __CYGWIN__ */
+
+#if defined(TCL_NO_DEPRECATED)
+# define Tcl_SeekOld 0
+# define Tcl_TellOld 0
+# undef Tcl_SetBooleanObj
+# define Tcl_SetBooleanObj 0
+# undef Tcl_PkgPresent
+# define Tcl_PkgPresent 0
+# undef Tcl_PkgProvide
+# define Tcl_PkgProvide 0
+# undef Tcl_PkgRequire
+# define Tcl_PkgRequire 0
+# undef Tcl_GetIndexFromObj
+# define Tcl_GetIndexFromObj 0
+# define Tcl_NewBooleanObj 0
+# undef Tcl_DbNewBooleanObj
+# define Tcl_DbNewBooleanObj 0
+# undef Tcl_SetBooleanObj
+# define Tcl_SetBooleanObj 0
+# undef Tcl_SetVar
+# define Tcl_SetVar 0
+# undef Tcl_UnsetVar
+# define Tcl_UnsetVar 0
+# undef Tcl_GetVar
+# define Tcl_GetVar 0
+# undef Tcl_TraceVar
+# define Tcl_TraceVar 0
+# undef Tcl_UntraceVar
+# define Tcl_UntraceVar 0
+# undef Tcl_VarTraceInfo
+# define Tcl_VarTraceInfo 0
+# undef Tcl_UpVar
+# define Tcl_UpVar 0
+# undef Tcl_AddErrorInfo
+# define Tcl_AddErrorInfo 0
+# undef Tcl_AddObjErrorInfo
+# define Tcl_AddObjErrorInfo 0
+# undef Tcl_Eval
+# define Tcl_Eval 0
+# undef Tcl_GlobalEval
+# define Tcl_GlobalEval 0
+# undef Tcl_SaveResult
+# define Tcl_SaveResult 0
+# undef Tcl_RestoreResult
+# define Tcl_RestoreResult 0
+# undef Tcl_DiscardResult
+# define Tcl_DiscardResult 0
+# undef Tcl_SetResult
+# define Tcl_SetResult 0
+# undef Tcl_EvalObj
+# define Tcl_EvalObj 0
+# undef Tcl_GlobalEvalObj
+# define Tcl_GlobalEvalObj 0
+# define TclBackgroundException 0
+# undef TclpReaddir
+# define TclpReaddir 0
+# define TclSetStartupScript 0
+# define TclGetStartupScript 0
+# define TclCreateNamespace 0
+# define TclDeleteNamespace 0
+# define TclAppendExportList 0
+# define TclExport 0
+# define TclImport 0
+# define TclForgetImport 0
+# define TclGetCurrentNamespace_ 0
+# define TclGetGlobalNamespace_ 0
+# define TclFindNamespace 0
+# define TclFindCommand 0
+# define TclGetCommandFromObj 0
+# define TclGetCommandFullName 0
+# define TclCopyChannelOld 0
+# define Tcl_AppendResultVA 0
+# define Tcl_AppendStringsToObjVA 0
+# define Tcl_SetErrorCodeVA 0
+# define Tcl_PanicVA 0
+# define Tcl_VarEvalVA 0
+# undef TclpGetDate
+# define TclpGetDate 0
+# undef TclpLocaltime
+# define TclpLocaltime 0
+# undef TclpGmtime
+# define TclpGmtime 0
+# define TclpLocaltime_unix 0
+# define TclpGmtime_unix 0
+# define Tcl_SetExitProc 0
+# define Tcl_SetPanicProc 0
+# define Tcl_FindExecutable 0
+# define Tcl_GetUnicode 0
+# define TclOldFreeObj 0
+#else /* TCL_NO_DEPRECATED */
+# define Tcl_SeekOld seekOld
+# define Tcl_TellOld tellOld
+# define TclBackgroundException Tcl_BackgroundException
+# define TclSetStartupScript Tcl_SetStartupScript
+# define TclGetStartupScript Tcl_GetStartupScript
+# define TclCreateNamespace Tcl_CreateNamespace
+# define TclDeleteNamespace Tcl_DeleteNamespace
+# define TclAppendExportList Tcl_AppendExportList
+# define TclExport Tcl_Export
+# define TclImport Tcl_Import
+# define TclForgetImport Tcl_ForgetImport
+# define TclGetCurrentNamespace_ Tcl_GetCurrentNamespace
+# define TclGetGlobalNamespace_ Tcl_GetGlobalNamespace
+# define TclFindNamespace Tcl_FindNamespace
+# define TclFindCommand Tcl_FindCommand
+# define TclGetCommandFromObj Tcl_GetCommandFromObj
+# define TclGetCommandFullName Tcl_GetCommandFullName
# define TclpLocaltime_unix TclpLocaltime
# define TclpGmtime_unix TclpGmtime
-#endif
+# define TclOldFreeObj TclFreeObj
+
+static int
+seekOld(
+ Tcl_Channel chan, /* The channel on which to seek. */
+ int offset, /* Offset to seek to. */
+ int mode) /* Relative to which location to seek? */
+{
+ return Tcl_Seek(chan, offset, mode);
+}
+
+static int
+tellOld(
+ Tcl_Channel chan) /* The channel to return pos for. */
+{
+ return Tcl_Tell(chan);
+}
+#endif /* !TCL_NO_DEPRECATED */
/*
* WARNING: The contents of this file is automatically generated by the
@@ -398,6 +547,15 @@ static int formatInt(char *buffer, int n){
MODULE_SCOPE const TclStubs tclStubs;
MODULE_SCOPE const TclTomMathStubs tclTomMathStubs;
+#ifdef __GNUC__
+/*
+ * The rest of this file shouldn't warn about deprecated functions; they're
+ * there because we intend them to be so and know that this file is OK to
+ * touch those fields.
+ */
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+#endif
+
/* !BEGIN!: Do not edit below this line. */
static const TclIntStubs tclIntStubs = {
@@ -515,22 +673,22 @@ static const TclIntStubs tclIntStubs = {
TclUpdateReturnInfo, /* 109 */
TclSockMinimumBuffers, /* 110 */
Tcl_AddInterpResolvers, /* 111 */
- Tcl_AppendExportList, /* 112 */
- Tcl_CreateNamespace, /* 113 */
- Tcl_DeleteNamespace, /* 114 */
- Tcl_Export, /* 115 */
- Tcl_FindCommand, /* 116 */
- Tcl_FindNamespace, /* 117 */
+ TclAppendExportList, /* 112 */
+ TclCreateNamespace, /* 113 */
+ TclDeleteNamespace, /* 114 */
+ TclExport, /* 115 */
+ TclFindCommand, /* 116 */
+ TclFindNamespace, /* 117 */
Tcl_GetInterpResolvers, /* 118 */
Tcl_GetNamespaceResolvers, /* 119 */
Tcl_FindNamespaceVar, /* 120 */
- Tcl_ForgetImport, /* 121 */
- Tcl_GetCommandFromObj, /* 122 */
- Tcl_GetCommandFullName, /* 123 */
- Tcl_GetCurrentNamespace, /* 124 */
- Tcl_GetGlobalNamespace, /* 125 */
+ TclForgetImport, /* 121 */
+ TclGetCommandFromObj, /* 122 */
+ TclGetCommandFullName, /* 123 */
+ TclGetCurrentNamespace_, /* 124 */
+ TclGetGlobalNamespace_, /* 125 */
Tcl_GetVariableFullName, /* 126 */
- Tcl_Import, /* 127 */
+ TclImport, /* 127 */
Tcl_PopCallFrame, /* 128 */
Tcl_PushCallFrame, /* 129 */
Tcl_RemoveInterpResolvers, /* 130 */
@@ -581,8 +739,8 @@ static const TclIntStubs tclIntStubs = {
TclCallVarTraces, /* 175 */
TclCleanupVar, /* 176 */
TclVarErrMsg, /* 177 */
- Tcl_SetStartupScript, /* 178 */
- Tcl_GetStartupScript, /* 179 */
+ TclSetStartupScript, /* 178 */
+ TclGetStartupScript, /* 179 */
0, /* 180 */
0, /* 181 */
TclpLocaltime, /* 182 */
@@ -660,6 +818,7 @@ static const TclIntStubs tclIntStubs = {
TclPtrIncrObjVar, /* 254 */
TclPtrObjMakeUpvar, /* 255 */
TclPtrUnsetVar, /* 256 */
+ TclStaticPackage, /* 257 */
};
static const TclIntPlatStubs tclIntPlatStubs = {
@@ -850,6 +1009,15 @@ const TclTomMathStubs tclTomMathStubs = {
TclBNInitBignumFromWideInt, /* 65 */
TclBNInitBignumFromWideUInt, /* 66 */
TclBN_mp_expt_d_ex, /* 67 */
+ TclBN_mp_set_long_long, /* 68 */
+ TclBN_mp_get_long_long, /* 69 */
+ TclBN_mp_set_long, /* 70 */
+ TclBN_mp_get_long, /* 71 */
+ TclBN_mp_get_int, /* 72 */
+ TclBN_mp_tc_and, /* 73 */
+ TclBN_mp_tc_or, /* 74 */
+ TclBN_mp_tc_xor, /* 75 */
+ TclBN_mp_tc_div_2d, /* 76 */
};
static const TclStubHooks tclStubHooks = {
@@ -907,7 +1075,7 @@ const TclStubs tclStubs = {
Tcl_DbNewObj, /* 27 */
Tcl_DbNewStringObj, /* 28 */
Tcl_DuplicateObj, /* 29 */
- TclFreeObj, /* 30 */
+ TclOldFreeObj, /* 30 */
Tcl_GetBoolean, /* 31 */
Tcl_GetBooleanFromObj, /* 32 */
Tcl_GetByteArrayFromObj, /* 33 */
@@ -1516,6 +1684,19 @@ const TclStubs tclStubs = {
Tcl_FindSymbol, /* 628 */
Tcl_FSUnloadFile, /* 629 */
Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
+ Tcl_OpenTcpServerEx, /* 631 */
+ TclZipfs_Mount, /* 632 */
+ TclZipfs_Unmount, /* 633 */
+ TclZipfs_TclLibrary, /* 634 */
+ TclZipfs_MountBuffer, /* 635 */
+ Tcl_FreeIntRep, /* 636 */
+ Tcl_InitStringRep, /* 637 */
+ Tcl_FetchIntRep, /* 638 */
+ Tcl_StoreIntRep, /* 639 */
+ Tcl_HasStringRep, /* 640 */
+ Tcl_IncrRefCount, /* 641 */
+ Tcl_DecrRefCount, /* 642 */
+ Tcl_IsShared, /* 643 */
};
/* !END!: Do not edit above this line. */
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 859cbf9..5261591 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -24,13 +24,10 @@ const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
/*
- * Use our own isDigit to avoid linking to libc on windows
+ * Use our own ISDIGIT to avoid linking to libc on windows
*/
-static int isDigit(const int c)
-{
- return (c >= '0' && c <= '9');
-}
+#define ISDIGIT(c) (((unsigned)((c)-'0')) <= 9)
/*
*----------------------------------------------------------------------
@@ -54,7 +51,8 @@ MODULE_SCOPE const char *
Tcl_InitStubs(
Tcl_Interp *interp,
const char *version,
- int exact)
+ int exact,
+ int magic)
{
Interp *iPtr = (Interp *) interp;
const char *actualVersion = NULL;
@@ -67,9 +65,9 @@ Tcl_InitStubs(
* times. [Bug 615304]
*/
- if (!stubsPtr || (stubsPtr->magic != TCL_STUB_MAGIC)) {
- iPtr->result = "interpreter uses an incompatible stubs mechanism";
- iPtr->freeProc = TCL_STATIC;
+ if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
+ iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
+ iPtr->freeProc = 0;
return NULL;
}
@@ -77,12 +75,12 @@ Tcl_InitStubs(
if (actualVersion == NULL) {
return NULL;
}
- if (exact) {
+ if (exact&1) {
const char *p = version;
int count = 0;
while (*p) {
- count += !isDigit(*p++);
+ count += !ISDIGIT(*p++);
}
if (count == 1) {
const char *q = actualVersion;
@@ -91,7 +89,7 @@ Tcl_InitStubs(
while (*p && (*p == *q)) {
p++; q++;
}
- if (*p || isDigit(*q)) {
+ if (*p || ISDIGIT(*q)) {
/* Construct error message */
stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 1, NULL);
return NULL;
@@ -103,12 +101,16 @@ Tcl_InitStubs(
}
}
}
- tclStubsPtr = (TclStubs *)pkgData;
+ if (((exact&0xff00) < 0x900)) {
+ /* We are running Tcl 8.x */
+ stubsPtr = (TclStubs *)pkgData;
+ }
+ tclStubsPtr = stubsPtr;
- if (tclStubsPtr->hooks) {
- tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
- tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
- tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+ if (stubsPtr->hooks) {
+ tclPlatStubsPtr = stubsPtr->hooks->tclPlatStubs;
+ tclIntStubsPtr = stubsPtr->hooks->tclIntStubs;
+ tclIntPlatStubsPtr = stubsPtr->hooks->tclIntPlatStubs;
} else {
tclPlatStubsPtr = NULL;
tclIntStubsPtr = NULL;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index b39ef0a..c87bb54 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -42,16 +42,8 @@
* Declare external functions used in Windows tests.
*/
-/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Tcltest_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-EXTERN int Tcltest_Init(Tcl_Interp *interp);
-EXTERN int Tcltest_SafeInit(Tcl_Interp *interp);
+DLLEXPORT int Tcltest_Init(Tcl_Interp *interp);
+DLLEXPORT int Tcltest_SafeInit(Tcl_Interp *interp);
/*
* Dynamic string shared by TestdcallCmd and DelCallbackProc; used to collect
@@ -75,6 +67,18 @@ typedef struct TestAsyncHandler {
/* Next is list of handlers. */
} TestAsyncHandler;
+/*
+ * Start of the socket driver state structure to acces field testFlags
+ */
+
+typedef struct TcpState TcpState;
+
+struct TcpState {
+ Tcl_Channel channel; /* Channel associated with this socket. */
+ int testFlags; /* bit field for tests. Is set by testsocket
+ * test procedure */
+};
+
TCL_DECLARE_MUTEX(asyncTestMutex)
static TestAsyncHandler *firstHandler = NULL;
@@ -98,7 +102,7 @@ static Tcl_Trace cmdTrace;
* TestdelCmd:
*/
-typedef struct DelCmd {
+typedef struct {
Tcl_Interp *interp; /* Interpreter in which command exists. */
char *deleteCmd; /* Script to execute when command is deleted.
* Malloc'ed. */
@@ -109,7 +113,7 @@ typedef struct DelCmd {
* command.
*/
-typedef struct TclEncoding {
+typedef struct {
Tcl_Interp *interp;
char *toUtfCmd;
char *fromUtfCmd;
@@ -132,7 +136,7 @@ static int exitMainLoop = 0;
* Event structure used in testing the event queue management procedures.
*/
-typedef struct TestEvent {
+typedef struct {
Tcl_Event header; /* Header common to all events */
Tcl_Interp *interp; /* Interpreter that will handle the event */
Tcl_Obj *command; /* Command to evaluate when the event occurs */
@@ -155,223 +159,230 @@ static TestChannel *firstDetached;
* Forward declarations for procedures defined later in this file:
*/
-static int AsyncHandlerProc(ClientData clientData,
+static int AsyncHandlerProc(void *clientData,
Tcl_Interp *interp, int code);
-#ifdef TCL_THREADS
-static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
+#if TCL_THREADS
+static Tcl_ThreadCreateType AsyncThreadProc(void *);
#endif
static void CleanupTestSetassocdataTests(
- ClientData clientData, Tcl_Interp *interp);
-static void CmdDelProc1(ClientData clientData);
-static void CmdDelProc2(ClientData clientData);
-static int CmdProc1(ClientData clientData,
+ void *clientData, Tcl_Interp *interp);
+static void CmdDelProc1(void *clientData);
+static void CmdDelProc2(void *clientData);
+static int CmdProc1(void *clientData,
Tcl_Interp *interp, int argc, const char **argv);
-static int CmdProc2(ClientData clientData,
+static int CmdProc2(void *clientData,
Tcl_Interp *interp, int argc, const char **argv);
static void CmdTraceDeleteProc(
- ClientData clientData, Tcl_Interp *interp,
+ void *clientData, Tcl_Interp *interp,
int level, char *command, Tcl_CmdProc *cmdProc,
- ClientData cmdClientData, int argc,
+ void *cmdClientData, int argc,
const char *argv[]);
-static void CmdTraceProc(ClientData clientData,
+static void CmdTraceProc(void *clientData,
Tcl_Interp *interp, int level, char *command,
- Tcl_CmdProc *cmdProc, ClientData cmdClientData,
+ Tcl_CmdProc *cmdProc, void *cmdClientData,
int argc, const char *argv[]);
static int CreatedCommandProc(
- ClientData clientData, Tcl_Interp *interp,
+ void *clientData, Tcl_Interp *interp,
int argc, const char **argv);
static int CreatedCommandProc2(
- ClientData clientData, Tcl_Interp *interp,
+ void *clientData, Tcl_Interp *interp,
int argc, const char **argv);
-static void DelCallbackProc(ClientData clientData,
+static void DelCallbackProc(void *clientData,
Tcl_Interp *interp);
-static int DelCmdProc(ClientData clientData,
+static int DelCmdProc(void *clientData,
Tcl_Interp *interp, int argc, const char **argv);
-static void DelDeleteProc(ClientData clientData);
-static void EncodingFreeProc(ClientData clientData);
-static int EncodingToUtfProc(ClientData clientData,
+static void DelDeleteProc(void *clientData);
+static void EncodingFreeProc(void *clientData);
+static int EncodingToUtfProc(void *clientData,
const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr, int *dstWrotePtr,
int *dstCharsPtr);
-static int EncodingFromUtfProc(ClientData clientData,
+static int EncodingFromUtfProc(void *clientData,
const char *src, int srcLen, int flags,
Tcl_EncodingState *statePtr, char *dst,
int dstLen, int *srcReadPtr, int *dstWrotePtr,
int *dstCharsPtr);
-static void ExitProcEven(ClientData clientData);
-static void ExitProcOdd(ClientData clientData);
-static int GetTimesObjCmd(ClientData clientData,
+static void ExitProcEven(void *clientData);
+static void ExitProcOdd(void *clientData);
+static int GetTimesObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void MainLoop(void);
-static int NoopCmd(ClientData clientData,
+static int NoopCmd(void *clientData,
Tcl_Interp *interp, int argc, const char **argv);
-static int NoopObjCmd(ClientData clientData,
+static int NoopObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int ObjTraceProc(ClientData clientData,
+static int ObjTraceProc(void *clientData,
Tcl_Interp *interp, int level, const char *command,
Tcl_Command commandToken, int objc,
Tcl_Obj *const objv[]);
-static void ObjTraceDeleteProc(ClientData clientData);
+static void ObjTraceDeleteProc(void *clientData);
static void PrintParse(Tcl_Interp *interp, Tcl_Parse *parsePtr);
static void SpecialFree(char *blockPtr);
static int StaticInitProc(Tcl_Interp *interp);
-static int TestasyncCmd(ClientData dummy,
+static int TestasyncCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
+static int TestbytestringObjCmd(void *clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static int TestpurebytesobjObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestbytestringObjCmd(ClientData clientData,
+static int TeststringbytesObjCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestcmdinfoCmd(ClientData dummy,
+static int TestcmdinfoCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestcmdtokenCmd(ClientData dummy,
+static int TestcmdtokenCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestcmdtraceCmd(ClientData dummy,
+static int TestcmdtraceCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestconcatobjCmd(ClientData dummy,
+static int TestconcatobjCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestcreatecommandCmd(ClientData dummy,
+static int TestcreatecommandCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestdcallCmd(ClientData dummy,
+static int TestdcallCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestdelCmd(ClientData dummy,
+static int TestdelCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestdelassocdataCmd(ClientData dummy,
+static int TestdelassocdataCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestdoubledigitsObjCmd(ClientData dummy,
- Tcl_Interp* interp,
- int objc, Tcl_Obj* const objv[]);
-static int TestdstringCmd(ClientData dummy,
+static int TestdoubledigitsObjCmd(void *dummy,
+ Tcl_Interp* interp, int objc,
+ Tcl_Obj* const objv[]);
+static int TestdstringCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestencodingObjCmd(ClientData dummy,
+static int TestencodingObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestevalexObjCmd(ClientData dummy,
+static int TestevalexObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestevalobjvObjCmd(ClientData dummy,
+static int TestevalobjvObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TesteventObjCmd(ClientData unused,
+static int TesteventObjCmd(void *unused,
Tcl_Interp *interp, int argc,
Tcl_Obj *const objv[]);
static int TesteventProc(Tcl_Event *event, int flags);
static int TesteventDeleteProc(Tcl_Event *event,
- ClientData clientData);
-static int TestexithandlerCmd(ClientData dummy,
+ void *clientData);
+static int TestexithandlerCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestexprlongCmd(ClientData dummy,
+static int TestexprlongCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestexprlongobjCmd(ClientData dummy,
+static int TestexprlongobjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestexprdoubleCmd(ClientData dummy,
+static int TestexprdoubleCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestexprdoubleobjCmd(ClientData dummy,
+static int TestexprdoubleobjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestexprparserObjCmd(ClientData dummy,
+static int TestexprparserObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestexprstringCmd(ClientData dummy,
+static int TestexprstringCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestfileCmd(ClientData dummy,
+static int TestfileCmd(void *dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
-static int TestfilelinkCmd(ClientData dummy,
+static int TestfilelinkCmd(void *dummy,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
-static int TestfeventCmd(ClientData dummy,
+static int TestfeventCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestgetassocdataCmd(ClientData dummy,
+static int TestgetassocdataCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestgetintCmd(ClientData dummy,
+static int TestgetintCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestgetplatformCmd(ClientData dummy,
+static int TestlongsizeCmd(void *dummy,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestgetplatformCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestgetvarfullnameCmd(
- ClientData dummy, Tcl_Interp *interp,
+ void *dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int TestinterpdeleteCmd(ClientData dummy,
+static int TestinterpdeleteCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestlinkCmd(ClientData dummy,
+static int TestlinkCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestlocaleCmd(ClientData dummy,
+static int TestlocaleCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestMathFunc(ClientData clientData,
- Tcl_Interp *interp, Tcl_Value *args,
- Tcl_Value *resultPtr);
-static int TestMathFunc2(ClientData clientData,
- Tcl_Interp *interp, Tcl_Value *args,
- Tcl_Value *resultPtr);
-static int TestmainthreadCmd(ClientData dummy,
+static int TestmainthreadCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestsetmainloopCmd(ClientData dummy,
+static int TestsetmainloopCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestexitmainloopCmd(ClientData dummy,
+static int TestexitmainloopCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestpanicCmd(ClientData dummy,
+static int TestpanicCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
+static int TestparseargsCmd(void *dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int TestparserObjCmd(ClientData dummy,
+static int TestparserObjCmd(void *dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestparsevarObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestparsevarObjCmd(ClientData dummy,
+static int TestparsevarnameObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestparsevarnameObjCmd(ClientData dummy,
+static int TestpreferstableObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestregexpObjCmd(ClientData dummy,
+static int TestprintObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestreturnObjCmd(ClientData dummy,
+static int TestregexpObjCmd(void *dummy,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int TestreturnObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void TestregexpXflags(const char *string,
int length, int *cflagsPtr, int *eflagsPtr);
-static int TestsaveresultCmd(ClientData dummy,
+static int TestsaveresultCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void TestsaveresultFree(char *blockPtr);
-static int TestsetassocdataCmd(ClientData dummy,
+static int TestsetassocdataCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestsetCmd(ClientData dummy,
+static int TestsetCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int Testset2Cmd(ClientData dummy,
+static int Testset2Cmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestseterrorcodeCmd(ClientData dummy,
+static int TestseterrorcodeCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestsetobjerrorcodeCmd(
- ClientData dummy, Tcl_Interp *interp,
+ void *dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int TestsetplatformCmd(ClientData dummy,
+static int TestsetplatformCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TeststaticpkgCmd(ClientData dummy,
+static int TeststaticpkgCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TesttranslatefilenameCmd(ClientData dummy,
+static int TesttranslatefilenameCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestupvarCmd(ClientData dummy,
+static int TestupvarCmd(void *dummy,
Tcl_Interp *interp, int argc, const char **argv);
static int TestWrongNumArgsObjCmd(
- ClientData clientData, Tcl_Interp *interp,
+ void *clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TestGetIndexFromObjStructObjCmd(
- ClientData clientData, Tcl_Interp *interp,
+ void *clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-static int TestChannelCmd(ClientData clientData,
+static int TestChannelCmd(void *clientData,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestChannelEventCmd(ClientData clientData,
+static int TestChannelEventCmd(void *clientData,
Tcl_Interp *interp, int argc, const char **argv);
-static int TestFilesystemObjCmd(ClientData dummy,
+static int TestSocketCmd(void *clientData,
+ Tcl_Interp *interp, int argc, const char **argv);
+static int TestFilesystemObjCmd(void *dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static int TestSimpleFilesystemObjCmd(
- ClientData dummy, Tcl_Interp *interp, int objc,
+ void *dummy, Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static void TestReport(const char *cmd, Tcl_Obj *arg1,
Tcl_Obj *arg2);
@@ -407,31 +418,31 @@ static Tcl_FSListVolumesProc SimpleListVolumes;
static Tcl_FSPathInFilesystemProc SimplePathInFilesystem;
static Tcl_Obj * SimpleRedirect(Tcl_Obj *pathPtr);
static Tcl_FSMatchInDirectoryProc SimpleMatchInDirectory;
-static int TestNumUtfCharsCmd(ClientData clientData,
+static int TestNumUtfCharsCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestFindFirstCmd(ClientData clientData,
+static int TestFindFirstCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestFindLastCmd(ClientData clientData,
+static int TestFindLastCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestHashSystemHashCmd(ClientData clientData,
+static int TestHashSystemHashCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static Tcl_NRPostProc NREUnwind_callback;
-static int TestNREUnwind(ClientData clientData,
+static int TestNREUnwind(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestNRELevels(ClientData clientData,
+static int TestNRELevels(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestInterpResolverCmd(ClientData clientData,
+static int TestInterpResolverCmd(void *clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
#if defined(HAVE_CPUID) || defined(_WIN32)
-static int TestcpuidCmd(ClientData dummy,
+static int TestcpuidCmd(void *dummy,
Tcl_Interp* interp, int objc,
Tcl_Obj *const objv[]);
#endif
@@ -541,8 +552,6 @@ int
Tcltest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
- Tcl_ValueType t3ArgTypes[2];
-
Tcl_Obj *listPtr;
Tcl_Obj **objv;
int objc, index;
@@ -551,10 +560,10 @@ Tcltest_Init(
"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
};
- if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
- if (Tcl_TomMath_InitStubs(interp, "8.5") == NULL) {
+ if (Tcl_TomMath_InitStubs(interp, "8.5-") == NULL) {
return TCL_ERROR;
}
if (Tcl_OOInitStubs(interp) == NULL) {
@@ -562,7 +571,7 @@ Tcltest_Init(
}
/* TIP #268: Full patchlevel instead of just major.minor */
- if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
+ if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
return TCL_ERROR;
}
@@ -575,6 +584,7 @@ Tcltest_Init(
Tcl_CreateObjCommand(interp, "noop", NoopObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testpurebytesobj", TestpurebytesobjObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testbytestring", TestbytestringObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "teststringbytes", TeststringbytesObjCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testwrongnumargs", TestWrongNumArgsObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testfilesystem", TestFilesystemObjCmd,
@@ -641,6 +651,8 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
NULL, NULL);
+ Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testgetvarfullname",
@@ -658,6 +670,10 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
+ NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testprint", TestprintObjCmd,
+ NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -669,9 +685,9 @@ Tcltest_Init(
Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testseterr", TestsetCmd,
- (ClientData) TCL_LEAVE_ERR_MSG, NULL);
+ INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
Tcl_CreateCommand(interp, "testset2", Testset2Cmd,
- (ClientData) TCL_LEAVE_ERR_MSG, NULL);
+ INT2PTR(TCL_LEAVE_ERR_MSG), NULL);
Tcl_CreateCommand(interp, "testseterrorcode", TestseterrorcodeCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testsetobjerrorcode",
@@ -684,13 +700,13 @@ Tcltest_Init(
TestFindLastCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd,
NULL, NULL);
+ Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
+ NULL, NULL);
Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testtranslatefilename",
TesttranslatefilenameCmd, NULL, NULL);
Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
- Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
- Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
NULL);
Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
@@ -699,13 +715,8 @@ Tcltest_Init(
NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
- (ClientData) 0, NULL);
+ NULL, NULL);
#endif
- t3ArgTypes[0] = TCL_EITHER;
- t3ArgTypes[1] = TCL_EITHER;
- Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
- NULL);
-
Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
@@ -719,7 +730,7 @@ Tcltest_Init(
if (Procbodytest_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (TclThread_Init(interp) != TCL_OK) {
return TCL_ERROR;
}
@@ -788,7 +799,7 @@ int
Tcltest_SafeInit(
Tcl_Interp *interp) /* Interpreter for application. */
{
- if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
return Procbodytest_SafeInit(interp);
@@ -814,7 +825,7 @@ Tcltest_SafeInit(
/* ARGSUSED */
static int
TestasyncCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -825,7 +836,7 @@ TestasyncCmd(
if (argc < 2) {
wrongNumArgs:
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
@@ -899,7 +910,7 @@ TestasyncCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
Tcl_MutexUnlock(&asyncTestMutex);
return code;
-#ifdef TCL_THREADS
+#if TCL_THREADS
} else if (strcmp(argv[1], "marklater") == 0) {
if (argc != 3) {
goto wrongNumArgs;
@@ -915,7 +926,7 @@ TestasyncCmd(
if (Tcl_CreateThread(&threadID, AsyncThreadProc,
INT2PTR(id), TCL_THREAD_STACK_DEFAULT,
TCL_THREAD_NOFLAGS) != TCL_OK) {
- Tcl_SetResult(interp, "can't create thread", TCL_STATIC);
+ Tcl_AppendResult(interp, "can't create thread", NULL);
Tcl_MutexUnlock(&asyncTestMutex);
return TCL_ERROR;
}
@@ -939,7 +950,7 @@ TestasyncCmd(
static int
AsyncHandlerProc(
- ClientData clientData, /* If of TestAsyncHandler structure.
+ void *clientData, /* If of TestAsyncHandler structure.
* in global list. */
Tcl_Interp *interp, /* Interpreter in which command was
* executed, or NULL. */
@@ -996,10 +1007,10 @@ AsyncHandlerProc(
*----------------------------------------------------------------------
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
- ClientData clientData) /* Parameter is the id of a
+ void *clientData) /* Parameter is the id of a
* TestAsyncHandler, defined above. */
{
TestAsyncHandler *asyncPtr;
@@ -1041,7 +1052,7 @@ AsyncThreadProc(
/* ARGSUSED */
static int
TestcmdinfoCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1054,7 +1065,7 @@ TestcmdinfoCmd(
return TCL_ERROR;
}
if (strcmp(argv[1], "create") == 0) {
- Tcl_CreateCommand(interp, argv[2], CmdProc1, (ClientData) "original",
+ Tcl_CreateCommand(interp, argv[2], CmdProc1, (void *) "original",
CmdDelProc1);
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_DStringInit(&delString);
@@ -1062,7 +1073,7 @@ TestcmdinfoCmd(
Tcl_DStringResult(interp, &delString);
} else if (strcmp(argv[1], "get") == 0) {
if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
- Tcl_SetResult(interp, "??", TCL_STATIC);
+ Tcl_AppendResult(interp, "??", NULL);
return TCL_OK;
}
if (info.proc == CmdProc1) {
@@ -1091,11 +1102,11 @@ TestcmdinfoCmd(
}
} else if (strcmp(argv[1], "modify") == 0) {
info.proc = CmdProc2;
- info.clientData = (ClientData) "new_command_data";
+ info.clientData = (void *) "new_command_data";
info.objProc = NULL;
info.objClientData = NULL;
info.deleteProc = CmdDelProc2;
- info.deleteData = (ClientData) "new_delete_data";
+ info.deleteData = (void *) "new_delete_data";
if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
} else {
@@ -1112,7 +1123,7 @@ TestcmdinfoCmd(
/*ARGSUSED*/
static int
CmdProc1(
- ClientData clientData, /* String to return. */
+ void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1124,7 +1135,7 @@ CmdProc1(
/*ARGSUSED*/
static int
CmdProc2(
- ClientData clientData, /* String to return. */
+ void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1135,7 +1146,7 @@ CmdProc2(
static void
CmdDelProc1(
- ClientData clientData) /* String to save. */
+ void *clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
Tcl_DStringAppend(&delString, "CmdDelProc1 ", -1);
@@ -1144,7 +1155,7 @@ CmdDelProc1(
static void
CmdDelProc2(
- ClientData clientData) /* String to save. */
+ void *clientData) /* String to save. */
{
Tcl_DStringInit(&delString);
Tcl_DStringAppend(&delString, "CmdDelProc2 ", -1);
@@ -1171,7 +1182,7 @@ CmdDelProc2(
/* ARGSUSED */
static int
TestcmdtokenCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1187,9 +1198,9 @@ TestcmdtokenCmd(
}
if (strcmp(argv[1], "create") == 0) {
token = Tcl_CreateCommand(interp, argv[2], CmdProc1,
- (ClientData) "original", NULL);
+ (void *) "original", NULL);
sprintf(buf, "%p", (void *)token);
- Tcl_SetResult(interp, buf, TCL_VOLATILE);
+ Tcl_AppendResult(interp, buf, NULL);
} else if (strcmp(argv[1], "name") == 0) {
Tcl_Obj *objPtr;
@@ -1235,7 +1246,7 @@ TestcmdtokenCmd(
/* ARGSUSED */
static int
TestcmdtraceCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1291,11 +1302,11 @@ TestcmdtraceCmd(
deleteCalled = 0;
cmdTrace = Tcl_CreateObjTrace(interp, 50000,
TCL_ALLOW_INLINE_COMPILATION, ObjTraceProc,
- (ClientData) &deleteCalled, ObjTraceDeleteProc);
- result = Tcl_Eval(interp, argv[2]);
+ &deleteCalled, ObjTraceDeleteProc);
+ result = Tcl_EvalEx(interp, argv[2], -1, 0);
Tcl_DeleteTrace(interp, cmdTrace);
if (!deleteCalled) {
- Tcl_SetResult(interp, "Delete wasn't called", TCL_STATIC);
+ Tcl_AppendResult(interp, "Delete wasn't called", NULL);
return TCL_ERROR;
} else {
return result;
@@ -1306,7 +1317,7 @@ TestcmdtraceCmd(
Tcl_DStringInit(&buffer);
t1 = Tcl_CreateTrace(interp, 1, CmdTraceProc, &buffer);
t2 = Tcl_CreateTrace(interp, 50000, CmdTraceProc, &buffer);
- result = Tcl_Eval(interp, argv[2]);
+ result = Tcl_EvalEx(interp, argv[2], -1, 0);
if (result == TCL_OK) {
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, Tcl_DStringValue(&buffer), NULL);
@@ -1324,7 +1335,7 @@ TestcmdtraceCmd(
static void
CmdTraceProc(
- ClientData clientData, /* Pointer to buffer in which the
+ void *clientData, /* Pointer to buffer in which the
* command and arguments are appended.
* Accumulates test result. */
Tcl_Interp *interp, /* Current interpreter. */
@@ -1332,7 +1343,7 @@ CmdTraceProc(
char *command, /* The command being traced (after
* substitutions). */
Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */
- ClientData cmdClientData, /* Client data associated with command
+ void *cmdClientData, /* Client data associated with command
* procedure. */
int argc, /* Number of arguments. */
const char *argv[]) /* Argument strings. */
@@ -1351,13 +1362,13 @@ CmdTraceProc(
static void
CmdTraceDeleteProc(
- ClientData clientData, /* Unused. */
+ void *clientData, /* Unused. */
Tcl_Interp *interp, /* Current interpreter. */
int level, /* Current trace level. */
char *command, /* The command being traced (after
* substitutions). */
Tcl_CmdProc *cmdProc, /* Points to command's command procedure. */
- ClientData cmdClientData, /* Client data associated with command
+ void *cmdClientData, /* Client data associated with command
* procedure. */
int argc, /* Number of arguments. */
const char *argv[]) /* Argument strings. */
@@ -1373,7 +1384,7 @@ CmdTraceDeleteProc(
static int
ObjTraceProc(
- ClientData clientData, /* unused */
+ void *clientData, /* unused */
Tcl_Interp *interp, /* Tcl interpreter */
int level, /* Execution level */
const char *command, /* Command being executed */
@@ -1401,7 +1412,7 @@ ObjTraceProc(
static void
ObjTraceDeleteProc(
- ClientData clientData)
+ void *clientData)
{
int *intPtr = (int *) clientData;
*intPtr = 1; /* Record that the trace was deleted */
@@ -1430,7 +1441,7 @@ ObjTraceDeleteProc(
static int
TestcreatecommandCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1460,7 +1471,7 @@ TestcreatecommandCmd(
static int
CreatedCommandProc(
- ClientData clientData, /* String to return. */
+ void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1482,7 +1493,7 @@ CreatedCommandProc(
static int
CreatedCommandProc2(
- ClientData clientData, /* String to return. */
+ void *clientData, /* String to return. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1521,7 +1532,7 @@ CreatedCommandProc2(
/* ARGSUSED */
static int
TestdcallCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1536,10 +1547,10 @@ TestdcallCmd(
}
if (id < 0) {
Tcl_DontCallWhenDeleted(delInterp, DelCallbackProc,
- (ClientData) INT2PTR(-id));
+ INT2PTR(-id));
} else {
Tcl_CallWhenDeleted(delInterp, DelCallbackProc,
- (ClientData) INT2PTR(id));
+ INT2PTR(id));
}
}
Tcl_DeleteInterp(delInterp);
@@ -1553,7 +1564,7 @@ TestdcallCmd(
static void
DelCallbackProc(
- ClientData clientData, /* Numerical value to append to delString. */
+ void *clientData, /* Numerical value to append to delString. */
Tcl_Interp *interp) /* Interpreter being deleted. */
{
int id = PTR2INT(clientData);
@@ -1586,7 +1597,7 @@ DelCallbackProc(
/* ARGSUSED */
static int
TestdelCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1595,7 +1606,7 @@ TestdelCmd(
Tcl_Interp *slave;
if (argc != 4) {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
@@ -1609,14 +1620,14 @@ TestdelCmd(
dPtr->deleteCmd = ckalloc(strlen(argv[3]) + 1);
strcpy(dPtr->deleteCmd, argv[3]);
- Tcl_CreateCommand(slave, argv[2], DelCmdProc, (ClientData) dPtr,
+ Tcl_CreateCommand(slave, argv[2], DelCmdProc, dPtr,
DelDeleteProc);
return TCL_OK;
}
static int
DelCmdProc(
- ClientData clientData, /* String result to return. */
+ void *clientData, /* String result to return. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1631,11 +1642,11 @@ DelCmdProc(
static void
DelDeleteProc(
- ClientData clientData) /* String command to evaluate. */
+ void *clientData) /* String command to evaluate. */
{
DelCmd *dPtr = clientData;
- Tcl_Eval(dPtr->interp, dPtr->deleteCmd);
+ Tcl_EvalEx(dPtr->interp, dPtr->deleteCmd, -1, 0);
Tcl_ResetResult(dPtr->interp);
ckfree(dPtr->deleteCmd);
ckfree(dPtr);
@@ -1661,7 +1672,7 @@ DelDeleteProc(
static int
TestdelassocdataCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1697,7 +1708,7 @@ TestdelassocdataCmd(
*/
static int
-TestdoubledigitsObjCmd(ClientData unused,
+TestdoubledigitsObjCmd(void *unused,
/* NULL */
Tcl_Interp* interp,
/* Tcl interpreter */
@@ -1791,7 +1802,7 @@ TestdoubledigitsObjCmd(ClientData unused,
/* ARGSUSED */
static int
TestdstringCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -1800,7 +1811,7 @@ TestdstringCmd(
if (argc < 2) {
wrongNumArgs:
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
if (strcmp(argv[1], "append") == 0) {
@@ -1836,9 +1847,9 @@ TestdstringCmd(
goto wrongNumArgs;
}
if (strcmp(argv[2], "staticsmall") == 0) {
- Tcl_SetResult(interp, "short", TCL_STATIC);
+ Tcl_AppendResult(interp, "short", NULL);
} else if (strcmp(argv[2], "staticlarge") == 0) {
- Tcl_SetResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", TCL_STATIC);
+ Tcl_AppendResult(interp, "first0 first1 first2 first3 first4 first5 first6 first7 first8 first9\nsecond0 second1 second2 second3 second4 second5 second6 second7 second8 second9\nthird0 third1 third2 third3 third4 third5 third6 third7 third8 third9\nfourth0 fourth1 fourth2 fourth3 fourth4 fourth5 fourth6 fourth7 fourth8 fourth9\nfifth0 fifth1 fifth2 fifth3 fifth4 fifth5 fifth6 fifth7 fifth8 fifth9\nsixth0 sixth1 sixth2 sixth3 sixth4 sixth5 sixth6 sixth7 sixth8 sixth9\nseventh0 seventh1 seventh2 seventh3 seventh4 seventh5 seventh6 seventh7 seventh8 seventh9\n", NULL);
} else if (strcmp(argv[2], "free") == 0) {
char *s = ckalloc(100);
strcpy(s, "This is a malloc-ed string");
@@ -1918,7 +1929,7 @@ static void SpecialFree(blockPtr)
/* ARGSUSED */
static int
TestencodingObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1951,11 +1962,11 @@ TestencodingObjCmd(
string = Tcl_GetStringFromObj(objv[3], &length);
encodingPtr->toUtfCmd = ckalloc(length + 1);
- memcpy(encodingPtr->toUtfCmd, string, (unsigned) length + 1);
+ memcpy(encodingPtr->toUtfCmd, string, length + 1);
string = Tcl_GetStringFromObj(objv[4], &length);
encodingPtr->fromUtfCmd = ckalloc(length + 1);
- memcpy(encodingPtr->fromUtfCmd, string, (unsigned) (length + 1));
+ memcpy(encodingPtr->fromUtfCmd, string, length + 1);
string = Tcl_GetStringFromObj(objv[2], &length);
@@ -1963,7 +1974,7 @@ TestencodingObjCmd(
type.toUtfProc = EncodingToUtfProc;
type.fromUtfProc = EncodingFromUtfProc;
type.freeProc = EncodingFreeProc;
- type.clientData = (ClientData) encodingPtr;
+ type.clientData = encodingPtr;
type.nullSize = 1;
Tcl_CreateEncoding(&type);
@@ -1973,9 +1984,12 @@ TestencodingObjCmd(
if (objc != 3) {
return TCL_ERROR;
}
- encoding = Tcl_GetEncoding(NULL, Tcl_GetString(objv[2]));
- Tcl_FreeEncoding(encoding);
- Tcl_FreeEncoding(encoding);
+ if (TCL_OK != Tcl_GetEncodingFromObj(interp, objv[2], &encoding)) {
+ return TCL_ERROR;
+ }
+ Tcl_FreeEncoding(encoding); /* Free returned reference */
+ Tcl_FreeEncoding(encoding); /* Free to match CREATE */
+ TclFreeIntRep(objv[2]); /* Free the cached ref */
break;
}
return TCL_OK;
@@ -1983,7 +1997,7 @@ TestencodingObjCmd(
static int
EncodingToUtfProc(
- ClientData clientData, /* TclEncoding structure. */
+ void *clientData, /* TclEncoding structure. */
const char *src, /* Source string in specified encoding. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -1998,13 +2012,13 @@ EncodingToUtfProc(
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
- Tcl_EvalEx(encodingPtr->interp,encodingPtr->toUtfCmd,-1,TCL_EVAL_GLOBAL);
+ Tcl_EvalEx(encodingPtr->interp, encodingPtr->toUtfCmd, -1, TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
len = dstLen;
}
- memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
+ memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
Tcl_ResetResult(encodingPtr->interp);
*srcReadPtr = srcLen;
@@ -2015,7 +2029,7 @@ EncodingToUtfProc(
static int
EncodingFromUtfProc(
- ClientData clientData, /* TclEncoding structure. */
+ void *clientData, /* TclEncoding structure. */
const char *src, /* Source string in specified encoding. */
int srcLen, /* Source string length in bytes. */
int flags, /* Conversion control flags. */
@@ -2030,13 +2044,13 @@ EncodingFromUtfProc(
TclEncoding *encodingPtr;
encodingPtr = (TclEncoding *) clientData;
- Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd,-1,TCL_EVAL_GLOBAL);
+ Tcl_EvalEx(encodingPtr->interp, encodingPtr->fromUtfCmd, -1, TCL_EVAL_GLOBAL);
len = strlen(Tcl_GetStringResult(encodingPtr->interp));
if (len > dstLen) {
len = dstLen;
}
- memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), (unsigned) len);
+ memcpy(dst, Tcl_GetStringResult(encodingPtr->interp), len);
Tcl_ResetResult(encodingPtr->interp);
*srcReadPtr = srcLen;
@@ -2047,7 +2061,7 @@ EncodingFromUtfProc(
static void
EncodingFreeProc(
- ClientData clientData) /* ClientData associated with type. */
+ void *clientData) /* ClientData associated with type. */
{
TclEncoding *encodingPtr = clientData;
@@ -2075,7 +2089,7 @@ EncodingFreeProc(
static int
TestevalexObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2120,7 +2134,7 @@ TestevalexObjCmd(
static int
TestevalobjvObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2169,7 +2183,7 @@ TestevalobjvObjCmd(
static int
TesteventObjCmd(
- ClientData unused, /* Not used */
+ void *unused, /* Not used */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const objv[]) /* Parameter vector */
@@ -2266,14 +2280,14 @@ TesteventProc(
if (result != TCL_OK) {
Tcl_AddErrorInfo(interp,
" (command bound to \"testevent\" callback)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, TCL_ERROR);
return 1; /* Avoid looping on errors */
}
if (Tcl_GetBooleanFromObj(interp, Tcl_GetObjResult(interp),
&retval) != TCL_OK) {
Tcl_AddErrorInfo(interp,
" (return value from \"testevent\" callback)");
- Tcl_BackgroundError(interp);
+ Tcl_BackgroundException(interp, TCL_ERROR);
return 1;
}
if (retval) {
@@ -2305,7 +2319,7 @@ TesteventProc(
static int
TesteventDeleteProc(
Tcl_Event *event, /* Event to examine */
- ClientData clientData) /* Tcl_Obj containing the name of the event(s)
+ void *clientData) /* Tcl_Obj containing the name of the event(s)
* to remove */
{
TestEvent *ev; /* Event to examine */
@@ -2348,7 +2362,7 @@ TesteventDeleteProc(
static int
TestexithandlerCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2365,10 +2379,10 @@ TestexithandlerCmd(
}
if (strcmp(argv[1], "create") == 0) {
Tcl_CreateExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
- (ClientData) INT2PTR(value));
+ INT2PTR(value));
} else if (strcmp(argv[1], "delete") == 0) {
Tcl_DeleteExitHandler((value & 1) ? ExitProcOdd : ExitProcEven,
- (ClientData) INT2PTR(value));
+ INT2PTR(value));
} else {
Tcl_AppendResult(interp, "bad option \"", argv[1],
"\": must be create or delete", NULL);
@@ -2379,12 +2393,12 @@ TestexithandlerCmd(
static void
ExitProcOdd(
- ClientData clientData) /* Integer value to print. */
+ void *clientData) /* Integer value to print. */
{
char buf[16 + TCL_INTEGER_SPACE];
size_t len;
- sprintf(buf, "odd %d\n", PTR2INT(clientData));
+ sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
Tcl_Panic("ExitProcOdd: unable to write to stdout");
@@ -2393,12 +2407,12 @@ ExitProcOdd(
static void
ExitProcEven(
- ClientData clientData) /* Integer value to print. */
+ void *clientData) /* Integer value to print. */
{
char buf[16 + TCL_INTEGER_SPACE];
size_t len;
- sprintf(buf, "even %d\n", PTR2INT(clientData));
+ sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
len = strlen(buf);
if (len != (size_t) write(1, buf, len)) {
Tcl_Panic("ExitProcEven: unable to write to stdout");
@@ -2424,7 +2438,7 @@ ExitProcEven(
static int
TestexprlongCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2438,7 +2452,7 @@ TestexprlongCmd(
" expression\"", NULL);
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprLong(interp, argv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2467,7 +2481,7 @@ TestexprlongCmd(
static int
TestexprlongobjCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
@@ -2480,7 +2494,7 @@ TestexprlongobjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprLongObj(interp, objv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2509,7 +2523,7 @@ TestexprlongobjCmd(
static int
TestexprdoubleCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2523,7 +2537,7 @@ TestexprdoubleCmd(
" expression\"", NULL);
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprDouble(interp, argv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2553,7 +2567,7 @@ TestexprdoubleCmd(
static int
TestexprdoubleobjCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const *objv) /* Argument objects. */
@@ -2566,7 +2580,7 @@ TestexprdoubleobjCmd(
Tcl_WrongNumArgs(interp, 1, objv, "expression");
return TCL_ERROR;
}
- Tcl_SetResult(interp, "This is a result", TCL_STATIC);
+ Tcl_AppendResult(interp, "This is a result", NULL);
result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult);
if (result != TCL_OK) {
return result;
@@ -2595,7 +2609,7 @@ TestexprdoubleobjCmd(
static int
TestexprstringCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2627,7 +2641,7 @@ TestexprstringCmd(
static int
TestfilelinkCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -2694,7 +2708,7 @@ TestfilelinkCmd(
static int
TestgetassocdataCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2732,7 +2746,7 @@ TestgetassocdataCmd(
static int
TestgetplatformCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2773,7 +2787,7 @@ TestgetplatformCmd(
/* ARGSUSED */
static int
TestinterpdeleteCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2814,7 +2828,7 @@ TestinterpdeleteCmd(
/* ARGSUSED */
static int
TestlinkCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -2822,7 +2836,7 @@ TestlinkCmd(
static int intVar = 43;
static int boolVar = 4;
static double realVar = 1.23;
- static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
+ static Tcl_WideInt wideVar = 79;
static char *stringVar = NULL;
static char charVar = '@';
static unsigned char ucharVar = 130;
@@ -2832,7 +2846,7 @@ TestlinkCmd(
static long longVar = 123456789L;
static unsigned long ulongVar = 3456789012UL;
static float floatVar = 4.5;
- static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123);
+ static Tcl_WideUInt uwideVar = 123;
static int created = 0;
char buffer[2*TCL_DOUBLE_SPACE];
int writable, flag;
@@ -3022,10 +3036,10 @@ TestlinkCmd(
Tcl_AppendElement(interp, buffer);
TclFormatInt(buffer, (int) uintVar);
Tcl_AppendElement(interp, buffer);
- tmp = Tcl_NewLongObj(longVar);
+ tmp = Tcl_NewWideIntObj(longVar);
Tcl_AppendElement(interp, Tcl_GetString(tmp));
Tcl_DecrRefCount(tmp);
- tmp = Tcl_NewLongObj((long)ulongVar);
+ tmp = Tcl_NewWideIntObj((long)ulongVar);
Tcl_AppendElement(interp, Tcl_GetString(tmp));
Tcl_DecrRefCount(tmp);
Tcl_PrintDouble(NULL, (double)floatVar, buffer);
@@ -3282,7 +3296,7 @@ TestlinkCmd(
static int
TestlocaleCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3328,144 +3342,6 @@ TestlocaleCmd(
/*
*----------------------------------------------------------------------
*
- * TestMathFunc --
- *
- * This is a user-defined math procedure to test out math procedures
- * with no arguments.
- *
- * Results:
- * A normal Tcl completion code.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TestMathFunc(
- ClientData clientData, /* Integer value to return. */
- Tcl_Interp *interp, /* Not used. */
- Tcl_Value *args, /* Not used. */
- Tcl_Value *resultPtr) /* Where to store result. */
-{
- resultPtr->type = TCL_INT;
- resultPtr->intValue = PTR2INT(clientData);
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TestMathFunc2 --
- *
- * This is a user-defined math procedure to test out math procedures
- * that do have arguments, in this case 2.
- *
- * Results:
- * A normal Tcl completion code.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
- /* ARGSUSED */
-static int
-TestMathFunc2(
- ClientData clientData, /* Integer value to return. */
- Tcl_Interp *interp, /* Used to report errors. */
- Tcl_Value *args, /* Points to an array of two Tcl_Value structs
- * for the two arguments. */
- Tcl_Value *resultPtr) /* Where to store the result. */
-{
- int result = TCL_OK;
-
- /*
- * Return the maximum of the two arguments with the correct type.
- */
-
- if (args[0].type == TCL_INT) {
- int i0 = args[0].intValue;
-
- if (args[1].type == TCL_INT) {
- int i1 = args[1].intValue;
-
- resultPtr->type = TCL_INT;
- resultPtr->intValue = ((i0 > i1)? i0 : i1);
- } else if (args[1].type == TCL_DOUBLE) {
- double d0 = i0;
- 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 w0 = Tcl_LongAsWide(i0);
- Tcl_WideInt w1 = args[1].wideValue;
-
- resultPtr->type = TCL_WIDE_INT;
- resultPtr->wideValue = ((w0 > w1)? w0 : w1);
- } else {
- Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
- result = TCL_ERROR;
- }
- } else if (args[0].type == TCL_DOUBLE) {
- double d0 = args[0].doubleValue;
-
- if (args[1].type == TCL_INT) {
- double d1 = args[1].intValue;
-
- resultPtr->type = TCL_DOUBLE;
- resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
- } else if (args[1].type == TCL_DOUBLE) {
- double d1 = args[1].doubleValue;
-
- resultPtr->type = TCL_DOUBLE;
- resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
- } 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);
- } else {
- Tcl_SetResult(interp, "T3: wrong type for arg 2", TCL_STATIC);
- result = TCL_ERROR;
- }
- } 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, "T3: wrong type for arg 2", TCL_STATIC);
- result = TCL_ERROR;
- }
- } else {
- Tcl_SetResult(interp, "T3: wrong type for arg 1", TCL_STATIC);
- result = TCL_ERROR;
- }
- return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* CleanupTestSetassocdataTests --
*
* This function is called when an interpreter is deleted to clean
@@ -3482,7 +3358,7 @@ TestMathFunc2(
/* ARGSUSED */
static void
CleanupTestSetassocdataTests(
- ClientData clientData, /* Data to be released. */
+ void *clientData, /* Data to be released. */
Tcl_Interp *interp) /* Interpreter being deleted. */
{
ckfree(clientData);
@@ -3507,7 +3383,7 @@ CleanupTestSetassocdataTests(
static int
TestparserObjCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3563,7 +3439,7 @@ TestparserObjCmd(
static int
TestexprparserObjCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3710,7 +3586,7 @@ PrintParse(
static int
TestparsevarObjCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3751,7 +3627,7 @@ TestparsevarObjCmd(
static int
TestparsevarnameObjCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -3797,6 +3673,75 @@ TestparsevarnameObjCmd(
/*
*----------------------------------------------------------------------
*
+ * TestpreferstableObjCmd --
+ *
+ * This procedure implements the "testpreferstable" command. It is
+ * used for being able to test the "package" command even when the
+ * environment variable TCL_PKG_PREFER_LATEST is set in your environment.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestpreferstableObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ Interp *iPtr = (Interp *) interp;
+ iPtr->packagePrefer = PKG_PREFER_STABLE;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestprintObjCmd --
+ *
+ * This procedure implements the "testprint" command. It is
+ * used for being able to test the Tcl_ObjPrintf() function.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestprintObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ Tcl_WideInt argv1 = 0;
+ size_t argv2;
+
+ if (objc < 2 || objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "format wideint");
+ }
+
+ if (objc > 1) {
+ Tcl_GetWideIntFromObj(interp, objv[2], &argv1);
+ }
+ argv2 = (size_t)argv1;
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(Tcl_GetString(objv[1]), argv1, argv2, argv2));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestregexpObjCmd --
*
* This procedure implements the "testregexp" command. It is used to give
@@ -3816,7 +3761,7 @@ TestparsevarnameObjCmd(
/* ARGSUSED */
static int
TestregexpObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -3940,7 +3885,7 @@ TestregexpObjCmd(
varName = Tcl_GetString(objv[2]);
TclRegExpRangeUniChar(regExpr, -1, &start, &end);
sprintf(resinfo, "%d %d", start, end-1);
- value = Tcl_SetVar(interp, varName, resinfo, 0);
+ value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
varName, "\"", NULL);
@@ -3954,7 +3899,7 @@ TestregexpObjCmd(
Tcl_RegExpGetInfo(regExpr, &info);
varName = Tcl_GetString(objv[2]);
sprintf(resinfo, "%ld", info.extendStart);
- value = Tcl_SetVar(interp, varName, resinfo, 0);
+ value = Tcl_SetVar2(interp, varName, NULL, resinfo, 0);
if (value == NULL) {
Tcl_AppendResult(interp, "couldn't set variable \"",
varName, "\"", NULL);
@@ -4001,8 +3946,8 @@ TestregexpObjCmd(
end--;
}
- objs[0] = Tcl_NewLongObj(start);
- objs[1] = Tcl_NewLongObj(end);
+ objs[0] = Tcl_NewWideIntObj(start);
+ objs[1] = Tcl_NewWideIntObj(end);
newPtr = Tcl_NewListObj(2, objs);
} else {
@@ -4140,7 +4085,7 @@ TestregexpXflags(
/* ARGSUSED */
static int
TestreturnObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -4168,7 +4113,7 @@ TestreturnObjCmd(
static int
TestsetassocdataCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4195,8 +4140,7 @@ TestsetassocdataCmd(
ckfree(oldData);
}
- Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests,
- (ClientData) buf);
+ Tcl_SetAssocData(interp, argv[1], CleanupTestSetassocdataTests, buf);
return TCL_OK;
}
@@ -4220,7 +4164,7 @@ TestsetassocdataCmd(
static int
TestsetplatformCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4269,7 +4213,7 @@ TestsetplatformCmd(
static int
TeststaticpkgCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4287,7 +4231,7 @@ TeststaticpkgCmd(
if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
return TCL_ERROR;
}
- tclStubsPtr->tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
+ Tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
StaticInitProc, (safe) ? StaticInitProc : NULL);
return TCL_OK;
}
@@ -4297,7 +4241,7 @@ StaticInitProc(
Tcl_Interp *interp) /* Interpreter in which package is supposedly
* being loaded. */
{
- Tcl_SetVar(interp, "x", "loaded", TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "x", NULL, "loaded", TCL_GLOBAL_ONLY);
return TCL_OK;
}
@@ -4320,7 +4264,7 @@ StaticInitProc(
static int
TesttranslatefilenameCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4362,7 +4306,7 @@ TesttranslatefilenameCmd(
/* ARGSUSED */
static int
TestupvarCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4381,7 +4325,7 @@ TestupvarCmd(
} else if (strcmp(argv[4], "namespace") == 0) {
flags = TCL_NAMESPACE_ONLY;
}
- return Tcl_UpVar(interp, argv[1], argv[2], argv[3], flags);
+ return Tcl_UpVar2(interp, argv[1], argv[2], NULL, argv[3], flags);
} else {
if (strcmp(argv[5], "global") == 0) {
flags = TCL_GLOBAL_ONLY;
@@ -4415,13 +4359,13 @@ TestupvarCmd(
/* ARGSUSED */
static int
TestseterrorcodeCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
{
if (argc > 6) {
- Tcl_SetResult(interp, "too many args", TCL_STATIC);
+ Tcl_AppendResult(interp, "too many args", NULL);
return TCL_ERROR;
}
switch (argc) {
@@ -4468,7 +4412,7 @@ TestseterrorcodeCmd(
/* ARGSUSED */
static int
TestsetobjerrorcodeCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4497,7 +4441,7 @@ TestsetobjerrorcodeCmd(
/* ARGSUSED */
static int
TestfeventCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4569,7 +4513,7 @@ TestfeventCmd(
static int
TestpanicCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -4590,7 +4534,7 @@ TestpanicCmd(
static int
TestfileCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
Tcl_Obj *const argv[]) /* The argument objects. */
@@ -4672,7 +4616,7 @@ TestfileCmd(
static int
TestgetvarfullnameCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4746,7 +4690,7 @@ TestgetvarfullnameCmd(
static int
GetTimesObjCmd(
- ClientData unused, /* Unused. */
+ void *unused, /* Unused. */
Tcl_Interp *interp, /* The current interpreter. */
int notused1, /* Number of arguments. */
Tcl_Obj *const notused2[]) /* The argument objects. */
@@ -4875,10 +4819,10 @@ GetTimesObjCmd(
timePer/100000);
/* Tcl_SetVar 100000 times */
- fprintf(stderr, "Tcl_SetVar of \"12345\" 100000 times\n");
+ fprintf(stderr, "Tcl_SetVar2 of \"12345\" 100000 times\n");
Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
- s = Tcl_SetVar(interp, "a", "12345", TCL_LEAVE_ERR_MSG);
+ s = Tcl_SetVar2(interp, "a", NULL, "12345", TCL_LEAVE_ERR_MSG);
if (s == NULL) {
return TCL_ERROR;
}
@@ -4892,7 +4836,7 @@ GetTimesObjCmd(
fprintf(stderr, "Tcl_GetVar of a==\"12345\" 100000 times\n");
Tcl_GetTime(&start);
for (i = 0; i < 100000; i++) {
- s = Tcl_GetVar(interp, "a", TCL_LEAVE_ERR_MSG);
+ s = Tcl_GetVar2(interp, "a", NULL, TCL_LEAVE_ERR_MSG);
if (s == NULL) {
return TCL_ERROR;
}
@@ -4925,7 +4869,7 @@ GetTimesObjCmd(
static int
NoopCmd(
- ClientData unused, /* Unused. */
+ void *unused, /* Unused. */
Tcl_Interp *interp, /* The current interpreter. */
int argc, /* The number of arguments. */
const char **argv) /* The argument strings. */
@@ -4952,7 +4896,7 @@ NoopCmd(
static int
NoopObjCmd(
- ClientData unused, /* Not used. */
+ void *unused, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -4963,13 +4907,47 @@ NoopObjCmd(
/*
*----------------------------------------------------------------------
*
+ * TeststringbytesObjCmd --
+ * Returns bytearray value of the bytes in argument string rep
+ *
+ * Results:
+ * Returns the TCL_OK result code.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TeststringbytesObjCmd(
+ void *unused, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* The argument objects. */
+{
+ int n;
+ const unsigned char *p;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "value");
+ return TCL_ERROR;
+ }
+ p = (const unsigned char *)Tcl_GetStringFromObj(objv[1], &n);
+ Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(p, n));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestpurebytesobjObjCmd --
*
* This object-based procedure constructs a pure bytes object
* without type and with internal representation containing NULL's.
*
* If no argument supplied it returns empty object with tclEmptyStringRep,
- * otherwise it returns this as pure bytes object with bytes value equal
+ * otherwise it returns this as pure bytes object with bytes value equal
* string.
*
* Results:
@@ -5030,7 +5008,7 @@ TestpurebytesobjObjCmd(
static int
TestbytestringObjCmd(
- ClientData unused, /* Not used. */
+ void *unused, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -5067,7 +5045,7 @@ TestbytestringObjCmd(
/* ARGSUSED */
static int
TestsetCmd(
- ClientData data, /* Additional flags for Get/SetVar2. */
+ void *data, /* Additional flags for Get/SetVar2. */
register Tcl_Interp *interp,/* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -5076,7 +5054,7 @@ TestsetCmd(
const char *value;
if (argc == 2) {
- Tcl_SetResult(interp, "before get", TCL_STATIC);
+ Tcl_AppendResult(interp, "before get", NULL);
value = Tcl_GetVar2(interp, argv[1], NULL, flags);
if (value == NULL) {
return TCL_ERROR;
@@ -5084,7 +5062,7 @@ TestsetCmd(
Tcl_AppendElement(interp, value);
return TCL_OK;
} else if (argc == 3) {
- Tcl_SetResult(interp, "before set", TCL_STATIC);
+ Tcl_AppendResult(interp, "before set", NULL);
value = Tcl_SetVar2(interp, argv[1], NULL, argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
@@ -5099,7 +5077,7 @@ TestsetCmd(
}
static int
Testset2Cmd(
- ClientData data, /* Additional flags for Get/SetVar2. */
+ void *data, /* Additional flags for Get/SetVar2. */
register Tcl_Interp *interp,/* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -5108,7 +5086,7 @@ Testset2Cmd(
const char *value;
if (argc == 3) {
- Tcl_SetResult(interp, "before get", TCL_STATIC);
+ Tcl_AppendResult(interp, "before get", NULL);
value = Tcl_GetVar2(interp, argv[1], argv[2], flags);
if (value == NULL) {
return TCL_ERROR;
@@ -5116,7 +5094,7 @@ Testset2Cmd(
Tcl_AppendElement(interp, value);
return TCL_OK;
} else if (argc == 4) {
- Tcl_SetResult(interp, "before set", TCL_STATIC);
+ Tcl_AppendResult(interp, "before set", NULL);
value = Tcl_SetVar2(interp, argv[1], argv[2], argv[3], flags);
if (value == NULL) {
return TCL_ERROR;
@@ -5150,7 +5128,7 @@ Testset2Cmd(
/* ARGSUSED */
static int
TestsaveresultCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
@@ -5182,10 +5160,11 @@ TestsaveresultCmd(
return TCL_ERROR;
}
+ freeCount = 0;
objPtr = NULL; /* Lint. */
switch ((enum options) index) {
case RESULT_SMALL:
- Tcl_SetResult(interp, "small result", TCL_VOLATILE);
+ Tcl_AppendResult(interp, "small result", NULL);
break;
case RESULT_APPEND:
Tcl_AppendResult(interp, "append result", NULL);
@@ -5206,13 +5185,12 @@ TestsaveresultCmd(
break;
}
- freeCount = 0;
Tcl_SaveResult(interp, &state);
if (((enum options) index) == RESULT_OBJECT) {
result = Tcl_EvalObjEx(interp, objv[2], 0);
} else {
- result = Tcl_Eval(interp, Tcl_GetString(objv[2]));
+ result = Tcl_EvalEx(interp, Tcl_GetString(objv[2]), -1, 0);
}
if (discard) {
@@ -5224,11 +5202,9 @@ TestsaveresultCmd(
switch ((enum options) index) {
case RESULT_DYNAMIC: {
- int present = iPtr->freeProc == TestsaveresultFree;
- int called = freeCount;
+ int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;
- Tcl_AppendElement(interp, called ? "called" : "notCalled");
- Tcl_AppendElement(interp, present ? "present" : "missing");
+ Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
break;
}
case RESULT_OBJECT:
@@ -5283,7 +5259,7 @@ TestsaveresultFree(
static int
TestmainthreadCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -5294,7 +5270,7 @@ TestmainthreadCmd(
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
}
}
@@ -5344,7 +5320,7 @@ MainLoop(void)
static int
TestsetmainloopCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -5373,7 +5349,7 @@ TestsetmainloopCmd(
static int
TestexitmainloopCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
register Tcl_Interp *interp,/* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -5402,7 +5378,7 @@ TestexitmainloopCmd(
/* ARGSUSED */
static int
TestChannelCmd(
- ClientData clientData, /* Not used. */
+ void *clientData, /* Not used. */
Tcl_Interp *interp, /* Interpreter for result. */
int argc, /* Count of additional args. */
const char **argv) /* Additional arg strings. */
@@ -5871,7 +5847,7 @@ TestChannelCmd(
/* ARGSUSED */
static int
TestChannelEventCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -5896,7 +5872,7 @@ TestChannelEventCmd(
cmd = argv[2];
len = strlen(cmd);
- if ((cmd[0] == 'a') && (strncmp(cmd, "add", (unsigned) len) == 0)) {
+ if ((cmd[0] == 'a') && (strncmp(cmd, "add", len) == 0)) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName add eventSpec script\"", NULL);
@@ -5925,12 +5901,12 @@ TestChannelEventCmd(
Tcl_IncrRefCount(esPtr->scriptPtr);
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, esPtr);
return TCL_OK;
}
- if ((cmd[0] == 'd') && (strncmp(cmd, "delete", (unsigned) len) == 0)) {
+ if ((cmd[0] == 'd') && (strncmp(cmd, "delete", len) == 0)) {
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName delete index\"", NULL);
@@ -5969,14 +5945,14 @@ TestChannelEventCmd(
prevEsPtr->nextPtr = esPtr->nextPtr;
}
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree(esPtr);
return TCL_OK;
}
- if ((cmd[0] == 'l') && (strncmp(cmd, "list", (unsigned) len) == 0)) {
+ if ((cmd[0] == 'l') && (strncmp(cmd, "list", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName list\"", NULL);
@@ -5999,7 +5975,7 @@ TestChannelEventCmd(
return TCL_OK;
}
- if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", (unsigned) len) == 0)) {
+ if ((cmd[0] == 'r') && (strncmp(cmd, "removeall", len) == 0)) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName removeall\"", NULL);
@@ -6010,7 +5986,7 @@ TestChannelEventCmd(
esPtr = nextEsPtr) {
nextEsPtr = esPtr->nextPtr;
Tcl_DeleteChannelHandler((Tcl_Channel) chanPtr,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, esPtr);
Tcl_DecrRefCount(esPtr->scriptPtr);
ckfree(esPtr);
}
@@ -6018,7 +5994,7 @@ TestChannelEventCmd(
return TCL_OK;
}
- if ((cmd[0] == 's') && (strncmp(cmd, "set", (unsigned) len) == 0)) {
+ if ((cmd[0] == 's') && (strncmp(cmd, "set", len) == 0)) {
if (argc != 5) {
Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
" channelName delete index event\"", NULL);
@@ -6056,7 +6032,7 @@ TestChannelEventCmd(
}
esPtr->mask = mask;
Tcl_CreateChannelHandler((Tcl_Channel) chanPtr, mask,
- TclChannelEventScriptInvoker, (ClientData) esPtr);
+ TclChannelEventScriptInvoker, esPtr);
return TCL_OK;
}
Tcl_AppendResult(interp, "bad command ", cmd, ", must be one of "
@@ -6067,6 +6043,75 @@ TestChannelEventCmd(
/*
*----------------------------------------------------------------------
*
+ * TestSocketCmd --
+ *
+ * Implements the Tcl "testsocket" debugging command and its
+ * subcommands. This is part of the testing environment.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestSocketCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interpreter for result. */
+ int argc, /* Count of additional args. */
+ const char **argv) /* Additional arg strings. */
+{
+ const char *cmdName; /* Sub command. */
+ size_t len; /* Length of subcommand string. */
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " subcommand ?additional args..?\"", NULL);
+ return TCL_ERROR;
+ }
+ cmdName = argv[1];
+ len = strlen(cmdName);
+
+ if ((cmdName[0] == 't') && (strncmp(cmdName, "testflags", len) == 0)) {
+ Tcl_Channel hChannel;
+ int modePtr;
+ TcpState *statePtr;
+ /* Set test value in the socket driver
+ */
+ /* Check for argument "channel name"
+ */
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " testflags channel flags\"", NULL);
+ return TCL_ERROR;
+ }
+ hChannel = Tcl_GetChannel(interp, argv[2], &modePtr);
+ if ( NULL == hChannel ) {
+ Tcl_AppendResult(interp, "unknown channel:", argv[2], NULL);
+ return TCL_ERROR;
+ }
+ statePtr = (TcpState *)Tcl_GetChannelInstanceData(hChannel);
+ if ( NULL == statePtr) {
+ Tcl_AppendResult(interp, "No channel instance data:", argv[2],
+ NULL);
+ return TCL_ERROR;
+ }
+ statePtr->testFlags = atoi(argv[3]);
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad option \"", cmdName, "\": should be "
+ "testflags", NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TestWrongNumArgsObjCmd --
*
* Test the Tcl_WrongNumArgs function.
@@ -6082,7 +6127,7 @@ TestChannelEventCmd(
static int
TestWrongNumArgsObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -6095,7 +6140,7 @@ TestWrongNumArgsObjCmd(
* Don't use Tcl_WrongNumArgs here, as that is the function
* we want to test!
*/
- Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+ Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
@@ -6112,7 +6157,7 @@ TestWrongNumArgsObjCmd(
/*
* Asked for more arguments than were given.
*/
- Tcl_SetResult(interp, "insufficient arguments", TCL_STATIC);
+ Tcl_AppendResult(interp, "insufficient arguments", NULL);
return TCL_ERROR;
}
@@ -6138,7 +6183,7 @@ TestWrongNumArgsObjCmd(
static int
TestGetIndexFromObjStructObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -6192,7 +6237,7 @@ TestGetIndexFromObjStructObjCmd(
static int
TestFilesystemObjCmd(
- ClientData dummy,
+ void *dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6208,7 +6253,7 @@ TestFilesystemObjCmd(
return TCL_ERROR;
}
if (boolVal) {
- res = Tcl_FSRegister((ClientData)interp, &testReportingFilesystem);
+ res = Tcl_FSRegister(interp, &testReportingFilesystem);
msg = (res == TCL_OK) ? "registered" : "failed";
} else {
res = Tcl_FSUnregister(&testReportingFilesystem);
@@ -6221,7 +6266,7 @@ TestFilesystemObjCmd(
static int
TestReportInFilesystem(
Tcl_Obj *pathPtr,
- ClientData *clientDataPtr)
+ void **clientDataPtr)
{
static Tcl_Obj *lastPathPtr = NULL;
Tcl_Obj *newPathPtr;
@@ -6243,7 +6288,7 @@ TestReportInFilesystem(
return -1;
}
lastPathPtr = NULL;
- *clientDataPtr = (ClientData) newPathPtr;
+ *clientDataPtr = newPathPtr;
return TCL_OK;
}
@@ -6261,7 +6306,7 @@ TestReportGetNativePath(
static void
TestReportFreeInternalRep(
- ClientData clientData)
+ void *clientData)
{
Tcl_Obj *nativeRep = (Tcl_Obj *) clientData;
@@ -6273,7 +6318,7 @@ TestReportFreeInternalRep(
static ClientData
TestReportDupInternalRep(
- ClientData clientData)
+ void *clientData)
{
Tcl_Obj *original = (Tcl_Obj *) clientData;
@@ -6314,7 +6359,7 @@ TestReport(
savedResult = Tcl_GetObjResult(interp);
Tcl_IncrRefCount(savedResult);
Tcl_SetObjResult(interp, Tcl_NewObj());
- Tcl_Eval(interp, Tcl_DStringValue(&ds));
+ Tcl_EvalEx(interp, Tcl_DStringValue(&ds), -1, 0);
Tcl_DStringFree(&ds);
Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, savedResult);
@@ -6539,7 +6584,7 @@ TestReportNormalizePath(
static int
SimplePathInFilesystem(
Tcl_Obj *pathPtr,
- ClientData *clientDataPtr)
+ void **clientDataPtr)
{
const char *str = Tcl_GetString(pathPtr);
@@ -6568,7 +6613,7 @@ SimplePathInFilesystem(
static int
TestSimpleFilesystemObjCmd(
- ClientData dummy,
+ void *dummy,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6584,7 +6629,7 @@ TestSimpleFilesystemObjCmd(
return TCL_ERROR;
}
if (boolVal) {
- res = Tcl_FSRegister((ClientData)interp, &simpleFilesystem);
+ res = Tcl_FSRegister(interp, &simpleFilesystem);
msg = (res == TCL_OK) ? "registered" : "failed";
} else {
res = Tcl_FSUnregister(&simpleFilesystem);
@@ -6728,7 +6773,7 @@ SimpleListVolumes(void)
static int
TestNumUtfCharsCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6751,7 +6796,7 @@ TestNumUtfCharsCmd(
static int
TestFindFirstCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6773,7 +6818,7 @@ TestFindFirstCmd(
static int
TestFindLastCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6815,13 +6860,13 @@ TestFindLastCmd(
static int
TestcpuidCmd(
- ClientData dummy,
+ void *dummy,
Tcl_Interp* interp, /* Tcl interpreter */
int objc, /* Parameter count */
Tcl_Obj *const * objv) /* Parameter vector */
{
int status, index, i;
- unsigned int regs[4];
+ int regs[4];
Tcl_Obj *regsObjs[4];
if (objc != 2) {
@@ -6831,14 +6876,14 @@ TestcpuidCmd(
if (Tcl_GetIntFromObj(interp, objv[1], &index) != TCL_OK) {
return TCL_ERROR;
}
- status = TclWinCPUID((unsigned) index, regs);
+ status = TclWinCPUID(index, regs);
if (status != TCL_OK) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("operation not available", -1));
return status;
}
for (i=0 ; i<4 ; ++i) {
- regsObjs[i] = Tcl_NewIntObj((int) regs[i]);
+ regsObjs[i] = Tcl_NewIntObj(regs[i]);
}
Tcl_SetObjResult(interp, Tcl_NewListObj(4, regsObjs));
return TCL_OK;
@@ -6851,7 +6896,7 @@ TestcpuidCmd(
static int
TestHashSystemHashCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6927,13 +6972,13 @@ TestHashSystemHashCmd(
*/
static int
TestgetintCmd(
- ClientData dummy,
+ void *dummy,
Tcl_Interp *interp,
int argc,
const char **argv)
{
if (argc < 2) {
- Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
+ Tcl_AppendResult(interp, "wrong # args", NULL);
return TCL_ERROR;
} else {
int val, i, total=0;
@@ -6949,9 +6994,27 @@ TestgetintCmd(
}
}
+/*
+ * Used for determining sizeof(long) at script level.
+ */
+static int
+TestlongsizeCmd(
+ void *dummy,
+ Tcl_Interp *interp,
+ int argc,
+ const char **argv)
+{
+ if (argc != 1) {
+ Tcl_AppendResult(interp, "wrong # args", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
+ return TCL_OK;
+}
+
static int
NREUnwind_callback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -6978,7 +7041,7 @@ NREUnwind_callback(
static int
TestNREUnwind(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -6996,7 +7059,7 @@ TestNREUnwind(
static int
TestNRELevels(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -7052,7 +7115,7 @@ TestNRELevels(
static int
TestconcatobjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -7073,17 +7136,11 @@ TestconcatobjCmd(
list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
Tcl_ListObjLength(NULL, list1Ptr, &len);
- if (list1Ptr->bytes != NULL) {
- ckfree(list1Ptr->bytes);
- list1Ptr->bytes = NULL;
- }
+ Tcl_InvalidateStringRep(list1Ptr);
list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
Tcl_ListObjLength(NULL, list2Ptr, &len);
- if (list2Ptr->bytes != NULL) {
- ckfree(list2Ptr->bytes);
- list2Ptr->bytes = NULL;
- }
+ Tcl_InvalidateStringRep(list2Ptr);
/*
* Verify that concat'ing a list obj with one or more empty strings does
@@ -7355,7 +7412,7 @@ TestconcatobjCmd(
static int
TestparseargsCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Arguments. */
@@ -7457,7 +7514,7 @@ InterpCmdResolver(
*/
CallFrame *parentFramePtr = varFramePtr->callerPtr;
- char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";
+ const char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)";
if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) {
resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY);
@@ -7594,7 +7651,7 @@ InterpCompiledVarResolver(
static int
TestInterpResolverCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index f7d2bae..67b1997 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -622,23 +622,9 @@ TestindexobjCmd(
}
argv[objc-4] = NULL;
- /*
- * Tcl_GetIndexFromObj assumes that the table is statically-allocated so
- * that its address is different for each index object. If we accidently
- * allocate a table at the same address as that cached in the index
- * object, clear out the object's cached state.
- */
-
- if (objv[3]->typePtr != NULL
- && !strcmp("index", objv[3]->typePtr->name)) {
- indexRep = objv[3]->internalRep.twoPtrValue.ptr1;
- if (indexRep->tablePtr == (void *) argv) {
- TclFreeIntRep(objv[3]);
- }
- }
-
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
- argv, "token", (allowAbbrev? 0 : TCL_EXACT), &index);
+ argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
+ &index);
ckfree(argv);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), index);
@@ -737,9 +723,9 @@ TestintobjCmd(
}
intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], intValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "setmaxlong") == 0) {
@@ -748,9 +734,9 @@ TestintobjCmd(
goto wrongNumArgs;
}
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], maxLong);
+ Tcl_SetWideIntObj(varPtr[varIndex], maxLong);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxLong));
}
} else if (strcmp(subCmd, "ismaxlong") == 0) {
if (objc != 3) {
@@ -796,9 +782,9 @@ TestintobjCmd(
Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
#else
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
+ Tcl_SetWideIntObj(varPtr[varIndex], LONG_MAX);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(LONG_MAX));
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
Tcl_ResetResult(interp);
@@ -1102,6 +1088,9 @@ TestobjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
typeName = objv[2]->typePtr->name;
+#ifndef TCL_WIDE_INT_IS_LONG
+ if (!strcmp(typeName, "wideInt")) typeName = "int";
+#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
} else if (strcmp(subCmd, "refcount") == 0) {
@@ -1115,7 +1104,7 @@ TestobjCmd(
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(varPtr[varIndex]->refCount));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(varPtr[varIndex]->refCount));
} else if (strcmp(subCmd, "type") == 0) {
if (objc != 3) {
goto wrongNumArgs;
@@ -1129,6 +1118,11 @@ TestobjCmd(
}
if (varPtr[varIndex]->typePtr == NULL) { /* a string! */
Tcl_AppendToObj(Tcl_GetObjResult(interp), "string", -1);
+#ifndef TCL_WIDE_INT_IS_LONG
+ } else if (!strcmp(varPtr[varIndex]->typePtr->name, "wideInt")) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "int", -1);
+#endif
} else {
Tcl_AppendToObj(Tcl_GetObjResult(interp),
varPtr[varIndex]->typePtr->name, -1);
diff --git a/generic/tclThread.c b/generic/tclThread.c
index 198fa6a..cafd824 100644
--- a/generic/tclThread.c
+++ b/generic/tclThread.c
@@ -41,21 +41,6 @@ static void RememberSyncObject(void *objPtr,
SyncObjRecord *recPtr);
/*
- * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
- * specified. Here we undo that so the functions are defined in the stubs
- * table.
- */
-
-#ifndef TCL_THREADS
-#undef Tcl_MutexLock
-#undef Tcl_MutexUnlock
-#undef Tcl_MutexFinalize
-#undef Tcl_ConditionNotify
-#undef Tcl_ConditionWait
-#undef Tcl_ConditionFinalize
-#endif
-
-/*
*----------------------------------------------------------------------
*
* Tcl_GetThreadData --
@@ -79,7 +64,7 @@ Tcl_GetThreadData(
int size) /* Size of storage block */
{
void *result;
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Initialize the key for this thread.
*/
@@ -126,7 +111,7 @@ TclThreadDataKeyGet(
Tcl_ThreadDataKey *keyPtr) /* Identifier for the data chunk. */
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
return TclThreadStorageKeyGet(keyPtr);
#else /* TCL_THREADS */
return *keyPtr;
@@ -269,11 +254,12 @@ TclRememberMutex(
*----------------------------------------------------------------------
*/
+#undef Tcl_MutexFinalize
void
Tcl_MutexFinalize(
Tcl_Mutex *mutexPtr)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
TclpFinalizeMutex(mutexPtr);
#endif
TclpMasterLock();
@@ -322,11 +308,12 @@ TclRememberCondition(
*----------------------------------------------------------------------
*/
+#undef Tcl_ConditionFinalize
void
Tcl_ConditionFinalize(
Tcl_Condition *condPtr)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
TclpFinalizeCondition(condPtr);
#endif
TclpMasterLock();
@@ -356,7 +343,7 @@ void
TclFinalizeThreadData(int quick)
{
TclFinalizeThreadDataThread();
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
if (!quick) {
/*
* Quick exit principle makes it useless to terminate allocators
@@ -389,7 +376,7 @@ TclFinalizeSynchronization(void)
int i;
void *blockPtr;
Tcl_ThreadDataKey *keyPtr;
-#ifdef TCL_THREADS
+#if TCL_THREADS
Tcl_Mutex *mutexPtr;
Tcl_Condition *condPtr;
@@ -413,7 +400,7 @@ TclFinalizeSynchronization(void)
keyRecord.max = 0;
keyRecord.num = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Call thread storage master cleanup.
*/
@@ -473,12 +460,10 @@ Tcl_ExitThread(
int status)
{
Tcl_FinalizeThread();
-#ifdef TCL_THREADS
TclpThreadExit(status);
-#endif
}
-#ifndef TCL_THREADS
+#if !TCL_THREADS
/*
*----------------------------------------------------------------------
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index 2ee758e..3f1abc2 100644
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -13,7 +13,7 @@
*/
#include "tclInt.h"
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+#if TCL_THREADS && defined(USE_THREAD_ALLOC)
/*
* If range checking is enabled, an additional byte will be allocated to store
@@ -196,20 +196,11 @@ GetCache(void)
if (listLockPtr == NULL) {
Tcl_Mutex *initLockPtr;
- unsigned int i;
initLockPtr = Tcl_GetAllocMutex();
Tcl_MutexLock(initLockPtr);
if (listLockPtr == NULL) {
- listLockPtr = TclpNewAllocMutex();
- objLockPtr = TclpNewAllocMutex();
- for (i = 0; i < NBUCKETS; ++i) {
- bucketInfo[i].blockSize = MINALLOC << i;
- bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
- bucketInfo[i].numMove = i < NBUCKETS - 1 ?
- 1 << (NBUCKETS - 2 - i) : 1;
- bucketInfo[i].lockPtr = TclpNewAllocMutex();
- }
+ TclInitThreadAlloc();
}
Tcl_MutexUnlock(initLockPtr);
}
@@ -1064,6 +1055,40 @@ GetBlocks(
}
return 1;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitThreadAlloc --
+ *
+ * Initializes the allocator cache-maintenance structures.
+ * It is done early and protected during the TclInitSubsystems().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitThreadAlloc(void)
+{
+ unsigned int i;
+
+ listLockPtr = TclpNewAllocMutex();
+ objLockPtr = TclpNewAllocMutex();
+ for (i = 0; i < NBUCKETS; ++i) {
+ bucketInfo[i].blockSize = MINALLOC << i;
+ bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
+ bucketInfo[i].numMove = i < NBUCKETS - 1 ?
+ 1 << (NBUCKETS - 2 - i) : 1;
+ bucketInfo[i].lockPtr = TclpNewAllocMutex();
+ }
+ TclpInitAllocCache();
+}
/*
*----------------------------------------------------------------------
diff --git a/generic/tclThreadStorage.c b/generic/tclThreadStorage.c
index 755a461..b56ec80 100644
--- a/generic/tclThreadStorage.c
+++ b/generic/tclThreadStorage.c
@@ -13,7 +13,7 @@
#include "tclInt.h"
-#ifdef TCL_THREADS
+#if TCL_THREADS
#include <signal.h>
/*
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 35b3fc3..e9b1107 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -18,7 +18,7 @@
#endif
#include "tclInt.h"
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Each thread has an single instance of the following structure. There is one
* instance of this structure per thread even if that thread contains multiple
@@ -508,7 +508,7 @@ ThreadCreate(
joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;
Tcl_MutexLock(&threadMutex);
- if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl,
+ if (Tcl_CreateThread(&id, NewTestThread, &ctrl,
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "can't create a new thread", NULL);
@@ -654,9 +654,9 @@ ThreadErrorProc(
char *script;
char buf[TCL_DOUBLE_SPACE+1];
- sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread());
+ sprintf(buf, "%p", Tcl_GetCurrentThread());
- errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+ errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
if (errorProcString == NULL) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_WriteChars(errChannel, "Error from thread ", -1);
@@ -1031,8 +1031,8 @@ ThreadEventProc(
code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL);
Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
if (code != TCL_OK) {
- errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
- errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+ errorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
+ errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
} else {
errorCode = errorInfo = NULL;
}
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index c10986a..ccfd179 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -91,7 +91,7 @@ typedef struct IdleHandler {
* The structure defined below is used in this file only.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
TimerHandler *firstTimerHandlerPtr; /* First event in queue. */
int lastTimerId; /* Timer identifier of most recently created
* timer. */
@@ -789,7 +789,7 @@ Tcl_AfterObjCmd(
AfterInfo *afterPtr;
AfterAssocData *assocPtr;
int length;
- int index;
+ int index = -1;
static const char *const afterSubCmds[] = {
"cancel", "idle", "info", NULL
};
@@ -818,15 +818,9 @@ Tcl_AfterObjCmd(
* First lets see if the command was passed a number as the first argument.
*/
- if (objv[1]->typePtr == &tclIntType
-#ifndef TCL_WIDE_INT_IS_LONG
- || objv[1]->typePtr == &tclWideIntType
-#endif
- || objv[1]->typePtr == &tclBignumType
- || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
- &index) != TCL_OK)) {
- index = -1;
- if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
+ != TCL_OK) {
const char *arg = Tcl_GetString(objv[1]);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -900,10 +894,10 @@ Tcl_AfterObjCmd(
} else {
commandPtr = Tcl_ConcatObj(objc-2, objv+2);;
}
- command = Tcl_GetStringFromObj(commandPtr, &length);
+ command = TclGetStringFromObj(commandPtr, &length);
for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL;
afterPtr = afterPtr->nextPtr) {
- tempCommand = Tcl_GetStringFromObj(afterPtr->commandPtr,
+ tempCommand = TclGetStringFromObj(afterPtr->commandPtr,
&tempLength);
if ((length == tempLength)
&& !memcmp(command, tempCommand, (unsigned) length)) {
@@ -1045,31 +1039,27 @@ AfterDelay(
if (iPtr->limit.timeEvent == NULL
|| TCL_TIME_BEFORE(endTime, iPtr->limit.time)) {
diff = TCL_TIME_DIFF_MS_CEILING(endTime, now);
-#ifndef TCL_WIDE_INT_IS_LONG
- if (diff > LONG_MAX) {
- diff = LONG_MAX;
- }
-#endif
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
- if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) diff = 1;
+ if (diff == 0 && TCL_TIME_BEFORE(now, endTime)) {
+ diff = 1;
+ }
if (diff > 0) {
- Tcl_Sleep((long) diff);
- if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) break;
- } else break;
+ Tcl_Sleep((int) diff);
+ if (diff < SLEEP_OFFLOAD_GETTIMEOFDAY) {
+ break;
+ }
+ } else {
+ break;
+ }
} else {
diff = TCL_TIME_DIFF_MS(iPtr->limit.time, now);
-#ifndef TCL_WIDE_INT_IS_LONG
- if (diff > LONG_MAX) {
- diff = LONG_MAX;
- }
-#endif
if (diff > TCL_TIME_MAXIMUM_SLICE) {
diff = TCL_TIME_MAXIMUM_SLICE;
}
if (diff > 0) {
- Tcl_Sleep((long) diff);
+ Tcl_Sleep((int) diff);
}
if (Tcl_AsyncReady()) {
if (Tcl_AsyncInvoke(interp, TCL_OK) != TCL_OK) {
@@ -1083,7 +1073,7 @@ AfterDelay(
return TCL_ERROR;
}
}
- Tcl_GetTime(&now);
+ Tcl_GetTime(&now);
} while (TCL_TIME_BEFORE(now, endTime));
return TCL_OK;
}
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
index 065fe09..a6c3d5b 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -223,13 +223,13 @@ declare 63 {
# Formerly internal API to allow initialisation of bignums without knowing the
# typedefs of how a bignum works internally.
-declare 64 {
+declare 64 {deprecated {Use mp_init() + mp_set_long_long()}} {
void TclBNInitBignumFromLong(mp_int *bignum, long initVal)
}
-declare 65 {
+declare 65 {deprecated {Use mp_init() + mp_set_long_long()}} {
void TclBNInitBignumFromWideInt(mp_int *bignum, Tcl_WideInt initVal)
}
-declare 66 {
+declare 66 {deprecated {Use mp_init() + mp_set_long_long()}} {
void TclBNInitBignumFromWideUInt(mp_int *bignum, Tcl_WideUInt initVal)
}
@@ -237,6 +237,37 @@ declare 66 {
declare 67 {
int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast)
}
+# Added in libtommath 1.0.1
+declare 68 {
+ int TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i)
+}
+declare 69 {
+ Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a)
+}
+declare 70 {
+ int TclBN_mp_set_long(mp_int *a, unsigned long i)
+}
+declare 71 {
+ unsigned long TclBN_mp_get_long(const mp_int *a)
+}
+declare 72 {
+ unsigned long TclBN_mp_get_int(const mp_int *a)
+}
+
+# Added in libtommath 1.1.0
+declare 73 {
+ int TclBN_mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c)
+}
+declare 74 {
+ int TclBN_mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c)
+}
+declare 75 {
+ int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c)
+}
+declare 76 {
+ int TclBN_mp_tc_div_2d(const mp_int *a, int b, mp_int *c)
+}
+
# Local Variables:
# mode: tcl
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index 81cd7c9..1e402fd 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -74,6 +74,9 @@
#define mp_exch TclBN_mp_exch
#define mp_expt_d TclBN_mp_expt_d
#define mp_expt_d_ex TclBN_mp_expt_d_ex
+#define mp_get_int TclBN_mp_get_int
+#define mp_get_long TclBN_mp_get_long
+#define mp_get_long_long TclBN_mp_get_long_long
#define mp_grow TclBN_mp_grow
#define mp_init TclBN_mp_init
#define mp_init_copy TclBN_mp_init_copy
@@ -97,11 +100,17 @@
#define mp_rshd TclBN_mp_rshd
#define mp_set TclBN_mp_set
#define mp_set_int TclBN_mp_set_int
+#define mp_set_long TclBN_mp_set_long
+#define mp_set_long_long TclBN_mp_set_long_long
#define mp_shrink TclBN_mp_shrink
#define mp_sqr TclBN_mp_sqr
#define mp_sqrt TclBN_mp_sqrt
#define mp_sub TclBN_mp_sub
#define mp_sub_d TclBN_mp_sub_d
+#define mp_tc_and TclBN_mp_tc_and
+#define mp_tc_div_2d TclBN_mp_tc_div_2d
+#define mp_tc_or TclBN_mp_tc_or
+#define mp_tc_xor TclBN_mp_tc_xor
#define mp_to_unsigned_bin TclBN_mp_to_unsigned_bin
#define mp_to_unsigned_bin_n TclBN_mp_to_unsigned_bin_n
#define mp_toom_mul TclBN_mp_toom_mul
@@ -297,16 +306,40 @@ EXTERN int TclBN_mp_set_int(mp_int *a, unsigned long i);
/* 63 */
EXTERN int TclBN_mp_cnt_lsb(const mp_int *a);
/* 64 */
-EXTERN void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
+TCL_DEPRECATED("Use mp_init() + mp_set_long_long()")
+void TclBNInitBignumFromLong(mp_int *bignum, long initVal);
/* 65 */
-EXTERN void TclBNInitBignumFromWideInt(mp_int *bignum,
+TCL_DEPRECATED("Use mp_init() + mp_set_long_long()")
+void TclBNInitBignumFromWideInt(mp_int *bignum,
Tcl_WideInt initVal);
/* 66 */
-EXTERN void TclBNInitBignumFromWideUInt(mp_int *bignum,
+TCL_DEPRECATED("Use mp_init() + mp_set_long_long()")
+void TclBNInitBignumFromWideUInt(mp_int *bignum,
Tcl_WideUInt initVal);
/* 67 */
EXTERN int TclBN_mp_expt_d_ex(const mp_int *a, mp_digit b,
mp_int *c, int fast);
+/* 68 */
+EXTERN int TclBN_mp_set_long_long(mp_int *a, Tcl_WideUInt i);
+/* 69 */
+EXTERN Tcl_WideUInt TclBN_mp_get_long_long(const mp_int *a);
+/* 70 */
+EXTERN int TclBN_mp_set_long(mp_int *a, unsigned long i);
+/* 71 */
+EXTERN unsigned long TclBN_mp_get_long(const mp_int *a);
+/* 72 */
+EXTERN unsigned long TclBN_mp_get_int(const mp_int *a);
+/* 73 */
+EXTERN int TclBN_mp_tc_and(const mp_int *a, const mp_int *b,
+ mp_int *c);
+/* 74 */
+EXTERN int TclBN_mp_tc_or(const mp_int *a, const mp_int *b,
+ mp_int *c);
+/* 75 */
+EXTERN int TclBN_mp_tc_xor(const mp_int *a, const mp_int *b,
+ mp_int *c);
+/* 76 */
+EXTERN int TclBN_mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
typedef struct TclTomMathStubs {
int magic;
@@ -376,10 +409,19 @@ typedef struct TclTomMathStubs {
int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
- void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
- void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
- void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
+ TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromLong) (mp_int *bignum, long initVal); /* 64 */
+ TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideInt) (mp_int *bignum, Tcl_WideInt initVal); /* 65 */
+ TCL_DEPRECATED_API("Use mp_init() + mp_set_long_long()") void (*tclBNInitBignumFromWideUInt) (mp_int *bignum, Tcl_WideUInt initVal); /* 66 */
int (*tclBN_mp_expt_d_ex) (const mp_int *a, mp_digit b, mp_int *c, int fast); /* 67 */
+ int (*tclBN_mp_set_long_long) (mp_int *a, Tcl_WideUInt i); /* 68 */
+ Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */
+ int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */
+ unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */
+ unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */
+ int (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */
+ int (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */
+ int (*tclBN_mp_tc_xor) (const mp_int *a, const mp_int *b, mp_int *c); /* 75 */
+ int (*tclBN_mp_tc_div_2d) (const mp_int *a, int b, mp_int *c); /* 76 */
} TclTomMathStubs;
extern const TclTomMathStubs *tclTomMathStubsPtr;
@@ -530,6 +572,24 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
(tclTomMathStubsPtr->tclBNInitBignumFromWideUInt) /* 66 */
#define TclBN_mp_expt_d_ex \
(tclTomMathStubsPtr->tclBN_mp_expt_d_ex) /* 67 */
+#define TclBN_mp_set_long_long \
+ (tclTomMathStubsPtr->tclBN_mp_set_long_long) /* 68 */
+#define TclBN_mp_get_long_long \
+ (tclTomMathStubsPtr->tclBN_mp_get_long_long) /* 69 */
+#define TclBN_mp_set_long \
+ (tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */
+#define TclBN_mp_get_long \
+ (tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */
+#define TclBN_mp_get_int \
+ (tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */
+#define TclBN_mp_tc_and \
+ (tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */
+#define TclBN_mp_tc_or \
+ (tclTomMathStubsPtr->tclBN_mp_tc_or) /* 74 */
+#define TclBN_mp_tc_xor \
+ (tclTomMathStubsPtr->tclBN_mp_tc_xor) /* 75 */
+#define TclBN_mp_tc_div_2d \
+ (tclTomMathStubsPtr->tclBN_mp_tc_div_2d) /* 76 */
#endif /* defined(USE_TCL_STUBS) */
diff --git a/generic/tclTomMathInterface.c b/generic/tclTomMathInterface.c
index 48db8c3..9e7bf4b 100644
--- a/generic/tclTomMathInterface.c
+++ b/generic/tclTomMathInterface.c
@@ -89,86 +89,11 @@ TclBN_revision(void)
{
return TCLTOMMATH_REVISION;
}
-#if 0
/*
*----------------------------------------------------------------------
*
- * TclBNAlloc --
- *
- * Allocate memory for libtommath.
- *
- * Results:
- * Returns a pointer to the allocated block.
- *
- * This procedure is a wrapper around Tcl_Alloc, needed because of a
- * mismatched type signature between Tcl_Alloc and malloc.
- *
- *----------------------------------------------------------------------
- */
-
-extern void *
-TclBNAlloc(
- size_t x)
-{
- return (void *) ckalloc((unsigned int) x);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclBNRealloc --
- *
- * Change the size of an allocated block of memory in libtommath
- *
- * Results:
- * Returns a pointer to the allocated block.
- *
- * This procedure is a wrapper around Tcl_Realloc, needed because of a
- * mismatched type signature between Tcl_Realloc and realloc.
- *
- *----------------------------------------------------------------------
- */
-
-void *
-TclBNRealloc(
- void *p,
- size_t s)
-{
- return (void *) ckrealloc((char *) p, (unsigned int) s);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclBNFree --
- *
- * Free allocated memory in libtommath.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Memory is freed.
- *
- * This function is simply a wrapper around Tcl_Free, needed in libtommath
- * because of a type mismatch between free and Tcl_Free.
- *
- *----------------------------------------------------------------------
- */
-
-extern void
-TclBNFree(
- void *p)
-{
- ckree((char *) p);
-}
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * TclBNInitBignumFromLong --
+ * TclInitBignumFromLong --
*
* Allocate and initialize a 'bignum' from a native 'long'.
*
@@ -181,47 +106,20 @@ TclBNFree(
*----------------------------------------------------------------------
*/
-extern void
-TclBNInitBignumFromLong(
+void
+TclInitBignumFromLong(
mp_int *a,
- long initVal)
+ long v)
{
- int status;
- unsigned long v;
- mp_digit *p;
-
- /*
- * Allocate enough memory to hold the largest possible long
- */
-
- status = mp_init_size(a,
- (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT);
- if (status != MP_OKAY) {
- Tcl_Panic("initialization failure in TclBNInitBignumFromLong");
+ if (mp_init_size(a, (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclInitBignumFromLong");
}
-
- /*
- * Convert arg to sign and magnitude.
- */
-
- if (initVal < 0) {
- a->sign = MP_NEG;
- v = -initVal;
+ if (v < (long)0) {
+ mp_set_long_long(a, (Tcl_WideUInt)(-(Tcl_WideInt)v));
+ mp_neg(a, a);
} else {
- a->sign = MP_ZPOS;
- v = initVal;
- }
-
- /*
- * Store the magnitude in the bignum.
- */
-
- p = a->dp;
- while (v) {
- *p++ = (mp_digit) (v & MP_MASK);
- v >>= MP_DIGIT_BIT;
+ mp_set_long_long(a, (Tcl_WideUInt)v);
}
- a->used = p - a->dp;
}
/*
@@ -240,16 +138,19 @@ TclBNInitBignumFromLong(
*----------------------------------------------------------------------
*/
-extern void
-TclBNInitBignumFromWideInt(
+void
+TclInitBignumFromWideInt(
mp_int *a, /* Bignum to initialize */
Tcl_WideInt v) /* Initial value */
{
+ if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclInitBignumFromWideInt");
+ }
if (v < (Tcl_WideInt)0) {
- TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)(-v));
+ mp_set_long_long(a, (Tcl_WideUInt)(-v));
mp_neg(a, a);
} else {
- TclBNInitBignumFromWideUInt(a, (Tcl_WideUInt)v);
+ mp_set_long_long(a, (Tcl_WideUInt)v);
}
}
@@ -269,36 +170,15 @@ TclBNInitBignumFromWideInt(
*----------------------------------------------------------------------
*/
-extern void
-TclBNInitBignumFromWideUInt(
+void
+TclInitBignumFromWideUInt(
mp_int *a, /* Bignum to initialize */
Tcl_WideUInt v) /* Initial value */
{
- int status;
- mp_digit *p;
-
- /*
- * Allocate enough memory to hold the largest possible Tcl_WideUInt.
- */
-
- status = mp_init_size(a,
- (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT);
- if (status != MP_OKAY) {
- Tcl_Panic("initialization failure in TclBNInitBignumFromWideUInt");
- }
-
- a->sign = MP_ZPOS;
-
- /*
- * Store the magnitude in the bignum.
- */
-
- p = a->dp;
- while (v) {
- *p++ = (mp_digit) (v & MP_MASK);
- v >>= MP_DIGIT_BIT;
- }
- a->used = p - a->dp;
+ if (mp_init_size(a, (CHAR_BIT * sizeof(Tcl_WideUInt) + DIGIT_BIT - 1) / DIGIT_BIT) != MP_OKAY) {
+ Tcl_Panic("initialization failure in TclInitBignumFromWideUInt");
+ }
+ mp_set_long_long(a, v);
}
/*
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 882dc39..db48f7a 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.c
@@ -52,7 +52,7 @@ typedef struct {
* invoked step trace */
int curFlags; /* Trace flags for the current command */
int curCode; /* Return code for the current command */
- int refCount; /* Used to ensure this structure is not
+ size_t refCount; /* Used to ensure this structure is not
* deleted too early. Keeps track of how many
* pieces of code have a pointer to this
* structure. */
@@ -143,7 +143,7 @@ static int TraceVarEx(Tcl_Interp *interp, const char *part1,
* trace procs
*/
-typedef struct StringTraceData {
+typedef struct {
ClientData clientData; /* Client data from Tcl_CreateTrace */
Tcl_CmdTraceProc *proc; /* Trace function from Tcl_CreateTrace */
} StringTraceData;
@@ -280,7 +280,7 @@ Tcl_TraceObjCmd(
opsList = Tcl_NewObj();
Tcl_IncrRefCount(opsList);
- flagOps = Tcl_GetStringFromObj(objv[3], &numFlags);
+ flagOps = TclGetStringFromObj(objv[3], &numFlags);
if (numFlags == 0) {
Tcl_DecrRefCount(opsList);
goto badVarOps;
@@ -466,7 +466,7 @@ TraceExecutionObjCmd(
break;
}
}
- command = Tcl_GetStringFromObj(objv[5], &commandLength);
+ command = TclGetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
TraceCommandInfo *tcmdPtr = ckalloc(
@@ -703,7 +703,7 @@ TraceCommandObjCmd(
}
}
- command = Tcl_GetStringFromObj(objv[5], &commandLength);
+ command = TclGetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
TraceCommandInfo *tcmdPtr = ckalloc(
@@ -906,7 +906,7 @@ TraceVariableObjCmd(
break;
}
}
- command = Tcl_GetStringFromObj(objv[5], &commandLength);
+ command = TclGetStringFromObj(objv[5], &commandLength);
length = (size_t) commandLength;
if ((enum traceOptions) optionIndex == TRACE_ADD) {
CombinedTraceVarInfo *ctvarPtr = ckalloc(
@@ -2862,6 +2862,7 @@ DisposeTraceResult(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_UntraceVar
void
Tcl_UntraceVar(
@@ -2877,6 +2878,7 @@ Tcl_UntraceVar(
{
Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -3031,6 +3033,7 @@ Tcl_UntraceVar2(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_VarTraceInfo
ClientData
Tcl_VarTraceInfo(
@@ -3048,6 +3051,7 @@ Tcl_VarTraceInfo(
return Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc,
prevClientData);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -3140,6 +3144,7 @@ Tcl_VarTraceInfo2(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_TraceVar
int
Tcl_TraceVar(
@@ -3157,6 +3162,7 @@ Tcl_TraceVar(
{
return Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index b33bf5f..10e78bd 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -68,24 +68,14 @@ 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,
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
-#if TCL_UTF_MAX > 3
4,4,4,4,4,4,4,4,
-#else
- 1,1,1,1,1,1,1,1,
-#endif
1,1,1,1,1,1,1,1
};
-
-/*
- * Functions used only in this module.
- */
-
-static int UtfCount(int ch);
/*
*---------------------------------------------------------------------------
*
- * UtfCount --
+ * TclUtfCount --
*
* Find the number of bytes in the Utf character "ch".
*
@@ -98,8 +88,8 @@ static int UtfCount(int ch);
*---------------------------------------------------------------------------
*/
-static inline int
-UtfCount(
+int
+TclUtfCount(
int ch) /* The Unicode character whose size is returned. */
{
if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
@@ -108,11 +98,9 @@ UtfCount(
if (ch <= 0x7FF) {
return 2;
}
-#if TCL_UTF_MAX > 3
if (((unsigned)(ch - 0x10000) <= 0xFFFFF)) {
return 4;
}
-#endif
return 3;
}
@@ -141,7 +129,7 @@ Tcl_UniCharToUtf(
char *buf) /* Buffer in which the UTF-8 representation of
* the Tcl_UniChar is stored. Buffer must be
* large enough to hold the UTF-8 character
- * (at most TCL_UTF_MAX bytes). */
+ * (at most 4 bytes). */
{
if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) {
buf[0] = (char) ch;
@@ -154,7 +142,6 @@ Tcl_UniCharToUtf(
return 2;
}
if (ch <= 0xFFFF) {
-#if TCL_UTF_MAX > 3
if ((ch & 0xF800) == 0xD800) {
if (ch & 0x0400) {
/* Low surrogate */
@@ -177,11 +164,8 @@ Tcl_UniCharToUtf(
return 0;
}
}
-#endif
goto three;
}
-
-#if TCL_UTF_MAX > 3
if (ch <= 0x10FFFF) {
buf[3] = (char) ((ch | 0x80) & 0xBF);
buf[2] = (char) (((ch >> 6) | 0x80) & 0xBF);
@@ -196,7 +180,6 @@ Tcl_UniCharToUtf(
+ ((buf[2] & 0x30) >> 4);
goto three;
}
-#endif
}
ch = 0xFFFD;
@@ -235,23 +218,31 @@ Tcl_UniCharToUtfDString(
{
const Tcl_UniChar *w, *wEnd;
char *p, *string;
- int oldLength;
+ int oldLength, len = 1;
/*
- * UTF-8 string length in bytes will be <= Unicode string length *
- * TCL_UTF_MAX.
+ * UTF-8 string length in bytes will be <= Unicode string length * 4.
*/
oldLength = Tcl_DStringLength(dsPtr);
- Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * TCL_UTF_MAX);
+ Tcl_DStringSetLength(dsPtr, oldLength + (uniLength + 1) * 4);
string = Tcl_DStringValue(dsPtr) + oldLength;
p = string;
wEnd = uniStr + uniLength;
for (w = uniStr; w < wEnd; ) {
- p += Tcl_UniCharToUtf(*w, p);
+ if (!len && ((*w & 0xFC00) != 0xDC00)) {
+ /* Special case for handling high surrogates. */
+ p += Tcl_UniCharToUtf(-1, p);
+ }
+ len = Tcl_UniCharToUtf(*w, p);
+ p += len;
w++;
}
+ if (!len) {
+ /* Special case for handling high surrogates. */
+ p += Tcl_UniCharToUtf(-1, p);
+ }
Tcl_DStringSetLength(dsPtr, oldLength + (p - string));
return string;
@@ -292,6 +283,13 @@ Tcl_UniCharToUtfDString(
*---------------------------------------------------------------------------
*/
+static const unsigned short cp1252[32] = {
+ 0x20ac, 0x81, 0x201A, 0x0192, 0x201E, 0x2026, 0x2020, 0x2021,
+ 0x02C6, 0x2030, 0x0160, 0x2039, 0x0152, 0x8D, 0x017D, 0x8F,
+ 0x90, 0x2018, 0x2019, 0x201C, 0x201D, 0x2022, 0x2013, 0x2014,
+ 0x2DC, 0x2122, 0x0161, 0x203A, 0x0153, 0x9D, 0x017E, 0x0178
+};
+
int
Tcl_UtfToUniChar(
register const char *src, /* The UTF-8 string. */
@@ -308,11 +306,17 @@ Tcl_UtfToUniChar(
if (byte < 0xC0) {
/*
* Handles properly formed UTF-8 characters between 0x01 and 0x7F.
- * Also treats \0 and naked trail bytes 0x80 to 0xBF as valid
+ * Treats naked trail bytes 0x80 to 0x9F as valid characters from
+ * the cp1252 table. See: <https://en.wikipedia.org/wiki/UTF-8>
+ * Also treats \0 and other naked trail bytes 0xA0 to 0xBF as valid
* characters representing themselves.
*/
- *chPtr = (Tcl_UniChar) byte;
+ if ((unsigned)(byte-0x80) < (unsigned) 0x20) {
+ *chPtr = (Tcl_UniChar) cp1252[byte-0x80];
+ } else {
+ *chPtr = (Tcl_UniChar) byte;
+ }
return 1;
} else if (byte < 0xE0) {
if ((src[1] & 0xC0) == 0x80) {
@@ -348,13 +352,12 @@ Tcl_UtfToUniChar(
* represents itself.
*/
}
-#if TCL_UTF_MAX > 3
else if (byte < 0xF8) {
if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) {
/*
* Four-byte-character lead byte followed by three trail bytes.
*/
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
Tcl_UniChar surrogate;
byte = (((byte & 0x07) << 18) | ((src[1] & 0x3F) << 12)
@@ -385,7 +388,6 @@ Tcl_UtfToUniChar(
* represents itself.
*/
}
-#endif
*chPtr = (Tcl_UniChar) byte;
return 1;
@@ -439,15 +441,17 @@ Tcl_UtfToUniCharDString(
w = wString;
p = src;
- end = src + length - TCL_UTF_MAX;
+ end = src + length - 4;
while (p < end) {
p += TclUtfToUniChar(p, &ch);
*w++ = ch;
}
- end += TCL_UTF_MAX;
+ end += 4;
while (p < end) {
if (Tcl_UtfCharComplete(p, end-p)) {
p += TclUtfToUniChar(p, &ch);
+ } else if ((unsigned)((UCHAR(*p)-0x80)) < (unsigned) 0x20) {
+ ch = (Tcl_UniChar) cp1252[UCHAR(*p++)-0x80];
} else {
ch = UCHAR(*p++);
}
@@ -455,7 +459,7 @@ Tcl_UtfToUniCharDString(
}
*w = '\0';
Tcl_DStringSetLength(dsPtr,
- (oldLength + ((char *) w - (char *) wString)));
+ oldLength + ((char *) w - (char *) wString));
return wString;
}
@@ -529,13 +533,13 @@ Tcl_NumUtfChars(
}
if (i < 0) i = INT_MAX; /* Bug [2738427] */
} else {
- register const char *endPtr = src + length - TCL_UTF_MAX;
+ register const char *endPtr = src + length - 4;
while (src < endPtr) {
src += TclUtfToUniChar(src, &ch);
i++;
}
- endPtr += TCL_UTF_MAX;
+ endPtr += 4;
while ((src < endPtr) && Tcl_UtfCharComplete(src, endPtr - src)) {
src += TclUtfToUniChar(src, &ch);
i++;
@@ -577,7 +581,7 @@ Tcl_UtfFindFirst(
while (1) {
len = TclUtfToUniChar(src, &find);
fullchar = find;
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!len) {
len += TclUtfToUniChar(src, &find);
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
@@ -625,7 +629,7 @@ Tcl_UtfFindLast(
while (1) {
len = TclUtfToUniChar(src, &find);
fullchar = find;
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!len) {
len += TclUtfToUniChar(src, &find);
fullchar = (((fullchar & 0x3ff) << 10) | (find & 0x3ff)) + 0x10000;
@@ -668,7 +672,7 @@ Tcl_UtfNext(
Tcl_UniChar ch = 0;
int len = TclUtfToUniChar(src, &ch);
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (len == 0) {
len = TclUtfToUniChar(src, &ch);
}
@@ -707,7 +711,7 @@ Tcl_UtfPrev(
int i, byte;
look = --src;
- for (i = 0; i < TCL_UTF_MAX; i++) {
+ for (i = 0; i < 4; i++) {
if (look < start) {
if (src < start) {
src = start;
@@ -743,17 +747,33 @@ Tcl_UtfPrev(
*---------------------------------------------------------------------------
*/
-Tcl_UniChar
+int
Tcl_UniCharAtIndex(
register const char *src, /* The UTF-8 string to dereference. */
register int index) /* The position of the desired character. */
{
Tcl_UniChar ch = 0;
+ int fullchar = 0;
+#if TCL_UTF_MAX <= 4
+ int len = 1;
+#endif
while (index-- >= 0) {
+#if TCL_UTF_MAX <= 4
+ src += (len = TclUtfToUniChar(src, &ch));
+#else
src += TclUtfToUniChar(src, &ch);
+#endif
}
- return ch;
+ fullchar = ch;
+#if TCL_UTF_MAX <= 4
+ if (!len) {
+ /* If last Tcl_UniChar was a high surrogate, combine with low surrogate */
+ (void)TclUtfToUniChar(src, &ch);
+ fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+ }
+#endif
+ return fullchar;
}
/*
@@ -762,7 +782,9 @@ Tcl_UniCharAtIndex(
* Tcl_UtfAtIndex --
*
* Returns a pointer to the specified character (not byte) position in
- * the UTF-8 string.
+ * the UTF-8 string. If TCL_UTF_MAX <= 4, characters > U+FFFF count as
+ * 2 positions, but then the pointer should never be placed between
+ * the two positions.
*
* Results:
* As above.
@@ -785,7 +807,7 @@ Tcl_UtfAtIndex(
len = TclUtfToUniChar(src, &ch);
src += len;
}
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
if (!len) {
/* Index points at character following High Surrogate */
src += TclUtfToUniChar(src, &ch);
@@ -869,7 +891,8 @@ int
Tcl_UtfToUpper(
char *str) /* String to convert in place. */
{
- Tcl_UniChar ch = 0, upChar;
+ Tcl_UniChar ch = 0;
+ int upChar;
char *src, *dst;
int bytes;
@@ -880,7 +903,16 @@ Tcl_UtfToUpper(
src = dst = str;
while (*src) {
bytes = TclUtfToUniChar(src, &ch);
- upChar = Tcl_UniCharToUpper(ch);
+ upChar = ch;
+#if TCL_UTF_MAX <= 4
+ if (!bytes) {
+ /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
+ bytes = TclUtfToUniChar(src, &ch);
+ /* Combine surrogates */
+ upChar = (((upChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+ }
+#endif
+ upChar = Tcl_UniCharToUpper(upChar);
/*
* To keep badly formed Utf strings from getting inflated by the
@@ -888,7 +920,7 @@ Tcl_UtfToUpper(
* char to dst if its size is <= the original char.
*/
- if (bytes < UtfCount(upChar)) {
+ if ((bytes < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -922,7 +954,8 @@ int
Tcl_UtfToLower(
char *str) /* String to convert in place. */
{
- Tcl_UniChar ch = 0, lowChar;
+ Tcl_UniChar ch = 0;
+ int lowChar;
char *src, *dst;
int bytes;
@@ -933,7 +966,16 @@ Tcl_UtfToLower(
src = dst = str;
while (*src) {
bytes = TclUtfToUniChar(src, &ch);
- lowChar = Tcl_UniCharToLower(ch);
+ lowChar = ch;
+#if TCL_UTF_MAX <= 4
+ if (!bytes) {
+ /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
+ bytes = TclUtfToUniChar(src, &ch);
+ /* Combine surrogates */
+ lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+ }
+#endif
+ lowChar = Tcl_UniCharToLower(lowChar);
/*
* To keep badly formed Utf strings from getting inflated by the
@@ -941,7 +983,7 @@ Tcl_UtfToLower(
* char to dst if its size is <= the original char.
*/
- if (bytes < UtfCount(lowChar)) {
+ if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -976,7 +1018,8 @@ int
Tcl_UtfToTitle(
char *str) /* String to convert in place. */
{
- Tcl_UniChar ch = 0, titleChar, lowChar;
+ Tcl_UniChar ch = 0;
+ int titleChar, lowChar;
char *src, *dst;
int bytes;
@@ -989,9 +1032,18 @@ Tcl_UtfToTitle(
if (*src) {
bytes = TclUtfToUniChar(src, &ch);
- titleChar = Tcl_UniCharToTitle(ch);
+ titleChar = ch;
+#if TCL_UTF_MAX <= 4
+ if (!bytes) {
+ /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
+ bytes = TclUtfToUniChar(src, &ch);
+ /* Combine surrogates */
+ titleChar = (((titleChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+ }
+#endif
+ titleChar = Tcl_UniCharToTitle(titleChar);
- if (bytes < UtfCount(titleChar)) {
+ if ((bytes < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -1002,12 +1054,20 @@ Tcl_UtfToTitle(
while (*src) {
bytes = TclUtfToUniChar(src, &ch);
lowChar = ch;
+#if TCL_UTF_MAX <= 4
+ if (!bytes) {
+ /* TclUtfToUniChar only returns 0 for chars > 0xffff ! */
+ bytes = TclUtfToUniChar(src, &ch);
+ /* Combine surrogates */
+ lowChar = (((lowChar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
+ }
+#endif
/* Special exception for Georgian Asomtavruli chars, no titlecase. */
if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
lowChar = Tcl_UniCharToLower(lowChar);
}
- if (bytes < UtfCount(lowChar)) {
+ if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -1107,7 +1167,7 @@ Tcl_UtfNcmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
@@ -1158,7 +1218,7 @@ Tcl_UtfNcasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
@@ -1177,6 +1237,52 @@ Tcl_UtfNcasecmp(
}
return 0;
}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_UtfCmp --
+ *
+ * Compare UTF chars of string cs to string ct case sensitively.
+ * Replacement for strcmp in Tcl core, in places where UTF-8 should
+ * be handled.
+ *
+ * Results:
+ * Return <0 if cs < ct, 0 if cs == ct, or >0 if cs > ct.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUtfCmp(
+ const char *cs, /* UTF string to compare to ct. */
+ const char *ct) /* UTF string cs is compared to. */
+{
+ Tcl_UniChar ch1 = 0, ch2 = 0;
+
+ while (*cs && *ct) {
+ cs += TclUtfToUniChar(cs, &ch1);
+ ct += TclUtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
+#if TCL_UTF_MAX <= 4
+ /* Surrogates always report higher than non-surrogates */
+ if (((ch1 & 0xFC00) == 0xD800)) {
+ if ((ch2 & 0xFC00) != 0xD800) {
+ return ch1;
+ }
+ } else if ((ch2 & 0xFC00) == 0xD800) {
+ return -ch2;
+ }
+#endif
+ return ch1 - ch2;
+ }
+ }
+ return UCHAR(*cs) - UCHAR(*ct);
+}
+
/*
*----------------------------------------------------------------------
@@ -1207,7 +1313,7 @@ TclUtfCasecmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
if (ch1 != ch2) {
-#if TCL_UTF_MAX == 4
+#if TCL_UTF_MAX <= 4
/* Surrogates always report higher than non-surrogates */
if (((ch1 & 0xFC00) == 0xD800)) {
if ((ch2 & 0xFC00) != 0xD800) {
@@ -1244,16 +1350,18 @@ TclUtfCasecmp(
*----------------------------------------------------------------------
*/
-Tcl_UniChar
+int
Tcl_UniCharToUpper(
int ch) /* Unicode character to convert. */
{
- int info = GetUniCharInfo(ch);
+ if (!UNICODE_OUT_OF_RANGE(ch)) {
+ int info = GetUniCharInfo(ch);
- if (GetCaseType(info) & 0x04) {
- ch -= GetDelta(info);
+ if (GetCaseType(info) & 0x04) {
+ ch -= GetDelta(info);
+ }
}
- return (Tcl_UniChar) ch;
+ return ch & 0x1FFFFF;
}
/*
@@ -1272,17 +1380,19 @@ Tcl_UniCharToUpper(
*----------------------------------------------------------------------
*/
-Tcl_UniChar
+int
Tcl_UniCharToLower(
int ch) /* Unicode character to convert. */
{
- int info = GetUniCharInfo(ch);
- int mode = GetCaseType(info);
+ if (!UNICODE_OUT_OF_RANGE(ch)) {
+ int info = GetUniCharInfo(ch);
+ int mode = GetCaseType(info);
- if ((mode & 0x02) && (mode != 0x7)) {
- ch += GetDelta(info);
+ if ((mode & 0x02) && (mode != 0x7)) {
+ ch += GetDelta(info);
+ }
}
- return (Tcl_UniChar) ch;
+ return ch & 0x1FFFFF;
}
/*
@@ -1301,25 +1411,27 @@ Tcl_UniCharToLower(
*----------------------------------------------------------------------
*/
-Tcl_UniChar
+int
Tcl_UniCharToTitle(
int ch) /* Unicode character to convert. */
{
- int info = GetUniCharInfo(ch);
- int mode = GetCaseType(info);
+ if (!UNICODE_OUT_OF_RANGE(ch)) {
+ int info = GetUniCharInfo(ch);
+ int mode = GetCaseType(info);
- if (mode & 0x1) {
- /*
- * Subtract or add one depending on the original case.
- */
+ if (mode & 0x1) {
+ /*
+ * Subtract or add one depending on the original case.
+ */
- if (mode != 0x7) {
- ch += ((mode & 0x4) ? -1 : 1);
+ if (mode != 0x7) {
+ ch += ((mode & 0x4) ? -1 : 1);
+ }
+ } else if (mode == 0x4) {
+ ch -= GetDelta(info);
}
- } else if (mode == 0x4) {
- ch -= GetDelta(info);
}
- return (Tcl_UniChar) ch;
+ return ch & 0x1FFFFF;
}
/*
@@ -1453,11 +1565,9 @@ int
Tcl_UniCharIsAlnum(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return (((ALPHA_BITS | DIGIT_BITS) >> GetCategory(ch)) & 1);
}
@@ -1481,11 +1591,9 @@ int
Tcl_UniCharIsAlpha(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return ((ALPHA_BITS >> GetCategory(ch)) & 1);
}
@@ -1509,7 +1617,6 @@ int
Tcl_UniCharIsControl(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
ch &= 0x1FFFFF;
if ((ch == 0xE0001) || ((ch >= 0xE0020) && (ch <= 0xE007f))) {
@@ -1520,7 +1627,6 @@ Tcl_UniCharIsControl(
}
return 0;
}
-#endif
return ((CONTROL_BITS >> GetCategory(ch)) & 1);
}
@@ -1544,11 +1650,9 @@ int
Tcl_UniCharIsDigit(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return (GetCategory(ch) == DECIMAL_DIGIT_NUMBER);
}
@@ -1572,12 +1676,10 @@ int
Tcl_UniCharIsGraph(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
ch &= 0x1FFFFF;
return (ch >= 0xE0100) && (ch <= 0xE01EF);
}
-#endif
return ((GRAPH_BITS >> GetCategory(ch)) & 1);
}
@@ -1601,11 +1703,9 @@ int
Tcl_UniCharIsLower(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return (GetCategory(ch) == LOWERCASE_LETTER);
}
@@ -1629,12 +1729,10 @@ int
Tcl_UniCharIsPrint(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
ch &= 0x1FFFFF;
return (ch >= 0xE0100) && (ch <= 0xE01EF);
}
-#endif
return (((GRAPH_BITS|SPACE_BITS) >> GetCategory(ch)) & 1);
}
@@ -1658,11 +1756,9 @@ int
Tcl_UniCharIsPunct(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return ((PUNCT_BITS >> GetCategory(ch)) & 1);
}
@@ -1686,13 +1782,8 @@ int
Tcl_UniCharIsSpace(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
/* Ignore upper 11 bits. */
ch &= 0x1FFFFF;
-#else
- /* Ignore upper 16 bits. */
- ch &= 0xFFFF;
-#endif
/*
* If the character is within the first 127 characters, just use the
@@ -1701,10 +1792,8 @@ Tcl_UniCharIsSpace(
if (ch < 0x80) {
return TclIsSpaceProc((char) ch);
-#if TCL_UTF_MAX > 3
} else if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
-#endif
} else if (ch == 0x0085 || ch == 0x180E || ch == 0x200B
|| ch == 0x202F || ch == 0x2060 || ch == 0xFEFF) {
return 1;
@@ -1733,11 +1822,9 @@ int
Tcl_UniCharIsUpper(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return (GetCategory(ch) == UPPERCASE_LETTER);
}
@@ -1761,11 +1848,9 @@ int
Tcl_UniCharIsWordChar(
int ch) /* Unicode character to test. */
{
-#if TCL_UTF_MAX > 3
if (UNICODE_OUT_OF_RANGE(ch)) {
return 0;
}
-#endif
return ((WORD_BITS >> GetCategory(ch)) & 1);
}
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index d5cc7c2..3d4298e 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -15,6 +15,7 @@
#include "tclInt.h"
#include "tclParse.h"
#include "tclStringTrim.h"
+#include "tommath.h"
#include <math.h>
/*
@@ -107,12 +108,11 @@ static Tcl_ThreadDataKey precisionKey;
static void ClearHash(Tcl_HashTable *tablePtr);
static void FreeProcessGlobalValue(ClientData clientData);
static void FreeThreadHash(ClientData clientData);
-static int GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue,
- int *indexPtr);
+static int GetEndOffsetFromObj(Tcl_Obj *objPtr,
+ size_t endValue, Tcl_WideInt *indexPtr);
static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
-static int SetEndOffsetFromAny(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
-static void UpdateStringOfEndOffset(Tcl_Obj *objPtr);
+static int GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ size_t endValue, Tcl_WideInt *widePtr);
static int FindElement(Tcl_Interp *interp, const char *string,
int stringLength, const char *typeStr,
const char *typeCode, const char **elementPtr,
@@ -121,16 +121,20 @@ static int FindElement(Tcl_Interp *interp, const char *string,
/*
* 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.
+ * performance optimization in TclGetIntForIndex. The internal rep is
+ * stored directly in the wideValue, so no memory management is required
+ * for it. This is a caching intrep, keeping the result of a parse
+ * around. This type is only created from a pre-existing string, so an
+ * updateStringProc will never be called and need not exist. The type
+ * is unregistered, so has no need of a setFromAnyProc either.
*/
-const Tcl_ObjType tclEndOffsetType = {
+static const Tcl_ObjType endOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
- UpdateStringOfEndOffset, /* updateStringProc */
- SetEndOffsetFromAny
+ NULL, /* updateStringProc */
+ NULL /* setFromAnyProc */
};
/*
@@ -1403,9 +1407,9 @@ TclConvertElement(
*/
if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
- src = tclEmptyStringRep;
- length = 0;
- conversion = CONVERT_BRACE;
+ p[0] = '{';
+ p[1] = '}';
+ return 2;
}
/*
@@ -1623,6 +1627,7 @@ Tcl_Merge(
return result;
}
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*
*----------------------------------------------------------------------
*
@@ -1656,6 +1661,7 @@ Tcl_Backslash(
TclUtfToUniChar(buf, &ch);
return (char) ch;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1686,7 +1692,7 @@ UtfWellFormedEnd(
if (Tcl_UtfCharComplete(p, l - p)) {
return bytes;
}
- /*
+ /*
* Malformed utf-8 end, be sure we've NTS to safe compare of end-character,
* avoid segfault by access violation out of range.
*/
@@ -1719,13 +1725,13 @@ TrimRight(
{
const char *p = bytes + numBytes;
int pInc;
+ Tcl_UniChar ch1 = 0, ch2 = 0;
/*
* Outer loop: iterate over string to be trimmed.
*/
do {
- Tcl_UniChar ch1;
const char *q = trim;
int bytesLeft = numTrim;
@@ -1737,7 +1743,6 @@ TrimRight(
*/
do {
- Tcl_UniChar ch2;
int qInc = TclUtfToUniChar(q, &ch2);
if (ch1 == ch2) {
@@ -1818,13 +1823,13 @@ TrimLeft(
int numTrim) /* ...and its length in bytes */
{
const char *p = bytes;
+ Tcl_UniChar ch1 = 0, ch2 = 0;
/*
* Outer loop: iterate over string to be trimmed.
*/
do {
- Tcl_UniChar ch1;
int pInc = TclUtfToUniChar(p, &ch1);
const char *q = trim;
int bytesLeft = numTrim;
@@ -1834,7 +1839,6 @@ TrimLeft(
*/
do {
- Tcl_UniChar ch2;
int qInc = TclUtfToUniChar(q, &ch2);
if (ch1 == ch2) {
@@ -2012,7 +2016,7 @@ Tcl_Concat(
* All element bytes + (argc - 1) spaces + 1 terminating NULL.
*/
- result = ckalloc((unsigned) (bytesNeeded + argc));
+ result = ckalloc(bytesNeeded + argc);
for (p = result, i = 0; i < argc; i++) {
int triml, trimr, elemLength;
@@ -2093,7 +2097,7 @@ Tcl_ConcatObj(
if (TclListObjIsCanonical(objPtr)) {
continue;
}
- Tcl_GetStringFromObj(objPtr, &length);
+ TclGetStringFromObj(objPtr, &length);
if (length > 0) {
break;
}
@@ -2102,7 +2106,7 @@ Tcl_ConcatObj(
resPtr = NULL;
for (i = 0; i < objc; i++) {
objPtr = objv[i];
- if (objPtr->bytes && objPtr->length == 0) {
+ if (!TclListObjIsCanonical(objPtr)) {
continue;
}
if (resPtr) {
@@ -2237,7 +2241,7 @@ Tcl_StringCaseMatch(
{
int p, charLen;
const char *pstart = pattern;
- Tcl_UniChar ch1, ch2;
+ Tcl_UniChar ch1 = 0, ch2 = 0;
while (1) {
p = *pattern;
@@ -2347,7 +2351,7 @@ Tcl_StringCaseMatch(
*/
if (p == '[') {
- Tcl_UniChar startChar, endChar;
+ Tcl_UniChar startChar = 0, endChar = 0;
pattern++;
if (UCHAR(*str) < 0x80) {
@@ -2793,7 +2797,7 @@ TclDStringAppendObj(
Tcl_Obj *objPtr)
{
int length;
- char *bytes = Tcl_GetStringFromObj(objPtr, &length);
+ char *bytes = TclGetStringFromObj(objPtr, &length);
return Tcl_DStringAppend(dsPtr, bytes, length);
}
@@ -3010,7 +3014,6 @@ Tcl_DStringResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
- Tcl_ResetResult(interp);
Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
}
@@ -3040,6 +3043,14 @@ Tcl_DStringGetResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
+#ifdef TCL_NO_DEPRECATED
+ Tcl_Obj *obj = Tcl_GetObjResult(interp);
+ const char *bytes = TclGetString(obj);
+
+ Tcl_DStringFree(dsPtr);
+ Tcl_DStringAppend(dsPtr, bytes, obj->length);
+ Tcl_ResetResult(interp);
+#else
Interp *iPtr = (Interp *) interp;
if (dsPtr->string != dsPtr->staticSpace) {
@@ -3048,7 +3059,7 @@ Tcl_DStringGetResult(
/*
* Do more efficient transfer when we know the result is a Tcl_Obj. When
- * there's no st`ring result, we only have to deal with two cases:
+ * there's no string result, we only have to deal with two cases:
*
* 1. When the string rep is the empty string, when we don't copy but
* instead use the staticSpace in the DString to hold an empty string.
@@ -3063,17 +3074,17 @@ Tcl_DStringGetResult(
if (!iPtr->result[0] && iPtr->objResultPtr
&& !Tcl_IsShared(iPtr->objResultPtr)) {
- if (iPtr->objResultPtr->bytes == tclEmptyStringRep) {
+ if (iPtr->objResultPtr->bytes == &tclEmptyString) {
dsPtr->string = dsPtr->staticSpace;
dsPtr->string[0] = 0;
dsPtr->length = 0;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
} else {
- dsPtr->string = Tcl_GetString(iPtr->objResultPtr);
+ dsPtr->string = TclGetString(iPtr->objResultPtr);
dsPtr->length = iPtr->objResultPtr->length;
dsPtr->spaceAvl = dsPtr->length + 1;
TclFreeIntRep(iPtr->objResultPtr);
- iPtr->objResultPtr->bytes = tclEmptyStringRep;
+ iPtr->objResultPtr->bytes = &tclEmptyString;
iPtr->objResultPtr->length = 0;
}
return;
@@ -3093,7 +3104,7 @@ Tcl_DStringGetResult(
dsPtr->spaceAvl = dsPtr->length+1;
} else {
dsPtr->string = ckalloc(dsPtr->length+1);
- memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
+ memcpy(dsPtr->string, iPtr->result, dsPtr->length+1);
iPtr->freeProc(iPtr->result);
}
dsPtr->spaceAvl = dsPtr->length+1;
@@ -3106,11 +3117,12 @@ Tcl_DStringGetResult(
dsPtr->string = ckalloc(dsPtr->length+1);
dsPtr->spaceAvl = dsPtr->length + 1;
}
- memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
+ memcpy(dsPtr->string, iPtr->result, dsPtr->length+1);
}
iPtr->result = iPtr->resultSpace;
iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
}
/*
@@ -3261,7 +3273,7 @@ Tcl_PrintDouble(
int signum;
char *digits;
char *end;
- int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
+ int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));
/*
* Handle NaN.
@@ -3423,6 +3435,7 @@ Tcl_PrintDouble(
*----------------------------------------------------------------------
*/
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/* ARGSUSED */
char *
TclPrecTraceProc(
@@ -3434,7 +3447,7 @@ TclPrecTraceProc(
{
Tcl_Obj *value;
int prec;
- int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
+ int *precisionPtr = Tcl_GetThreadData(&precisionKey, sizeof(int));
/*
* If the variable is unset, then recreate the trace.
@@ -3457,7 +3470,7 @@ TclPrecTraceProc(
if (flags & TCL_TRACE_READS) {
- Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewIntObj(*precisionPtr),
+ Tcl_SetVar2Ex(interp, name1, name2, Tcl_NewWideIntObj(*precisionPtr),
flags & TCL_GLOBAL_ONLY);
return NULL;
}
@@ -3480,6 +3493,7 @@ TclPrecTraceProc(
*precisionPtr = prec;
return NULL;
}
+#endif /* !TCL_NO_DEPRECATED)*/
/*
*----------------------------------------------------------------------
@@ -3597,9 +3611,9 @@ int
TclFormatInt(
char *buffer, /* Points to the storage into which the
* formatted characters are written. */
- long n) /* The integer to format. */
+ Tcl_WideInt n) /* The integer to format. */
{
- long intVal;
+ Tcl_WideInt intVal;
int i;
int numFormatted, j;
const char *digits = "0123456789";
@@ -3622,7 +3636,7 @@ TclFormatInt(
intVal = -n; /* [Bug 3390638] Workaround for*/
if (n == -n || intVal == n) { /* broken compiler optimizers. */
- return sprintf(buffer, "%ld", n);
+ return sprintf(buffer, "%" TCL_LL_MODIFIER "d", n);
}
/*
@@ -3659,165 +3673,263 @@ TclFormatInt(
/*
*----------------------------------------------------------------------
*
- * TclGetIntForIndex --
+ * GetWideForIndex --
+ *
+ * This function produces a wide integer value corresponding to the
+ * index value held in *objPtr. The parsing supports all values
+ * recognized as any size of integer, and the syntaxes end[-+]$integer
+ * and $integer[-+]$integer. The argument endValue is used to give
+ * the meaning of the literal index value "end". Index arithmetic
+ * on arguments outside the wide integer range are only accepted
+ * when interp is a working interpreter, not NULL.
+ *
+ * Results:
+ * When parsing of *objPtr successfully recognizes an index value,
+ * TCL_OK is returned, and the wide integer value corresponding to
+ * the recognized index value is written to *widePtr. When parsing
+ * fails, TCL_ERROR is returned and error information is written to
+ * interp, if non-NULL.
+ *
+ * Side effects:
+ * The type of *objPtr may change.
*
- * Provides an integer corresponding to the list index held in a Tcl
- * object. The string value 'objPtr' is expected have the format
- * integer([+-]integer)? or end([+-]integer)?.
- *
- * Value
- * TCL_OK
- *
- * The index is stored at the address given by by 'indexPtr'. If
- * 'objPtr' has the value "end", the value stored is 'endValue'.
- *
- * TCL_ERROR
- *
- * The value of 'objPtr' does not have one of the expected formats. If
- * 'interp' is non-NULL, an error message is left in the interpreter's
- * result object.
- *
- * Effect
- *
- * The object referenced by 'objPtr' is converted, as needed, to an
- * integer, wide integer, or end-based-index object.
- *
*----------------------------------------------------------------------
*/
-int
-TclGetIntForIndex(
- Tcl_Interp *interp, /* Interpreter to use for error reporting. If
- * NULL, then no error message is left after
- * errors. */
- Tcl_Obj *objPtr, /* Points to an object containing either "end"
- * or an integer. */
- int endValue, /* The value to be stored at "indexPtr" if
- * "objPtr" holds "end". */
- int *indexPtr) /* Location filled in with an integer
- * representing an index. */
+static int
+GetWideForIndex(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ Tcl_Obj *objPtr, /* Points to the value to be parsed */
+ size_t endValue, /* The value to be stored at *widePtr if
+ * objPtr holds "end".
+ * NOTE: this value may be TCL_INDEX_NONE. */
+ Tcl_WideInt *widePtr) /* Location filled in with a wide integer
+ * representing an index. */
{
- int length;
- char *opPtr;
- const char *bytes;
+ ClientData cd;
+ const char *opPtr;
+ int numType, length, t1 = 0, t2 = 0;
+ int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
+
+ if (code == TCL_OK) {
+ if (numType == TCL_NUMBER_INT) {
+ /* objPtr holds an integer in the signed wide range */
+ *widePtr = *(Tcl_WideInt *)cd;
+ return TCL_OK;
+ }
+ if (numType != TCL_NUMBER_BIG) {
+ /* Must be a double -> not a valid index */
+ goto parseError;
+ }
- if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
- return TCL_OK;
+ /* objPtr holds an integer outside the signed wide range */
+ /* Truncate to the signed wide range. */
+ *widePtr = mp_isneg((mp_int *)cd) ? WIDE_MIN : WIDE_MAX;
+ return TCL_OK;
}
- if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) {
+ /* objPtr does not hold a number, check the end+/- format... */
+ if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
return TCL_OK;
}
- bytes = TclGetStringFromObj(objPtr, &length);
+ /* If we reach here, the string rep of objPtr exists. */
/*
- * Leading whitespace is acceptable in an index.
+ * The valid index syntax does not include any value that is
+ * a list of more than one element. This is necessary so that
+ * lists of index values can be reliably distinguished from any
+ * single index value.
*/
- while (length && TclIsSpaceProc(*bytes)) {
- bytes++;
- length--;
+ /*
+ * Quick scan to see if multi-value list is even possible.
+ * This relies on TclGetString() returning a NUL-terminated string.
+ */
+ if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)
+
+ /* If it's possible, do the full list parse. */
+ && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
+ && (length > 1)) {
+ goto parseError;
}
- if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
- TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
- int code, first, second;
- char savedOp = *opPtr;
+ /* Passed the list screen, so parse for index arithmetic expression */
+ if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
+ TCL_PARSE_INTEGER_ONLY)) {
+ Tcl_WideInt w1=0, w2=0;
- if ((savedOp != '+') && (savedOp != '-')) {
- goto parseError;
- }
- if (TclIsSpaceProc(opPtr[1])) {
- goto parseError;
- }
- *opPtr = '\0';
- code = Tcl_GetInt(interp, bytes, &first);
- *opPtr = savedOp;
- if (code == TCL_ERROR) {
- goto parseError;
- }
- if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
- goto parseError;
- }
- if (savedOp == '+') {
- *indexPtr = first + second;
- } else {
- *indexPtr = first - second;
+ /* value starts with valid integer... */
+
+ if ((*opPtr == '-') || (*opPtr == '+')) {
+ /* ... value continues with [-+] ... */
+
+ /* Save first integer as wide if possible */
+ TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
+ if (t1 == TCL_NUMBER_INT) {
+ w1 = (*(Tcl_WideInt *)cd);
+ }
+
+ if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
+ -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
+ /* ... value concludes with second valid integer */
+
+ /* Save second integer as wide if possible */
+ TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
+ if (t2 == TCL_NUMBER_INT) {
+ w2 = (*(Tcl_WideInt *)cd);
+ }
+ }
+ }
+ /* Clear invalid intreps left by TclParseNumber */
+ TclFreeIntRep(objPtr);
+
+ if (t1 && t2) {
+ /* We have both integer values */
+ if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
+ /* Both are wide, do wide-integer math */
+ if (*opPtr == '-') {
+ if ((w2 == WIDE_MIN) && (interp != NULL)) {
+ goto extreme;
+ }
+ w2 = -w2;
+ }
+
+ if ((w1 ^ w2) < 0) {
+ /* Different signs, sum cannot overflow */
+ *widePtr = w1 + w2;
+ } else if (w1 >= 0) {
+ if (w1 < WIDE_MAX - w2) {
+ *widePtr = w1 + w2;
+ } else {
+ *widePtr = WIDE_MAX;
+ }
+ } else {
+ if (w1 > WIDE_MIN - w2) {
+ *widePtr = w1 + w2;
+ } else {
+ *widePtr = WIDE_MIN;
+ }
+ }
+ } else if (interp == NULL) {
+ /*
+ * We use an interp to do bignum index calculations.
+ * If we don't get one, call all indices with bignums errors,
+ * and rely on callers to handle it.
+ */
+ return TCL_ERROR;
+ } else {
+ /*
+ * At least one is big, do bignum math. Little reason to
+ * value performance here. Re-use code. Parse has verified
+ * objPtr is an expression. Compute it.
+ */
+
+ Tcl_Obj *sum;
+
+ extreme:
+ Tcl_ExprObj(interp, objPtr, &sum);
+ TclGetNumberFromObj(NULL, sum, &cd, &numType);
+
+ if (numType == TCL_NUMBER_INT) {
+ /* sum holds an integer in the signed wide range */
+ *widePtr = *(Tcl_WideInt *)cd;
+ } else {
+ /* sum holds an integer outside the signed wide range */
+ /* Truncate to the signed wide range. */
+ if (mp_isneg((mp_int *)cd)) {
+ *widePtr = WIDE_MIN;
+ } else {
+ *widePtr = WIDE_MAX;
+ }
+ }
+ Tcl_DecrRefCount(sum);
+ }
+ return TCL_OK;
}
- return TCL_OK;
}
- /*
- * Report a parse error.
- */
-
+ /* Report a parse error. */
parseError:
if (interp != NULL) {
- bytes = Tcl_GetString(objPtr);
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad index \"%s\": must be integer?[+-]integer? or"
- " end?[+-]integer?", bytes));
- if (!strncmp(bytes, "end-", 4)) {
- bytes += 4;
- }
- TclCheckBadOctal(interp, bytes);
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+ char * bytes = TclGetString(objPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad index \"%s\": must be integer?[+-]integer? or"
+ " end?[+-]integer?", bytes));
+ if (!strncmp(bytes, "end-", 4)) {
+ bytes += 4;
+ }
+ TclCheckBadOctal(interp, bytes);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
-
return TCL_ERROR;
}
/*
*----------------------------------------------------------------------
*
- * UpdateStringOfEndOffset --
+ * TclGetIntForIndex --
*
- * Update the string rep of a Tcl object holding an "end-offset"
- * expression.
+ * This function returns an integer corresponding to the list index held
+ * in a Tcl object. The Tcl object's value is expected to be in the
+ * format integer([+-]integer)? or the format end([+-]integer)?.
*
* Results:
- * None.
+ * The return value is normally TCL_OK, which means that the index was
+ * successfully stored into the location referenced by "indexPtr". If the
+ * Tcl object referenced by "objPtr" has the value "end", the value
+ * stored is "endValue". If "objPtr"s values is not of one of the
+ * expected formats, TCL_ERROR is returned and, if "interp" is non-NULL,
+ * an error message is left in the interpreter's result object.
*
* Side effects:
- * Stores a valid string in the object's string rep.
- *
- * This function 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.
+ * The object referenced by "objPtr" might be converted to an integer,
+ * wide integer, or end-based-index object.
*
*----------------------------------------------------------------------
*/
-static void
-UpdateStringOfEndOffset(
- register Tcl_Obj *objPtr)
+int
+TclGetIntForIndex(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ Tcl_Obj *objPtr, /* Points to an object containing either "end"
+ * or an integer. */
+ int endValue, /* The value to be stored at "indexPtr" if
+ * "objPtr" holds "end". */
+ int *indexPtr) /* Location filled in with an integer
+ * representing an index. */
{
- char buffer[TCL_INTEGER_SPACE + 5];
- register int len = 3;
+ Tcl_WideInt wide;
- memcpy(buffer, "end", 4);
- if (objPtr->internalRep.longValue != 0) {
- buffer[len++] = '-';
- len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue));
+ if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (wide < 0) {
+ *indexPtr = -1;
+ } else if (wide > INT_MAX) {
+ *indexPtr = INT_MAX;
+ } else {
+ *indexPtr = (int) wide;
}
- objPtr->bytes = ckalloc((unsigned) len+1);
- memcpy(objPtr->bytes, buffer, (unsigned) len+1);
- objPtr->length = len;
+ return TCL_OK;
}
-
/*
*----------------------------------------------------------------------
*
* GetEndOffsetFromObj --
*
- * Look for a string of the form "end[+-]offset" and convert it to an
- * internal representation holding the offset.
+ * Look for a string of the form "end[+-]offset" and convert it to an
+ * internal representation holding the offset.
*
* Results:
- * Tcl return code.
+ * Tcl return code.
*
* Side effects:
- * May store a Tcl_ObjType.
+ * May store a Tcl_ObjType.
*
*----------------------------------------------------------------------
*/
@@ -3825,117 +3937,86 @@ UpdateStringOfEndOffset(
static int
GetEndOffsetFromObj(
Tcl_Obj *objPtr, /* Pointer to the object to parse */
- int endValue, /* The value to be stored at "indexPtr" if
+ size_t endValue, /* The value to be stored at "indexPtr" if
* "objPtr" holds "end". */
- int *indexPtr) /* Location filled in with an integer
+ Tcl_WideInt *widePtr) /* Location filled in with an integer
* representing an index. */
{
- if (SetEndOffsetFromAny(NULL, objPtr) != TCL_OK) {
- return TCL_ERROR;
- }
-
- /* TODO: Handle overflow cases sensibly */
- *indexPtr = endValue + (int)objPtr->internalRep.longValue;
- return TCL_OK;
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * 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(
- Tcl_Interp *interp, /* Tcl interpreter or NULL */
- Tcl_Obj *objPtr) /* Pointer to the object to parse */
-{
- int offset; /* Offset in the "end-offset" expression */
- register const char *bytes; /* String rep of the object */
- int length; /* Length of the object's string rep */
+ Tcl_ObjIntRep *irPtr;
+ Tcl_WideInt offset = 0; /* Offset in the "end-offset" expression */
- /*
- * If it's already the right type, we're fine.
- */
+ while ((irPtr = TclFetchIntRep(objPtr, &endOffsetType)) == NULL) {
+ Tcl_ObjIntRep ir;
+ int length;
+ const char *bytes = TclGetStringFromObj(objPtr, &length);
- if (objPtr->typePtr == &tclEndOffsetType) {
- return TCL_OK;
- }
+ if ((length < 3) || (length == 4)) {
+ /* Too short to be "end" or to be "end-$integer" */
+ return TCL_ERROR;
+ }
+ if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) {
+ /* Value doesn't start with "end" */
+ return TCL_ERROR;
+ }
- /*
- * Check for a string rep of the right form.
- */
+ if (length > 4) {
+ ClientData cd;
+ int t;
- bytes = TclGetStringFromObj(objPtr, &length);
- if ((*bytes != 'e') || (strncmp(bytes, "end",
- (size_t)((length > 3) ? 3 : length)) != 0)) {
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad index \"%s\": must be end?[+-]integer?", bytes));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
- }
- return TCL_ERROR;
- }
+ /* Parse for the "end-..." or "end+..." formats */
- /*
- * Convert the string rep.
- */
+ if ((bytes[3] != '-') && (bytes[3] != '+')) {
+ /* No operator where we need one */
+ return TCL_ERROR;
+ }
+ if (TclIsSpaceProc(bytes[4])) {
+ /* Space after + or - not permitted. */
+ return TCL_ERROR;
+ }
- if (length <= 3) {
- offset = 0;
- } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
- /*
- * This is our limited string expression evaluator. Pass everything
- * after "end-" to Tcl_GetInt, then reverse for offset.
- */
+ /* Parse the integer offset */
+ if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
+ bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
+ /* Not a recognized integer format */
+ return TCL_ERROR;
+ }
- if (TclIsSpaceProc(bytes[4])) {
- goto badIndexFormat;
- }
- if (Tcl_GetInt(interp, bytes+4, &offset) != TCL_OK) {
- return TCL_ERROR;
- }
- if (bytes[3] == '-') {
+ /* Got an integer offset; pull it from where parser left it. */
+ TclGetNumberFromObj(NULL, objPtr, &cd, &t);
- /* TODO: Review overflow concerns here! */
- offset = -offset;
+ if (t == TCL_NUMBER_BIG) {
+ /* Truncate to the signed wide range. */
+ if (mp_isneg((mp_int *)cd)) {
+ offset = (bytes[3] == '-') ? WIDE_MAX : WIDE_MIN;
+ } else {
+ offset = (bytes[3] == '-') ? WIDE_MIN : WIDE_MAX;
+ }
+ } else {
+ /* assert (t == TCL_NUMBER_INT); */
+ offset = (*(Tcl_WideInt *)cd);
+ if (bytes[3] == '-') {
+ offset = (offset == WIDE_MIN) ? WIDE_MAX : -offset;
+ }
+ }
}
- } else {
- /*
- * Conversion failed. Report the error.
- */
- badIndexFormat:
- if (interp != NULL) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "bad index \"%s\": must be end?[+-]integer?", bytes));
- Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
- }
- return TCL_ERROR;
+ /* Success. Store the new internal rep. */
+ ir.wideValue = offset;
+ Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
}
- /*
- * The conversion succeeded. Free the old internal rep and set the new
- * one.
- */
-
- TclFreeIntRep(objPtr);
- objPtr->internalRep.longValue = offset;
- objPtr->typePtr = &tclEndOffsetType;
+ offset = irPtr->wideValue;
+ if (endValue == (size_t)-1) {
+ *widePtr = offset - 1;
+ } else if (offset < 0) {
+ /* Different signs, sum cannot overflow */
+ *widePtr = endValue + offset;
+ } else if (endValue < (Tcl_WideUInt)WIDE_MAX - offset) {
+ *widePtr = endValue + offset;
+ } else {
+ *widePtr = WIDE_MAX;
+ }
return TCL_OK;
}
@@ -3951,7 +4032,7 @@ SetEndOffsetFromAny(
* arithmetic expressions. The absolute index values that can be
* directly meaningful as an index into either a list or a string are
* those integer values >= TCL_INDEX_START (0)
- * and < TCL_INDEX_AFTER (INT_MAX).
+ * and < INT_MAX.
* The largest string supported in Tcl 8 has bytelength INT_MAX.
* This means the largest supported character length is also INT_MAX,
* and the index of the last character in a string of length INT_MAX
@@ -3960,9 +4041,9 @@ SetEndOffsetFromAny(
* Any absolute index value parsed outside that range is encoded
* using the before and after values passed in by the
* caller as the encoding to use for indices that are either
- * less than or greater than the usable index range. TCL_INDEX_AFTER
+ * less than or greater than the usable index range. TCL_INDEX_NONE
* is available as a good choice for most callers to use for
- * after. Likewise, the value TCL_INDEX_BEFORE is good for
+ * after. Likewise, the value TCL_INDEX_NONE is good for
* most callers to use for before. Other values are possible
* when the caller knows it is helpful in producing its own behavior
* for indices before and after the indexed item.
@@ -4002,43 +4083,48 @@ TclIndexEncode(
int after, /* Value to return for index after end */
int *indexPtr) /* Where to write the encoded answer, not NULL */
{
- int idx;
+ ClientData cd;
+ Tcl_WideInt wide;
+ int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
- if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &idx)) {
- /* We parsed a value in the range INT_MIN...INT_MAX */
+ if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) {
+ /* We parsed a value in the range WIDE_MIN...WIDE_MAX */
+ wide = (*(Tcl_WideInt *)cd);
integerEncode:
- if (idx < TCL_INDEX_START) {
+ if (wide < TCL_INDEX_START) {
/* All negative absolute indices are "before the beginning" */
idx = before;
- } else if (idx == INT_MAX) {
+ } else if (wide >= INT_MAX) {
/* This index value is always "after the end" */
idx = after;
- }
+ } else {
+ idx = (int) wide;
+ }
/* usual case, the absolute index value encodes itself */
- } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) {
+ } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) {
/*
- * We parsed an end+offset index value.
- * idx holds the offset value in the range INT_MIN...INT_MAX.
+ * We parsed an end+offset index value.
+ * wide holds the offset value in the range WIDE_MIN...WIDE_MAX.
*/
- if (idx > 0) {
+ if (wide > 0) {
/*
- * All end+postive or end-negative expressions
+ * All end+postive or end-negative expressions
* always indicate "after the end".
*/
idx = after;
- } else if (idx < INT_MIN - TCL_INDEX_END) {
+ } else if (wide < INT_MIN - TCL_INDEX_END) {
/* These indices always indicate "before the beginning */
idx = before;
} else {
/* Encoded end-positive (or end+negative) are offset */
- idx += TCL_INDEX_END;
+ idx = (int)wide + TCL_INDEX_END;
}
/* TODO: Consider flag to suppress repeated end-offset parse. */
- } else if (TCL_OK == TclGetIntForIndexM(interp, objPtr, 0, &idx)) {
+ } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) {
/*
* Only reach this case when the index value is a
- * constant index arithmetic expression, and idx
+ * constant index arithmetic expression, and wide
* holds the result. Treat it the same as if it were
* parsed as an absolute integer value.
*/
@@ -4070,10 +4156,14 @@ TclIndexDecode(
int encoded, /* Value to decode */
int endValue) /* Meaning of "end" to use, > TCL_INDEX_END */
{
- if (encoded <= TCL_INDEX_END) {
- return (encoded - TCL_INDEX_END) + endValue;
+ if (encoded > TCL_INDEX_END) {
+ return encoded;
}
- return encoded;
+ endValue += encoded - TCL_INDEX_END;
+ if (endValue >= 0) {
+ return endValue;
+ }
+ return TCL_INDEX_NONE;
}
/*
@@ -4289,9 +4379,10 @@ TclSetProcessGlobalValue(
} else {
Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
}
- bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes);
+ bytes = TclGetString(newValue);
+ pgvPtr->numBytes = newValue->length;
pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
- memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
+ memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1);
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
}
@@ -4306,7 +4397,7 @@ TclSetProcessGlobalValue(
Tcl_IncrRefCount(newValue);
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
- hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy);
+ hPtr = Tcl_CreateHashEntry(cacheMap, (void *)(size_t)(pgvPtr->epoch), &dummy);
Tcl_SetHashValue(hPtr, newValue);
Tcl_MutexUnlock(&pgvPtr->mutex);
}
@@ -4332,7 +4423,7 @@ TclGetProcessGlobalValue(
Tcl_Obj *value = NULL;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
- int epoch = pgvPtr->epoch;
+ unsigned int epoch = pgvPtr->epoch;
if (pgvPtr->encoding) {
Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL);
@@ -4347,8 +4438,7 @@ TclGetProcessGlobalValue(
Tcl_DString native, newValue;
Tcl_MutexLock(&pgvPtr->mutex);
- pgvPtr->epoch++;
- epoch = pgvPtr->epoch;
+ epoch = ++pgvPtr->epoch;
Tcl_UtfToExternalDString(pgvPtr->encoding, pgvPtr->value,
pgvPtr->numBytes, &native);
Tcl_ExternalToUtfDString(current, Tcl_DStringValue(&native),
@@ -4357,7 +4447,7 @@ TclGetProcessGlobalValue(
ckfree(pgvPtr->value);
pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
- (size_t) Tcl_DStringLength(&newValue) + 1);
+ Tcl_DStringLength(&newValue) + 1);
Tcl_DStringFree(&newValue);
Tcl_FreeEncoding(pgvPtr->encoding);
pgvPtr->encoding = current;
@@ -4367,7 +4457,7 @@ TclGetProcessGlobalValue(
}
}
cacheMap = GetThreadHash(&pgvPtr->key);
- hPtr = Tcl_FindHashEntry(cacheMap, (char *) INT2PTR(epoch));
+ hPtr = Tcl_FindHashEntry(cacheMap, (void *)(size_t)epoch);
if (NULL == hPtr) {
int dummy;
@@ -4400,7 +4490,7 @@ TclGetProcessGlobalValue(
value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
hPtr = Tcl_CreateHashEntry(cacheMap,
- INT2PTR(pgvPtr->epoch), &dummy);
+ (void *)(size_t)(pgvPtr->epoch), &dummy);
Tcl_MutexUnlock(&pgvPtr->mutex);
Tcl_SetHashValue(hPtr, value);
Tcl_IncrRefCount(value);
@@ -4483,11 +4573,10 @@ TclGetObjNameOfExecutable(void)
const char *
Tcl_GetNameOfExecutable(void)
{
- int numBytes;
- const char *bytes =
- Tcl_GetStringFromObj(TclGetObjNameOfExecutable(), &numBytes);
+ Tcl_Obj *obj = TclGetObjNameOfExecutable();
+ const char *bytes = TclGetString(obj);
- if (numBytes == 0) {
+ if (obj->length == 0) {
return NULL;
}
return bytes;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 7b3db7e..6b88344 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -60,14 +60,12 @@ VarHashCreateVar(
Tcl_Obj *key,
int *newPtr)
{
- Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table,
- key, newPtr);
+ Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(&tablePtr->table, key, newPtr);
- if (hPtr) {
- return VarHashGetValue(hPtr);
- } else {
+ if (!hPtr) {
return NULL;
}
+ return VarHashGetValue(hPtr);
}
#define VarHashFindVar(tablePtr, key) \
@@ -92,11 +90,10 @@ VarHashFirstVar(
{
Tcl_HashEntry *hPtr = VarHashFirstEntry(tablePtr, searchPtr);
- if (hPtr) {
- return VarHashGetValue(hPtr);
- } else {
+ if (!hPtr) {
return NULL;
}
+ return VarHashGetValue(hPtr);
}
static inline Var *
@@ -105,11 +102,10 @@ VarHashNextVar(
{
Tcl_HashEntry *hPtr = VarHashNextEntry(searchPtr);
- if (hPtr) {
- return VarHashGetValue(hPtr);
- } else {
+ if (!hPtr) {
return NULL;
}
+ return VarHashGetValue(hPtr);
}
#define VarHashGetKey(varPtr) \
@@ -149,6 +145,7 @@ static const char *isArrayElement =
*/
typedef struct ArraySearch {
+ Tcl_Obj *name; /* Name of this search */
int id; /* Integer id used to distinguish among
* multiple concurrent searches for the same
* array. */
@@ -168,11 +165,31 @@ typedef struct ArraySearch {
} ArraySearch;
/*
+ * TIP #508: [array default]
+ *
+ * The following structure extends the regular TclVarHashTable used by array
+ * variables to store their optional default value.
+ */
+
+typedef struct ArrayVarHashTable {
+ TclVarHashTable table;
+ Tcl_Obj *defaultObj;
+} ArrayVarHashTable;
+
+/*
* Forward references to functions defined later in this file:
*/
static void AppendLocals(Tcl_Interp *interp, Tcl_Obj *listPtr,
Tcl_Obj *patternPtr, int includeLinks);
+static void ArrayPopulateSearch(Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj, Var *varPtr,
+ ArraySearch *searchPtr);
+static void ArrayDoneSearch(Interp *iPtr, Var *varPtr,
+ ArraySearch *searchPtr);
+static Tcl_NRPostProc ArrayForLoopCallback;
+static int ArrayForNRCmd(ClientData dummy, Tcl_Interp *interp,
+ int objc, Tcl_Obj *const *objv);
static void DeleteSearches(Interp *iPtr, Var *arrayVarPtr);
static void DeleteArray(Interp *iPtr, Tcl_Obj *arrayNamePtr,
Var *varPtr, int flags, int index);
@@ -191,8 +208,16 @@ static ArraySearch * ParseSearchId(Tcl_Interp *interp, const Var *varPtr,
static void UnsetVarStruct(Var *varPtr, Var *arrayPtr,
Interp *iPtr, Tcl_Obj *part1Ptr,
Tcl_Obj *part2Ptr, int flags, int index);
-static int SetArraySearchObj(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
+
+/*
+ * TIP #508: [array default]
+ */
+
+static int ArrayDefaultCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static void DeleteArrayVar(Var *arrayPtr);
+static void SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);
/*
* Functions defined in this file that may be exported in the future for use
@@ -205,14 +230,9 @@ MODULE_SCOPE Var * TclLookupSimpleVar(Tcl_Interp *interp,
static Tcl_DupInternalRepProc DupLocalVarName;
static Tcl_FreeInternalRepProc FreeLocalVarName;
-static Tcl_UpdateStringProc PanicOnUpdateVarName;
static Tcl_FreeInternalRepProc FreeParsedVarName;
static Tcl_DupInternalRepProc DupParsedVarName;
-static Tcl_UpdateStringProc UpdateParsedVarName;
-
-static Tcl_UpdateStringProc PanicOnUpdateVarName;
-static Tcl_SetFromAnyProc PanicOnSetVarName;
/*
* Types of Tcl_Objs used to cache variable lookups.
@@ -231,30 +251,52 @@ static Tcl_SetFromAnyProc PanicOnSetVarName;
static const Tcl_ObjType localVarNameType = {
"localVarName",
- FreeLocalVarName, DupLocalVarName, PanicOnUpdateVarName, PanicOnSetVarName
+ FreeLocalVarName, DupLocalVarName, NULL, NULL
};
-static const Tcl_ObjType tclParsedVarNameType = {
+#define LocalSetIntRep(objPtr, index, namePtr) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ Tcl_Obj *ptr = (namePtr); \
+ if (ptr) {Tcl_IncrRefCount(ptr);} \
+ ir.twoPtrValue.ptr1 = ptr; \
+ ir.twoPtrValue.ptr2 = INT2PTR(index); \
+ Tcl_StoreIntRep((objPtr), &localVarNameType, &ir); \
+ } while (0)
+
+#define LocalGetIntRep(objPtr, index, name) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &localVarNameType); \
+ (name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ (index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1; \
+ } while (0)
+
+static const Tcl_ObjType parsedVarNameType = {
"parsedVarName",
- FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
+ FreeParsedVarName, DupParsedVarName, NULL, NULL
};
-/*
- * Type of Tcl_Objs used to speed up array searches.
- *
- * INTERNALREP DEFINITION:
- * twoPtrValue.ptr1: searchIdNumber (cast to pointer)
- * twoPtrValue.ptr2: variableNameStartInString (cast to pointer)
- *
- * Note that the value stored in ptr2 is the offset into the string of the
- * start of the variable name and not the address of the variable name itself,
- * as this can be safely copied.
- */
-
-const Tcl_ObjType tclArraySearchType = {
- "array search",
- NULL, NULL, NULL, SetArraySearchObj
-};
+#define ParsedSetIntRep(objPtr, arrayPtr, elem) \
+ do { \
+ Tcl_ObjIntRep ir; \
+ Tcl_Obj *ptr1 = (arrayPtr); \
+ Tcl_Obj *ptr2 = (elem); \
+ if (ptr1) {Tcl_IncrRefCount(ptr1);} \
+ if (ptr2) {Tcl_IncrRefCount(ptr2);} \
+ ir.twoPtrValue.ptr1 = ptr1; \
+ ir.twoPtrValue.ptr2 = ptr2; \
+ Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir); \
+ } while (0)
+
+#define ParsedGetIntRep(objPtr, parsed, array, elem) \
+ do { \
+ const Tcl_ObjIntRep *irPtr; \
+ irPtr = TclFetchIntRep((objPtr), &parsedVarNameType); \
+ (parsed) = (irPtr != NULL); \
+ (array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL; \
+ (elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL; \
+ } while (0)
Var *
TclVarHashCreateVar(
@@ -340,7 +382,8 @@ CleanupVar(
{
if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
&& !TclIsVarTraced(varPtr)
- && (VarHashRefCount(varPtr) == !TclIsVarDeadHash(varPtr))) {
+ && (VarHashRefCount(varPtr) == (unsigned)
+ !TclIsVarDeadHash(varPtr))) {
if (VarHashRefCount(varPtr) == 0) {
ckfree(varPtr);
} else {
@@ -349,7 +392,8 @@ CleanupVar(
}
if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
- (VarHashRefCount(arrayPtr) == !TclIsVarDeadHash(arrayPtr))) {
+ (VarHashRefCount(arrayPtr) == (unsigned)
+ !TclIsVarDeadHash(arrayPtr))) {
if (VarHashRefCount(arrayPtr) == 0) {
ckfree(arrayPtr);
} else {
@@ -477,9 +521,8 @@ TclLookupVar(
*
* Side effects:
* New hashtable entries may be created if createPart1 or createPart2
- * are 1. The object part1Ptr is converted to one of localVarNameType,
- * tclNsVarNameType or tclParsedVarNameType and caches as much of the
- * lookup as it can.
+ * are 1. The object part1Ptr is converted to one of localVarNameType
+ * or parsedVarNameType and caches as much of the lookup as it can.
* When createPart1 is 1, callers must IncrRefCount part1Ptr if they
* plan to DecrRefCount it.
*
@@ -561,24 +604,20 @@ TclObjLookupVarEx(
* is set to NULL. */
{
Interp *iPtr = (Interp *) interp;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
register Var *varPtr; /* Points to the variable's in-frame Var
* structure. */
- const char *part1;
- int index, len1, len2;
- int parsed = 0;
- Tcl_Obj *objPtr;
- const Tcl_ObjType *typePtr = part1Ptr->typePtr;
const char *errMsg = NULL;
- CallFrame *varFramePtr = iPtr->varFramePtr;
- const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
- char *newPart2 = NULL;
- *arrayPtrPtr = NULL;
+ int index, parsed = 0;
+
+ int localIndex;
+ Tcl_Obj *namePtr, *arrayPtr, *elem;
- if (typePtr == &localVarNameType) {
- int localIndex;
+ *arrayPtrPtr = NULL;
- localVarNameTypeHandling:
- localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
+ restart:
+ LocalGetIntRep(part1Ptr, localIndex, namePtr);
+ if (localIndex >= 0) {
if (HasLocalVars(varFramePtr)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
@@ -586,8 +625,7 @@ TclObjLookupVarEx(
* Use the cached index if the names coincide.
*/
- Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj *checkNamePtr = localName(iPtr->varFramePtr, localIndex);
+ Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);
if ((!namePtr && (checkNamePtr == part1Ptr)) ||
(namePtr && (checkNamePtr == namePtr))) {
@@ -599,12 +637,11 @@ TclObjLookupVarEx(
}
/*
- * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
- * parts.
+ * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
*/
- if (typePtr == &tclParsedVarNameType) {
- if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
+ ParsedGetIntRep(part1Ptr, parsed, arrayPtr, elem);
+ if (parsed && arrayPtr) {
if (part2Ptr != NULL) {
/*
* ERROR: part1Ptr is already an array element, cannot specify
@@ -618,33 +655,23 @@ TclObjLookupVarEx(
}
return NULL;
}
- part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
- if (newPart2) {
- part2Ptr = Tcl_NewStringObj(newPart2, -1);
- if (createPart2) {
- Tcl_IncrRefCount(part2Ptr);
- }
- }
- part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
- typePtr = part1Ptr->typePtr;
- if (typePtr == &localVarNameType) {
- goto localVarNameTypeHandling;
- }
- }
- parsed = 1;
+ part2Ptr = elem;
+ part1Ptr = arrayPtr;
+ goto restart;
}
- part1 = TclGetStringFromObj(part1Ptr, &len1);
- if (!parsed && len1 && (*(part1 + len1 - 1) == ')')) {
+ if (!parsed) {
/*
* part1Ptr is possibly an unparsed array element.
*/
- register int i;
+ int len;
+ const char *part1 = TclGetStringFromObj(part1Ptr, &len);
+
+ if ((len > 1) && (part1[len - 1] == ')')) {
+ const char *part2 = strchr(part1, '(');
- len2 = -1;
- for (i = 0; i < len1; i++) {
- if (*(part1 + i) == '(') {
+ if (part2) {
if (part2Ptr != NULL) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
@@ -655,49 +682,13 @@ TclObjLookupVarEx(
return NULL;
}
- /*
- * 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(len2 + 1);
- memcpy(newPart2, part2, (unsigned) len2);
- *(newPart2+len2) = '\0';
- part2 = newPart2;
- part2Ptr = Tcl_NewStringObj(newPart2, -1);
- if (createPart2) {
- Tcl_IncrRefCount(part2Ptr);
- }
-
- /*
- * Free the internal rep of the original part1Ptr, now renamed
- * objPtr, and set it to tclParsedVarNameType.
- */
-
- objPtr = part1Ptr;
- TclFreeIntRep(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.
- */
-
- TclNewStringObj(part1Ptr, part1, len1);
- Tcl_IncrRefCount(part1Ptr);
+ arrayPtr = Tcl_NewStringObj(part1, (part2 - part1));
+ part2Ptr = Tcl_NewStringObj(part2 + 1,
+ len - (part2 - part1) - 2);
- objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
- objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
+ ParsedSetIntRep(part1Ptr, arrayPtr, part2Ptr);
- typePtr = part1Ptr->typePtr;
- part1 = TclGetString(part1Ptr);
- break;
+ part1Ptr = arrayPtr;
}
}
}
@@ -708,8 +699,6 @@ TclObjLookupVarEx(
* the cached types if possible.
*/
- TclFreeIntRep(part1Ptr);
-
varPtr = TclLookupSimpleVar(interp, part1Ptr, flags, createPart1,
&errMsg, &index);
if (varPtr == NULL) {
@@ -718,9 +707,6 @@ TclObjLookupVarEx(
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
TclGetString(part1Ptr), NULL);
}
- if (newPart2) {
- Tcl_DecrRefCount(part2Ptr);
- }
return NULL;
}
@@ -732,28 +718,39 @@ TclObjLookupVarEx(
/*
* An indexed local variable.
*/
- Tcl_Obj *cachedNamePtr = localName(iPtr->varFramePtr, index);
-
- part1Ptr->typePtr = &localVarNameType;
- if (part1Ptr != cachedNamePtr) {
- part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
- Tcl_IncrRefCount(cachedNamePtr);
- if (cachedNamePtr->typePtr != &localVarNameType
- || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
- TclFreeIntRep(cachedNamePtr);
- }
+
+ Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
+
+ if (part1Ptr == cachedNamePtr) {
+ cachedNamePtr = NULL;
} else {
- part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
+ /*
+ * [80304238ac] Trickiness here. We will store and incr the
+ * refcount on cachedNamePtr. Trouble is that it's possible
+ * (see test var-22.1) for cachedNamePtr to have an intrep
+ * that contains a stored and refcounted part1Ptr. This
+ * would be a reference cycle which leads to a memory leak.
+ *
+ * The solution here is to wipe away all intrep(s) in
+ * cachedNamePtr and leave it as string only. This is
+ * radical and destructive, so a better idea would be welcome.
+ */
+ TclFreeIntRep(cachedNamePtr);
+
+ /*
+ * Now go ahead and convert it the the "localVarName" type,
+ * since we suspect at least some use of the value as a
+ * varname and we want to resolve it quickly.
+ */
+ LocalSetIntRep(cachedNamePtr, index, NULL);
}
- part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
+ LocalSetIntRep(part1Ptr, index, cachedNamePtr);
} else {
/*
* At least mark part1Ptr as already parsed.
*/
- part1Ptr->typePtr = &tclParsedVarNameType;
- part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
- part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
+ ParsedSetIntRep(part1Ptr, NULL, NULL);
}
donePart1:
@@ -769,9 +766,6 @@ TclObjLookupVarEx(
*arrayPtrPtr = varPtr;
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
createPart1, createPart2, varPtr, -1);
- if (newPart2) {
- Tcl_DecrRefCount(part2Ptr);
- }
}
return varPtr;
}
@@ -938,38 +932,41 @@ TclLookupSimpleVar(
if (varPtr == NULL) {
Tcl_Obj *tailPtr;
- if (create) { /* Var wasn't found so create it. */
- TclGetNamespaceForQualName(interp, varName, cxtNsPtr,
- flags, &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
- if (varNsPtr == NULL) {
- *errMsgPtr = badNamespace;
- return NULL;
- } else if (tail == NULL) {
- *errMsgPtr = missingName;
- return NULL;
- }
- if (tail != varName) {
- tailPtr = Tcl_NewStringObj(tail, -1);
- } else {
- tailPtr = varNamePtr;
- }
- varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr,
- &isNew);
- if (lookGlobal) {
- /*
- * The variable was created starting from the global
- * namespace: a global reference is returned even if it
- * wasn't explicitly requested.
- */
-
- *indexPtr = -1;
- } else {
- *indexPtr = -2;
- }
- } else { /* Var wasn't found and not to create it. */
+ if (!create) { /* Var wasn't found and not to create it. */
*errMsgPtr = noSuchVar;
return NULL;
}
+
+ /*
+ * Var wasn't found so create it.
+ */
+
+ TclGetNamespaceForQualName(interp, varName, cxtNsPtr, flags,
+ &varNsPtr, &dummy1Ptr, &dummy2Ptr, &tail);
+ if (varNsPtr == NULL) {
+ *errMsgPtr = badNamespace;
+ return NULL;
+ } else if (tail == NULL) {
+ *errMsgPtr = missingName;
+ return NULL;
+ }
+ if (tail != varName) {
+ tailPtr = Tcl_NewStringObj(tail, -1);
+ } else {
+ tailPtr = varNamePtr;
+ }
+ varPtr = VarHashCreateVar(&varNsPtr->varTable, tailPtr, &isNew);
+ if (lookGlobal) {
+ /*
+ * The variable was created starting from the global
+ * namespace: a global reference is returned even if it wasn't
+ * explicitly requested.
+ */
+
+ *indexPtr = -1;
+ } else {
+ *indexPtr = -2;
+ }
}
} else { /* Local var: look in frame varFramePtr. */
int localCt = varFramePtr->numCompiledLocals;
@@ -1075,8 +1072,6 @@ TclLookupArrayElement(
{
int isNew;
Var *varPtr;
- TclVarHashTable *tablePtr;
- Namespace *nsPtr;
/*
* We're dealing with an array element. Make sure the variable is an array
@@ -1109,16 +1104,7 @@ TclLookupArrayElement(
return NULL;
}
- TclSetVarArray(arrayPtr);
- tablePtr = ckalloc(sizeof(TclVarHashTable));
- arrayPtr->value.tablePtr = tablePtr;
-
- if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
- nsPtr = TclGetVarNsPtr(arrayPtr);
- } else {
- nsPtr = NULL;
- }
- TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
+ TclInitArrayVar(arrayPtr);
} else if (!TclIsVarArray(arrayPtr)) {
if (flags & TCL_LEAVE_ERR_MSG) {
TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
@@ -1174,6 +1160,7 @@ TclLookupArrayElement(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_GetVar
const char *
Tcl_GetVar(
@@ -1194,6 +1181,7 @@ Tcl_GetVar(
}
return TclGetString(resultPtr);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1466,6 +1454,28 @@ TclPtrGetVarIdx(
return varPtr->value.objPtr;
}
+ /*
+ * Return the array default value if any.
+ */
+
+ if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
+ return TclGetArrayDefault(arrayPtr);
+ }
+ if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
+ /*
+ * UGLY! Peek inside the implementation of things. This lets us get
+ * the default of an array even when we've been [upvar]ed to just an
+ * element of the array.
+ */
+
+ ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
+ ((VarInHash *) varPtr)->entry.tablePtr;
+
+ if (avhtPtr->defaultObj) {
+ return avhtPtr->defaultObj;
+ }
+ }
+
if (flags & TCL_LEAVE_ERR_MSG) {
if (TclIsVarUndefined(varPtr) && arrayPtr
&& !TclIsVarUndefined(arrayPtr)) {
@@ -1563,6 +1573,7 @@ Tcl_SetObjCmd(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_SetVar
const char *
Tcl_SetVar(
@@ -1575,18 +1586,15 @@ Tcl_SetVar(
* TCL_APPEND_VALUE, TCL_LIST_ELEMENT,
* TCL_LEAVE_ERR_MSG. */
{
- Tcl_Obj *varValuePtr, *varNamePtr = Tcl_NewStringObj(varName, -1);
-
- Tcl_IncrRefCount(varNamePtr);
- varValuePtr = Tcl_ObjSetVar2(interp, varNamePtr, NULL,
+ Tcl_Obj *varValuePtr = Tcl_SetVar2Ex(interp, varName, NULL,
Tcl_NewStringObj(newValue, -1), flags);
- Tcl_DecrRefCount(varNamePtr);
if (varValuePtr == NULL) {
return NULL;
}
return TclGetString(varValuePtr);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1828,6 +1836,130 @@ TclPtrSetVar(
/*
*----------------------------------------------------------------------
*
+ * ListAppendInVar, StringAppendInVar --
+ *
+ * Support functions for TclPtrSetVarIdx that implement various types of
+ * appending operations.
+ *
+ * Results:
+ * ListAppendInVar returns a Tcl result code (from the core list append
+ * operation). StringAppendInVar has no return value.
+ *
+ * Side effects:
+ * The variable or element of the array is updated. This may make the
+ * variable/element exist. Reference counts of values may be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ListAppendInVar(
+ Tcl_Interp *interp,
+ Var *varPtr,
+ Var *arrayPtr,
+ Tcl_Obj *oldValuePtr,
+ Tcl_Obj *newValuePtr)
+{
+ if (oldValuePtr == NULL) {
+ /*
+ * No previous value. Check for defaults if there's an array we can
+ * ask this of.
+ */
+
+ if (arrayPtr) {
+ Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
+
+ if (defValuePtr) {
+ oldValuePtr = Tcl_DuplicateObj(defValuePtr);
+ }
+ }
+
+ if (oldValuePtr == NULL) {
+ /*
+ * No default. [lappend] semantics say this is like being an empty
+ * string.
+ */
+
+ TclNewObj(oldValuePtr);
+ }
+ varPtr->value.objPtr = oldValuePtr;
+ Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */
+ } else if (Tcl_IsShared(oldValuePtr)) {
+ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+ TclDecrRefCount(oldValuePtr);
+ oldValuePtr = varPtr->value.objPtr;
+ Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */
+ }
+
+ return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
+}
+
+static inline void
+StringAppendInVar(
+ Var *varPtr,
+ Var *arrayPtr,
+ Tcl_Obj *oldValuePtr,
+ Tcl_Obj *newValuePtr)
+{
+ /*
+ * If there was no previous value, either we use the array's default (if
+ * this is an array with a default at all) or we treat this as a simple
+ * set.
+ */
+
+ if (oldValuePtr == NULL) {
+ if (arrayPtr) {
+ Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
+
+ if (defValuePtr) {
+ /*
+ * This is *almost* the same as the shared path below, except
+ * that the original value reference in defValuePtr is not
+ * decremented.
+ */
+
+ Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);
+
+ varPtr->value.objPtr = valuePtr;
+ TclContinuationsCopy(valuePtr, defValuePtr);
+ Tcl_IncrRefCount(valuePtr);
+ Tcl_AppendObjToObj(valuePtr, newValuePtr);
+ if (newValuePtr->refCount == 0) {
+ Tcl_DecrRefCount(newValuePtr);
+ }
+ return;
+ }
+ }
+ varPtr->value.objPtr = newValuePtr;
+ Tcl_IncrRefCount(newValuePtr);
+ return;
+ }
+
+ /*
+ * We append newValuePtr's bytes but don't change its ref count. Unless
+ * the reference is shared, when we have to duplicate in order to be safe
+ * to modify at all.
+ */
+
+ if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */
+ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+
+ TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
+
+ TclDecrRefCount(oldValuePtr);
+ oldValuePtr = varPtr->value.objPtr;
+ Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */
+ }
+
+ Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
+ if (newValuePtr->refCount == 0) {
+ Tcl_DecrRefCount(newValuePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclPtrSetVarIdx --
*
* This function is the same as Tcl_SetVar2Ex above, except that it
@@ -1940,44 +2072,13 @@ TclPtrSetVarIdx(
}
if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
if (flags & TCL_LIST_ELEMENT) { /* Append list element. */
- if (oldValuePtr == NULL) {
- TclNewObj(oldValuePtr);
- varPtr->value.objPtr = oldValuePtr;
- Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */
- } else if (Tcl_IsShared(oldValuePtr)) {
- varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
- TclDecrRefCount(oldValuePtr);
- oldValuePtr = varPtr->value.objPtr;
- Tcl_IncrRefCount(oldValuePtr); /* Since var is referenced. */
- }
- result = Tcl_ListObjAppendElement(interp, oldValuePtr,
+ result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
newValuePtr);
if (result != TCL_OK) {
goto earlyError;
}
} else { /* Append string. */
- /*
- * We append newValuePtr's bytes but don't change its ref count.
- */
-
- if (oldValuePtr == NULL) {
- varPtr->value.objPtr = newValuePtr;
- Tcl_IncrRefCount(newValuePtr);
- } else {
- if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */
- varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-
- TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
-
- TclDecrRefCount(oldValuePtr);
- oldValuePtr = varPtr->value.objPtr;
- Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */
- }
- Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
- if (newValuePtr->refCount == 0) {
- Tcl_DecrRefCount(newValuePtr);
- }
- }
+ StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
}
} else if (newValuePtr != oldValuePtr) {
/*
@@ -2232,7 +2333,6 @@ TclPtrIncrObjVarIdx(
} else {
/* Unshared - can Incr in place */
if (TCL_OK == TclIncrObj(interp, varValuePtr, incrPtr)) {
-
/*
* This seems dumb to write the incremeted value into the var
* after we just adjusted the value in place, but the spec for
@@ -2268,6 +2368,7 @@ TclPtrIncrObjVarIdx(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_UnsetVar
int
Tcl_UnsetVar(
@@ -2296,6 +2397,7 @@ Tcl_UnsetVar(
Tcl_DecrRefCount(varNamePtr);
return result;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -2972,6 +3074,310 @@ Tcl_LappendObjCmd(
/*
*----------------------------------------------------------------------
*
+ * ArrayForObjCmd, ArrayForNRCmd, ArrayForLoopCallback, ArrayObjNext --
+ *
+ * These functions implement the "array for" Tcl command.
+ * array for {k v} a {}
+ * The array for command iterates over the array, setting the the
+ * specified loop variables, and executing the body each iteration.
+ *
+ * ArrayForObjCmd() is the standard wrapper around ArrayForNRCmd().
+ *
+ * ArrayForNRCmd() sets up the ArraySearch structure, sets arrayNamePtr
+ * inside the structure and calls VarHashFirstEntry to start the hash
+ * iteration.
+ *
+ * ArrayForNRCmd() does not execute the body or set the loop variables,
+ * it only initializes the iterator.
+ *
+ * ArrayForLoopCallback() iterates over the entire array, executing the
+ * body each time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ArrayObjNext(
+ Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj, /* array */
+ Var *varPtr, /* array */
+ ArraySearch *searchPtr,
+ Tcl_Obj **keyPtrPtr, /* Pointer to a variable to have the key
+ * written into, or NULL. */
+ Tcl_Obj **valuePtrPtr) /* Pointer to a variable to have the
+ * value written into, or NULL.*/
+{
+ Tcl_Obj *keyObj;
+ Tcl_Obj *valueObj = NULL;
+ int gotValue;
+ int donerc;
+
+ donerc = TCL_BREAK;
+
+ if ((varPtr->flags & VAR_SEARCH_ACTIVE) != VAR_SEARCH_ACTIVE) {
+ donerc = TCL_ERROR;
+ return donerc;
+ }
+
+ gotValue = 0;
+ while (1) {
+ Tcl_HashEntry *hPtr = searchPtr->nextEntry;
+
+ if (hPtr != NULL) {
+ searchPtr->nextEntry = NULL;
+ } else {
+ hPtr = Tcl_NextHashEntry(&searchPtr->search);
+ if (hPtr == NULL) {
+ gotValue = 0;
+ break;
+ }
+ }
+ varPtr = VarHashGetValue(hPtr);
+ if (!TclIsVarUndefined(varPtr)) {
+ gotValue = 1;
+ break;
+ }
+ }
+
+ if (!gotValue) {
+ return donerc;
+ }
+
+ donerc = TCL_CONTINUE;
+
+ keyObj = VarHashGetKey(varPtr);
+ *keyPtrPtr = keyObj;
+ valueObj = Tcl_ObjGetVar2(interp, arrayNameObj, keyObj,
+ TCL_LEAVE_ERR_MSG);
+ *valuePtrPtr = valueObj;
+
+ return donerc;
+}
+
+static int
+ArrayForObjCmd(
+ ClientData dummy, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ return Tcl_NRCallObjProc(interp, ArrayForNRCmd, dummy, objc, objv);
+}
+
+static int
+ArrayForNRCmd(
+ ClientData dummy,
+ Tcl_Interp *interp,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Tcl_Obj *varListObj, *arrayNameObj, *scriptObj;
+ ArraySearch *searchPtr = NULL;
+ Var *varPtr;
+ int isArray, numVars;
+
+ /*
+ * array for {k v} a body
+ */
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "{key value} arrayName script");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse arguments.
+ */
+
+ if (Tcl_ListObjLength(interp, objv[1], &numVars) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (numVars != 2) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "must have two variable names", -1));
+ Tcl_SetErrorCode(interp, "TCL", "SYNTAX", "array", "for", NULL);
+ return TCL_ERROR;
+ }
+
+ arrayNameObj = objv[2];
+
+ if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
+ return TCL_ERROR;
+ }
+
+ if (!isArray) {
+ return NotArrayError(interp, arrayNameObj);
+ }
+
+ /*
+ * Make a new array search, put it on the stack.
+ */
+
+ searchPtr = ckalloc(sizeof(ArraySearch));
+ ArrayPopulateSearch(interp, arrayNameObj, varPtr, searchPtr);
+
+ /*
+ * Make sure that these objects (which we need throughout the body of the
+ * loop) don't vanish.
+ */
+
+ varListObj = TclListObjCopy(NULL, objv[1]);
+ scriptObj = objv[3];
+ Tcl_IncrRefCount(scriptObj);
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
+ arrayNameObj, scriptObj);
+ return TCL_OK;
+}
+
+static int
+ArrayForLoopCallback(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Interp *iPtr = (Interp *) interp;
+ ArraySearch *searchPtr = data[0];
+ Tcl_Obj *varListObj = data[1];
+ Tcl_Obj *arrayNameObj = data[2];
+ Tcl_Obj *scriptObj = data[3];
+ Tcl_Obj **varv;
+ Tcl_Obj *keyObj, *valueObj;
+ Var *varPtr;
+ Var *arrayPtr;
+ int done, varc;
+
+ /*
+ * Process the result from the previous execution of the script body.
+ */
+
+ done = TCL_ERROR;
+
+ if (result == TCL_CONTINUE) {
+ result = TCL_OK;
+ } else if (result != TCL_OK) {
+ if (result == TCL_BREAK) {
+ Tcl_ResetResult(interp);
+ result = TCL_OK;
+ } else if (result == TCL_ERROR) {
+ Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
+ "\n (\"array for\" body line %d)",
+ Tcl_GetErrorLine(interp)));
+ }
+ goto arrayfordone;
+ }
+
+ /*
+ * Get the next mapping from the array.
+ */
+
+ keyObj = NULL;
+ valueObj = NULL;
+ varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL, /*flags*/ 0,
+ /*msg*/ 0, /*createPart1*/ 0, /*createPart2*/ 0, &arrayPtr);
+ if (varPtr == NULL) {
+ done = TCL_ERROR;
+ } else {
+ done = ArrayObjNext(interp, arrayNameObj, varPtr, searchPtr, &keyObj,
+ &valueObj);
+ }
+
+ result = TCL_OK;
+ if (done != TCL_CONTINUE) {
+ Tcl_ResetResult(interp);
+ if (done == TCL_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "array changed during iteration", -1));
+ Tcl_SetErrorCode(interp, "TCL", "READ", "array", "for", NULL);
+ varPtr->flags |= TCL_LEAVE_ERR_MSG;
+ result = done;
+ }
+ goto arrayfordone;
+ }
+
+ Tcl_ListObjGetElements(NULL, varListObj, &varc, &varv);
+ if (Tcl_ObjSetVar2(interp, varv[0], NULL, keyObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto arrayfordone;
+ }
+ if (valueObj != NULL) {
+ if (Tcl_ObjSetVar2(interp, varv[1], NULL, valueObj,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+ result = TCL_ERROR;
+ goto arrayfordone;
+ }
+ }
+
+ /*
+ * Run the script.
+ */
+
+ TclNRAddCallback(interp, ArrayForLoopCallback, searchPtr, varListObj,
+ arrayNameObj, scriptObj);
+ return TclNREvalObjEx(interp, scriptObj, 0, iPtr->cmdFramePtr, 3);
+
+ /*
+ * For unwinding everything once the iterating is done.
+ */
+
+ arrayfordone:
+ if (done != TCL_ERROR) {
+ /*
+ * If the search was terminated by an array change, the
+ * VAR_SEARCH_ACTIVE flag will no longer be set.
+ */
+
+ ArrayDoneSearch(iPtr, varPtr, searchPtr);
+ Tcl_DecrRefCount(searchPtr->name);
+ ckfree(searchPtr);
+ }
+
+ TclDecrRefCount(varListObj);
+ TclDecrRefCount(scriptObj);
+ return result;
+}
+
+/*
+ * ArrayPopulateSearch
+ */
+
+static void
+ArrayPopulateSearch(
+ Tcl_Interp *interp,
+ Tcl_Obj *arrayNameObj,
+ Var *varPtr,
+ ArraySearch *searchPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
+ if (isNew) {
+ searchPtr->id = 1;
+ varPtr->flags |= VAR_SEARCH_ACTIVE;
+ searchPtr->nextPtr = NULL;
+ } else {
+ searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
+ searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
+ }
+ searchPtr->varPtr = varPtr;
+ searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
+ &searchPtr->search);
+ Tcl_SetHashValue(hPtr, searchPtr);
+ searchPtr->name = Tcl_ObjPrintf("s-%d-%s", searchPtr->id,
+ TclGetString(arrayNameObj));
+ Tcl_IncrRefCount(searchPtr->name);
+}
+/*
+ *----------------------------------------------------------------------
+ *
* ArrayStartSearchCmd --
*
* This object-based function is invoked to process the "array
@@ -2988,6 +3394,7 @@ Tcl_LappendObjCmd(
*/
/* ARGSUSED */
+
static int
ArrayStartSearchCmd(
ClientData clientData,
@@ -2995,12 +3402,9 @@ ArrayStartSearchCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *)interp;
Var *varPtr;
- Tcl_HashEntry *hPtr;
- int isNew, isArray;
+ int isArray;
ArraySearch *searchPtr;
- const char *varName;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arrayName");
@@ -3019,24 +3423,54 @@ ArrayStartSearchCmd(
* Make a new array search with a free name.
*/
- varName = TclGetString(objv[1]);
searchPtr = ckalloc(sizeof(ArraySearch));
- hPtr = Tcl_CreateHashEntry(&iPtr->varSearches, varPtr, &isNew);
- if (isNew) {
- searchPtr->id = 1;
- varPtr->flags |= VAR_SEARCH_ACTIVE;
- searchPtr->nextPtr = NULL;
+ ArrayPopulateSearch(interp, objv[1], varPtr, searchPtr);
+ Tcl_SetObjResult(interp, searchPtr->name);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ArrayDoneSearch --
+ *
+ * Removes the search from the hash of active searches.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ArrayDoneSearch(
+ Interp *iPtr,
+ Var *varPtr,
+ ArraySearch *searchPtr)
+{
+ Tcl_HashEntry *hPtr;
+ ArraySearch *prevPtr;
+
+ /*
+ * Unhook the search from the list of searches associated with the
+ * variable.
+ */
+
+ hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
+ if (hPtr == NULL) {
+ return;
+ }
+ if (searchPtr == Tcl_GetHashValue(hPtr)) {
+ if (searchPtr->nextPtr) {
+ Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
+ } else {
+ varPtr->flags &= ~VAR_SEARCH_ACTIVE;
+ Tcl_DeleteHashEntry(hPtr);
+ }
} else {
- searchPtr->id = ((ArraySearch *) Tcl_GetHashValue(hPtr))->id + 1;
- searchPtr->nextPtr = Tcl_GetHashValue(hPtr);
+ for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
+ if (prevPtr->nextPtr == searchPtr) {
+ prevPtr->nextPtr = searchPtr->nextPtr;
+ break;
+ }
+ }
}
- searchPtr->varPtr = varPtr;
- searchPtr->nextEntry = VarHashFirstEntry(varPtr->value.tablePtr,
- &searchPtr->search);
- Tcl_SetHashValue(hPtr, searchPtr);
- Tcl_SetObjResult(interp,
- Tcl_ObjPrintf("s-%d-%s", searchPtr->id, varName));
- return TCL_OK;
}
/*
@@ -3064,7 +3498,7 @@ ArrayAnyMoreCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *)interp;
+ Interp *iPtr = (Interp *) interp;
Var *varPtr;
Tcl_Obj *varNameObj, *searchObj;
int gotValue, isArray;
@@ -3224,11 +3658,10 @@ ArrayDoneSearchCmd(
int objc,
Tcl_Obj *const objv[])
{
- Interp *iPtr = (Interp *)interp;
+ Interp *iPtr = (Interp *) interp;
Var *varPtr;
- Tcl_HashEntry *hPtr;
Tcl_Obj *varNameObj, *searchObj;
- ArraySearch *searchPtr, *prevPtr;
+ ArraySearch *searchPtr;
int isArray;
if (objc != 3) {
@@ -3255,27 +3688,8 @@ ArrayDoneSearchCmd(
return TCL_ERROR;
}
- /*
- * Unhook the search from the list of searches associated with the
- * variable.
- */
-
- hPtr = Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
- if (searchPtr == Tcl_GetHashValue(hPtr)) {
- if (searchPtr->nextPtr) {
- Tcl_SetHashValue(hPtr, searchPtr->nextPtr);
- } else {
- varPtr->flags &= ~VAR_SEARCH_ACTIVE;
- Tcl_DeleteHashEntry(hPtr);
- }
- } else {
- for (prevPtr=Tcl_GetHashValue(hPtr) ;; prevPtr=prevPtr->nextPtr) {
- if (prevPtr->nextPtr == searchPtr) {
- prevPtr->nextPtr = searchPtr->nextPtr;
- break;
- }
- }
- }
+ ArrayDoneSearch(iPtr, varPtr, searchPtr);
+ Tcl_DecrRefCount(searchPtr->name);
ckfree(searchPtr);
return TCL_OK;
}
@@ -3786,7 +4200,8 @@ ArraySetCmd(
if ((elemVarPtr == NULL) ||
(TclPtrSetVarIdx(interp, elemVarPtr, varPtr, arrayNameObj,
- elemPtrs[i],elemPtrs[i+1],TCL_LEAVE_ERR_MSG,-1) == NULL)){
+ elemPtrs[i], elemPtrs[i+1], TCL_LEAVE_ERR_MSG,
+ -1) == NULL)) {
result = TCL_ERROR;
break;
}
@@ -3820,9 +4235,7 @@ ArraySetCmd(
return TCL_ERROR;
}
}
- TclSetVarArray(varPtr);
- varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
- TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+ TclInitArrayVar(varPtr);
return TCL_OK;
}
@@ -4102,8 +4515,10 @@ TclInitArrayCmd(
{
static const EnsembleImplMap arrayImplMap[] = {
{"anymore", ArrayAnyMoreCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
+ {"default", ArrayDefaultCmd, TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
{"donesearch", ArrayDoneSearchCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
{"exists", ArrayExistsCmd, TclCompileArrayExistsCmd, NULL, NULL, 0},
+ {"for", ArrayForObjCmd, TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
{"get", ArrayGetCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
{"names", ArrayNamesCmd, TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
{"nextelement", ArrayNextElementCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
@@ -4128,7 +4543,7 @@ TclInitArrayCmd(
*
* Results:
* A standard Tcl completion code. If an error occurs then an error
- * message is left in iPtr->result.
+ * message is left in interp.
*
* Side effects:
* The variable given by myName is linked to the variable in framePtr
@@ -4222,7 +4637,7 @@ ObjMakeUpvar(
*
* Results:
* A standard Tcl completion code. If an error occurs then an error
- * message is left in iPtr->result.
+ * message is left in interp.
*
* Side effects:
* The variable given by myName is linked to the variable in framePtr
@@ -4413,6 +4828,7 @@ TclPtrObjMakeUpvarIdx(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef Tcl_UpVar
int
Tcl_UpVar(
@@ -4446,6 +4862,7 @@ Tcl_UpVar(
Tcl_DecrRefCount(localNamePtr);
return result;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -4901,75 +5318,6 @@ Tcl_UpvarObjCmd(
/*
*----------------------------------------------------------------------
*
- * 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(
- Tcl_Interp *interp,
- Tcl_Obj *objPtr)
-{
- const char *string;
- char *end; /* Can't be const due to strtoul defn. */
- int id;
- size_t offset;
-
- /*
- * Get the string representation. Make it up-to-date if necessary.
- */
-
- string = TclGetString(objPtr);
-
- /*
- * Parse the id into the three parts separated by dashes.
- */
-
- if ((string[0] != 's') || (string[1] != '-')) {
- goto syntax;
- }
- 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;
-
- TclFreeIntRep(objPtr);
- objPtr->typePtr = &tclArraySearchType;
- objPtr->internalRep.twoPtrValue.ptr1 = INT2PTR(id);
- objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(offset);
- return TCL_OK;
-
- syntax:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "illegal search identifier \"%s\"", string));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
- return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* ParseSearchId --
*
* This function translates from a tcl object to a pointer to an active
@@ -4980,10 +5328,6 @@ SetArraySearchObj(
* or NULL if there isn't one. If NULL is returned, the interp's result
* contains an error message.
*
- * Side effects:
- * The tcl object might have its internal type and representation
- * modified.
- *
*----------------------------------------------------------------------
*/
@@ -4999,65 +5343,43 @@ ParseSearchId(
* name. */
{
Interp *iPtr = (Interp *) interp;
- register const char *string;
- register size_t offset;
- int id;
ArraySearch *searchPtr;
- const char *varName = TclGetString(varNamePtr);
-
- /*
- * Parse the id.
- */
-
- if ((handleObj->typePtr != &tclArraySearchType)
- && (SetArraySearchObj(interp, handleObj) != TCL_OK)) {
- return NULL;
- }
-
- /*
- * Extract the information out of the Tcl_Obj.
- */
-
- id = PTR2INT(handleObj->internalRep.twoPtrValue.ptr1);
- string = TclGetString(handleObj);
- offset = PTR2INT(handleObj->internalRep.twoPtrValue.ptr2);
-
- /*
- * 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_SetObjResult(interp, Tcl_ObjPrintf(
- "search identifier \"%s\" isn't for variable \"%s\"",
- string, varName));
- goto badLookup;
- }
-
- /*
- * 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.
- */
+ const char *handle = TclGetString(handleObj);
+ char *end;
if (varPtr->flags & VAR_SEARCH_ACTIVE) {
Tcl_HashEntry *hPtr =
Tcl_FindHashEntry(&iPtr->varSearches, varPtr);
+ /* First look for same (Tcl_Obj *) */
for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
searchPtr = searchPtr->nextPtr) {
- if (searchPtr->id == id) {
+ if (searchPtr->name == handleObj) {
return searchPtr;
}
}
+ /* Fallback: do string compares. */
+ for (searchPtr = Tcl_GetHashValue(hPtr); searchPtr != NULL;
+ searchPtr = searchPtr->nextPtr) {
+ if (strcmp(TclGetString(searchPtr->name), handle) == 0) {
+ return searchPtr;
+ }
+ }
+ }
+ if ((handle[0] != 's') || (handle[1] != '-')
+ || (strtoul(handle + 2, &end, 10), end == (handle + 2))
+ || (*end != '-')) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "illegal search identifier \"%s\"", handle));
+ } else if (strcmp(end + 1, TclGetString(varNamePtr)) != 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "search identifier \"%s\" isn't for variable \"%s\"",
+ handle, TclGetString(varNamePtr)));
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't find search \"%s\"", handle));
}
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "couldn't find search \"%s\"", string));
- badLookup:
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", string, NULL);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "ARRAYSEARCH", handle, NULL);
return NULL;
}
@@ -5092,6 +5414,7 @@ DeleteSearches(
for (searchPtr = Tcl_GetHashValue(sPtr); searchPtr != NULL;
searchPtr = nextPtr) {
nextPtr = searchPtr->nextPtr;
+ Tcl_DecrRefCount(searchPtr->name);
ckfree(searchPtr);
}
arrayVarPtr->flags &= ~VAR_SEARCH_ACTIVE;
@@ -5383,8 +5706,7 @@ DeleteArray(
TclClearVarNamespaceVar(elPtr);
}
- VarHashDeleteTable(varPtr->value.tablePtr);
- ckfree(varPtr->value.tablePtr);
+ DeleteArrayVar(varPtr);
}
/*
@@ -5462,28 +5784,6 @@ TclObjVarErrMsg(
*/
/*
- * Panic functions that should never be called in normal operation.
- */
-
-static void
-PanicOnUpdateVarName(
- Tcl_Obj *objPtr)
-{
- Tcl_Panic("%s of type %s should not be called", "updateStringProc",
- objPtr->typePtr->name);
-}
-
-static int
-PanicOnSetVarName(
- Tcl_Interp *interp,
- Tcl_Obj *objPtr)
-{
- Tcl_Panic("%s of type %s should not be called", "setFromAnyProc",
- objPtr->typePtr->name);
- return TCL_ERROR;
-}
-
-/*
* localVarName -
*
* INTERNALREP DEFINITION:
@@ -5496,12 +5796,15 @@ static void
FreeLocalVarName(
Tcl_Obj *objPtr)
{
- Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1;
+ int index;
+ Tcl_Obj *namePtr;
+
+ LocalGetIntRep(objPtr, index, namePtr);
+ index++; /* Compiler warning bait. */
if (namePtr) {
Tcl_DecrRefCount(namePtr);
}
- objPtr->typePtr = NULL;
}
static void
@@ -5509,17 +5812,14 @@ DupLocalVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+ int index;
+ Tcl_Obj *namePtr;
+ LocalGetIntRep(srcPtr, index, namePtr);
if (!namePtr) {
namePtr = srcPtr;
}
- dupPtr->internalRep.twoPtrValue.ptr1 = namePtr;
- Tcl_IncrRefCount(namePtr);
-
- dupPtr->internalRep.twoPtrValue.ptr2 =
- srcPtr->internalRep.twoPtrValue.ptr2;
- dupPtr->typePtr = &localVarNameType;
+ LocalSetIntRep(dupPtr, index, namePtr);
}
/*
@@ -5535,14 +5835,16 @@ static void
FreeParsedVarName(
Tcl_Obj *objPtr)
{
- register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
- register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
+ register Tcl_Obj *arrayPtr, *elem;
+ int parsed;
+
+ ParsedGetIntRep(objPtr, parsed, arrayPtr, elem);
+ parsed++; /* Silence compiler. */
if (arrayPtr != NULL) {
TclDecrRefCount(arrayPtr);
- ckfree(elem);
+ TclDecrRefCount(elem);
}
- objPtr->typePtr = NULL;
}
static void
@@ -5550,58 +5852,13 @@ DupParsedVarName(
Tcl_Obj *srcPtr,
Tcl_Obj *dupPtr)
{
- register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
- char *elemCopy;
- unsigned 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 = arrayPtr;
- dupPtr->internalRep.twoPtrValue.ptr2 = elem;
- dupPtr->typePtr = &tclParsedVarNameType;
-}
-
-static void
-UpdateParsedVarName(
- Tcl_Obj *objPtr)
-{
- Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
- char *part2 = objPtr->internalRep.twoPtrValue.ptr2;
- const char *part1;
- char *p;
- int len1, len2, totalLen;
-
- if (arrayPtr == NULL) {
- /*
- * This is a parsed scalar name: what is it doing here?
- */
-
- Tcl_Panic("scalar parsedVarName without a string rep");
- }
-
- part1 = TclGetStringFromObj(arrayPtr, &len1);
- len2 = strlen(part2);
+ register Tcl_Obj *arrayPtr, *elem;
+ int parsed;
- totalLen = len1 + len2 + 2;
- p = ckalloc(totalLen + 1);
- objPtr->bytes = p;
- objPtr->length = totalLen;
+ ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem);
- memcpy(p, part1, (unsigned) len1);
- p += len1;
- *p++ = '(';
- memcpy(p, part2, (unsigned) len2);
- p += len2;
- *p++ = ')';
- *p = '\0';
+ parsed++; /* Silence compiler. */
+ ParsedSetIntRep(dupPtr, arrayPtr, elem);
}
/*
@@ -5930,7 +6187,7 @@ TclInfoVarsCmd(
*/
if ((nsPtr != globalNsPtr) && !specificNsInPattern) {
- varPtr = VarHashFirstVar(&globalNsPtr->varTable,&search);
+ varPtr = VarHashFirstVar(&globalNsPtr->varTable, &search);
while (varPtr) {
if (!TclIsVarUndefined(varPtr)
|| TclIsVarNamespaceVar(varPtr)) {
@@ -6226,25 +6483,50 @@ AppendLocals(
}
if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
- CallContext *contextPtr = iPtr->varFramePtr->clientData;
- Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;
+ Method *mPtr = (Method *)
+ Tcl_ObjectContextMethod(iPtr->varFramePtr->clientData);
+ PrivateVariableMapping *privatePtr;
if (mPtr->declaringObjectPtr) {
- FOREACH(objNamePtr, mPtr->declaringObjectPtr->variables) {
+ Object *oPtr = mPtr->declaringObjectPtr;
+
+ FOREACH(objNamePtr, oPtr->variables) {
Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
if (added && (!pattern ||
Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
}
}
+ FOREACH_STRUCT(privatePtr, oPtr->privateVariables) {
+ Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
+ &added);
+ if (added && (!pattern ||
+ Tcl_StringMatch(TclGetString(privatePtr->variableObj),
+ pattern))) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ privatePtr->variableObj);
+ }
+ }
} else {
- FOREACH(objNamePtr, mPtr->declaringClassPtr->variables) {
+ Class *clsPtr = mPtr->declaringClassPtr;
+
+ FOREACH(objNamePtr, clsPtr->variables) {
Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
if (added && (!pattern ||
Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
}
}
+ FOREACH_STRUCT(privatePtr, clsPtr->privateVariables) {
+ Tcl_CreateHashEntry(&addedTable, privatePtr->variableObj,
+ &added);
+ if (added && (!pattern ||
+ Tcl_StringMatch(TclGetString(privatePtr->variableObj),
+ pattern))) {
+ Tcl_ListObjAppendElement(interp, listPtr,
+ privatePtr->variableObj);
+ }
+ }
}
}
Tcl_DeleteHashTable(&addedTable);
@@ -6317,9 +6599,9 @@ CompareVarKeys(
/*
* If the object pointers are the same then they match.
* OPT: this comparison was moved to the caller
-
- if (objPtr1 == objPtr2) return 1;
- */
+ *
+ * if (objPtr1 == objPtr2) return 1;
+ */
/*
* Don't use Tcl_GetStringFromObj as it would prevent l1 and l2 being in a
@@ -6338,6 +6620,264 @@ CompareVarKeys(
return ((l1 == l2) && !memcmp(p1, p2, l1));
}
+/*----------------------------------------------------------------------
+ *
+ * ArrayDefaultCmd --
+ *
+ * This function implements the 'array default' Tcl command.
+ * Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ * Returns a standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArrayDefaultCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ static const char *const options[] = {
+ "get", "set", "exists", "unset", NULL
+ };
+ enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
+ Tcl_Obj *arrayNameObj, *defaultValueObj;
+ Var *varPtr, *arrayPtr;
+ int isArray, option;
+
+ /*
+ * Parse arguments.
+ */
+
+ if (objc != 3 && objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
+ 0, &option) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ arrayNameObj = objv[2];
+
+ if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
+ return TCL_ERROR;
+ }
+
+ switch (option) {
+ case OPT_GET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+ return TCL_ERROR;
+ }
+ if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
+ return NotArrayError(interp, arrayNameObj);
+ }
+
+ defaultValueObj = TclGetArrayDefault(varPtr);
+ if (!defaultValueObj) {
+ /* Array default must exist. */
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "array has no default value", -1));
+ Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, defaultValueObj);
+ return TCL_OK;
+
+ case OPT_SET:
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Attempt to create array if needed.
+ */
+ varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
+ /*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
+ /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ if (varPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (arrayPtr) {
+ /*
+ * Not a valid array name.
+ */
+
+ CleanupVar(varPtr, arrayPtr);
+ TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
+ needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+ TclGetString(arrayNameObj), NULL);
+ return TCL_ERROR;
+ }
+ if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+ /*
+ * Not an array.
+ */
+
+ TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
+ needArray, -1);
+ Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+ return TCL_ERROR;
+ }
+
+ if (!TclIsVarArray(varPtr)) {
+ TclInitArrayVar(varPtr);
+ }
+ defaultValueObj = objv[3];
+ SetArrayDefault(varPtr, defaultValueObj);
+ return TCL_OK;
+
+ case OPT_EXISTS:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Undefined variables (whether or not they have storage allocated) do
+ * not have defaults, and this is not an error case.
+ */
+
+ if (!varPtr || TclIsVarUndefined(varPtr)) {
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+ } else if (!isArray) {
+ return NotArrayError(interp, arrayNameObj);
+ } else {
+ defaultValueObj = TclGetArrayDefault(varPtr);
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
+ }
+ return TCL_OK;
+
+ case OPT_UNSET:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+ return TCL_ERROR;
+ }
+
+ if (varPtr && !TclIsVarUndefined(varPtr)) {
+ if (!isArray) {
+ return NotArrayError(interp, arrayNameObj);
+ }
+ SetArrayDefault(varPtr, NULL);
+ }
+ return TCL_OK;
+ }
+
+ /* Unreached */
+ return TCL_ERROR;
+}
+
+/*
+ * Initialize array variable.
+ */
+
+void
+TclInitArrayVar(
+ Var *arrayPtr)
+{
+ ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable));
+
+ /*
+ * Mark the variable as an array.
+ */
+
+ TclSetVarArray(arrayPtr);
+
+ /*
+ * Regular TclVarHashTable initialization.
+ */
+
+ arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
+ TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));
+
+ /*
+ * Default value initialization.
+ */
+
+ tablePtr->defaultObj = NULL;
+}
+
+/*
+ * Cleanup array variable.
+ */
+
+static void
+DeleteArrayVar(
+ Var *arrayPtr)
+{
+ ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+ arrayPtr->value.tablePtr;
+
+ /*
+ * Default value cleanup.
+ */
+
+ SetArrayDefault(arrayPtr, NULL);
+
+ /*
+ * Regular TclVarHashTable cleanup.
+ */
+
+ VarHashDeleteTable(arrayPtr->value.tablePtr);
+ ckfree(tablePtr);
+}
+
+/*
+ * Get array default value if any.
+ */
+
+Tcl_Obj *
+TclGetArrayDefault(
+ Var *arrayPtr)
+{
+ ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+ arrayPtr->value.tablePtr;
+
+ return tablePtr->defaultObj;
+}
+
+/*
+ * Set/replace/unset array default value.
+ */
+
+static void
+SetArrayDefault(
+ Var *arrayPtr,
+ Tcl_Obj *defaultObj)
+{
+ ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+ arrayPtr->value.tablePtr;
+
+ /*
+ * Increment/decrement refcount twice to ensure that the object is shared,
+ * so that it doesn't get modified accidentally by the folling code:
+ *
+ * array default set v 1
+ * lappend v(a) 2; # returns a new object {1 2}
+ * set v(b); # returns the original default object "1"
+ */
+
+ if (tablePtr->defaultObj) {
+ Tcl_DecrRefCount(tablePtr->defaultObj);
+ Tcl_DecrRefCount(tablePtr->defaultObj);
+ }
+ tablePtr->defaultObj = defaultObj;
+ if (tablePtr->defaultObj) {
+ Tcl_IncrRefCount(tablePtr->defaultObj);
+ Tcl_IncrRefCount(tablePtr->defaultObj);
+ }
+}
+
/*
* Local Variables:
* mode: c
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
new file mode 100644
index 0000000..d02a2da
--- /dev/null
+++ b/generic/tclZipfs.c
@@ -0,0 +1,5041 @@
+/*
+ * tclZipfs.c --
+ *
+ * Implementation of the ZIP filesystem used in TIP 430
+ * Adapted from the implentation for AndroWish.
+ *
+ * Copyright (c) 2016-2017 Sean Woods <yoda@etoyoc.com>
+ * Copyright (c) 2013-2015 Christian Werner <chw@ch-werner.de>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This file is distributed in two ways:
+ * generic/tclZipfs.c file in the TIP430-enabled Tcl cores.
+ * compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430
+ * projects.
+ */
+
+#include "tclInt.h"
+#include "tclFileSystem.h"
+
+#ifndef _WIN32
+#include <sys/mman.h>
+#endif /* _WIN32*/
+
+#ifndef MAP_FILE
+#define MAP_FILE 0
+#endif /* !MAP_FILE */
+
+#ifdef HAVE_ZLIB
+#include "zlib.h"
+#include "crypt.h"
+
+#ifdef CFG_RUNTIME_DLLFILE
+
+/*
+** We are compiling as part of the core.
+** TIP430 style zipfs prefix
+*/
+
+#define ZIPFS_VOLUME "//zipfs:/"
+#define ZIPFS_VOLUME_LEN 9
+#define ZIPFS_APP_MOUNT "//zipfs:/app"
+#define ZIPFS_ZIP_MOUNT "//zipfs:/lib/tcl"
+
+#else /* !CFG_RUNTIME_DLLFILE */
+
+/*
+** We are compiling from the /compat folder of tclconfig
+** Pre TIP430 style zipfs prefix
+** //zipfs:/ doesn't work straight out of the box on either windows or Unix
+** without other changes made to tip 430
+*/
+
+#define ZIPFS_VOLUME "zipfs:/"
+#define ZIPFS_VOLUME_LEN 7
+#define ZIPFS_APP_MOUNT "zipfs:/app"
+#define ZIPFS_ZIP_MOUNT "zipfs:/lib/tcl"
+
+#endif /* CFG_RUNTIME_DLLFILE */
+
+/*
+ * Various constants and offsets found in ZIP archive files
+ */
+
+#define ZIP_SIG_LEN 4
+
+/*
+ * Local header of ZIP archive member (at very beginning of each member).
+ */
+
+#define ZIP_LOCAL_HEADER_SIG 0x04034b50
+#define ZIP_LOCAL_HEADER_LEN 30
+#define ZIP_LOCAL_SIG_OFFS 0
+#define ZIP_LOCAL_VERSION_OFFS 4
+#define ZIP_LOCAL_FLAGS_OFFS 6
+#define ZIP_LOCAL_COMPMETH_OFFS 8
+#define ZIP_LOCAL_MTIME_OFFS 10
+#define ZIP_LOCAL_MDATE_OFFS 12
+#define ZIP_LOCAL_CRC32_OFFS 14
+#define ZIP_LOCAL_COMPLEN_OFFS 18
+#define ZIP_LOCAL_UNCOMPLEN_OFFS 22
+#define ZIP_LOCAL_PATHLEN_OFFS 26
+#define ZIP_LOCAL_EXTRALEN_OFFS 28
+
+/*
+ * Central header of ZIP archive member at end of ZIP file.
+ */
+
+#define ZIP_CENTRAL_HEADER_SIG 0x02014b50
+#define ZIP_CENTRAL_HEADER_LEN 46
+#define ZIP_CENTRAL_SIG_OFFS 0
+#define ZIP_CENTRAL_VERSIONMADE_OFFS 4
+#define ZIP_CENTRAL_VERSION_OFFS 6
+#define ZIP_CENTRAL_FLAGS_OFFS 8
+#define ZIP_CENTRAL_COMPMETH_OFFS 10
+#define ZIP_CENTRAL_MTIME_OFFS 12
+#define ZIP_CENTRAL_MDATE_OFFS 14
+#define ZIP_CENTRAL_CRC32_OFFS 16
+#define ZIP_CENTRAL_COMPLEN_OFFS 20
+#define ZIP_CENTRAL_UNCOMPLEN_OFFS 24
+#define ZIP_CENTRAL_PATHLEN_OFFS 28
+#define ZIP_CENTRAL_EXTRALEN_OFFS 30
+#define ZIP_CENTRAL_FCOMMENTLEN_OFFS 32
+#define ZIP_CENTRAL_DISKFILE_OFFS 34
+#define ZIP_CENTRAL_IATTR_OFFS 36
+#define ZIP_CENTRAL_EATTR_OFFS 38
+#define ZIP_CENTRAL_LOCALHDR_OFFS 42
+
+/*
+ * Central end signature at very end of ZIP file.
+ */
+
+#define ZIP_CENTRAL_END_SIG 0x06054b50
+#define ZIP_CENTRAL_END_LEN 22
+#define ZIP_CENTRAL_END_SIG_OFFS 0
+#define ZIP_CENTRAL_DISKNO_OFFS 4
+#define ZIP_CENTRAL_DISKDIR_OFFS 6
+#define ZIP_CENTRAL_ENTS_OFFS 8
+#define ZIP_CENTRAL_TOTALENTS_OFFS 10
+#define ZIP_CENTRAL_DIRSIZE_OFFS 12
+#define ZIP_CENTRAL_DIRSTART_OFFS 16
+#define ZIP_CENTRAL_COMMENTLEN_OFFS 20
+
+#define ZIP_MIN_VERSION 20
+#define ZIP_COMPMETH_STORED 0
+#define ZIP_COMPMETH_DEFLATED 8
+
+#define ZIP_PASSWORD_END_SIG 0x5a5a4b50
+
+#define DEFAULT_WRITE_MAX_SIZE (2 * 1024 * 1024)
+
+/*
+ * Macros to report errors only if an interp is present.
+ */
+
+#define ZIPFS_ERROR(interp,errstr) \
+ do { \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1)); \
+ } \
+ } while (0)
+#define ZIPFS_POSIX_ERROR(interp,errstr) \
+ do { \
+ if (interp) { \
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf( \
+ "%s: %s", errstr, Tcl_PosixError(interp))); \
+ } \
+ } while (0)
+
+/*
+ * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
+ */
+
+#define ZipReadInt(p) \
+ ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
+#define ZipReadShort(p) \
+ ((p)[0] | ((p)[1] << 8))
+
+#define ZipWriteInt(p, v) \
+ do { \
+ (p)[0] = (v) & 0xff; \
+ (p)[1] = ((v) >> 8) & 0xff; \
+ (p)[2] = ((v) >> 16) & 0xff; \
+ (p)[3] = ((v) >> 24) & 0xff; \
+ } while (0)
+#define ZipWriteShort(p, v) \
+ do { \
+ (p)[0] = (v) & 0xff; \
+ (p)[1] = ((v) >> 8) & 0xff; \
+ } while (0)
+
+/*
+ * Windows drive letters.
+ */
+
+#ifdef _WIN32
+static const char drvletters[] =
+ "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
+#endif /* _WIN32 */
+
+/*
+ * Mutex to protect localtime(3) when no reentrant version available.
+ */
+
+#if !defined(_WIN32) && !defined(HAVE_LOCALTIME_R) && TCL_THREADS
+TCL_DECLARE_MUTEX(localtimeMutex)
+#endif /* !_WIN32 && !HAVE_LOCALTIME_R && TCL_THREADS */
+
+/*
+ * In-core description of mounted ZIP archive file.
+ */
+
+typedef struct ZipFile {
+ char *name; /* Archive name */
+ size_t nameLength; /* Length of archive name */
+ char isMemBuffer; /* When true, not a file but a memory buffer */
+ Tcl_Channel chan; /* Channel handle or NULL */
+ unsigned char *data; /* Memory mapped or malloc'ed file */
+ size_t length; /* Length of memory mapped file */
+ void *ptrToFree; /* Non-NULL if malloc'ed file */
+ size_t numFiles; /* Number of files in archive */
+ size_t baseOffset; /* Archive start */
+ size_t passOffset; /* Password start */
+ size_t directoryOffset; /* Archive directory start */
+ unsigned char passBuf[264]; /* Password buffer */
+ size_t numOpen; /* Number of open files on archive */
+ struct ZipEntry *entries; /* List of files in archive */
+ struct ZipEntry *topEnts; /* List of top-level dirs in archive */
+ char *mountPoint; /* Mount point name */
+ size_t mountPointLen; /* Length of mount point name */
+#ifdef _WIN32
+ HANDLE mountHandle; /* Handle used for direct file access. */
+#endif /* _WIN32 */
+} ZipFile;
+
+/*
+ * In-core description of file contained in mounted ZIP archive.
+ */
+
+typedef struct ZipEntry {
+ char *name; /* The full pathname of the virtual file */
+ ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */
+ Tcl_WideInt offset; /* Data offset into memory mapped ZIP file */
+ int numBytes; /* Uncompressed size of the virtual file */
+ int numCompressedBytes; /* Compressed size of the virtual file */
+ int compressMethod; /* Compress method */
+ int isDirectory; /* Set to 1 if directory, or -1 if root */
+ int depth; /* Number of slashes in path. */
+ int crc32; /* CRC-32 */
+ int timestamp; /* Modification time */
+ int isEncrypted; /* True if data is encrypted */
+ unsigned char *data; /* File data if written */
+ struct ZipEntry *next; /* Next file in the same archive */
+ struct ZipEntry *tnext; /* Next top-level dir in archive */
+} ZipEntry;
+
+/*
+ * File channel for file contained in mounted ZIP archive.
+ */
+
+typedef struct ZipChannel {
+ ZipFile *zipFilePtr; /* The ZIP file holding this channel */
+ ZipEntry *zipEntryPtr; /* Pointer back to virtual file */
+ size_t maxWrite; /* Maximum size for write */
+ size_t numBytes; /* Number of bytes of uncompressed data */
+ size_t numRead; /* Position of next byte to be read from the
+ * channel */
+ unsigned char *ubuf; /* Pointer to the uncompressed data */
+ int iscompr; /* True if data is compressed */
+ int isDirectory; /* Set to 1 if directory, or -1 if root */
+ int isEncrypted; /* True if data is encrypted */
+ int isWriting; /* True if open for writing */
+ unsigned long keys[3]; /* Key for decryption */
+} ZipChannel;
+
+/*
+ * Global variables.
+ *
+ * Most are kept in single ZipFS struct. When build with threading support
+ * this struct is protected by the ZipFSMutex (see below).
+ *
+ * The "fileHash" component is the process wide global table of all known ZIP
+ * archive members in all mounted ZIP archives.
+ *
+ * The "zipHash" components is the process wide global table of all mounted
+ * ZIP archive files.
+ */
+
+static struct {
+ int initialized; /* True when initialized */
+ int lock; /* RW lock, see below */
+ int waiters; /* RW lock, see below */
+ int wrmax; /* Maximum write size of a file */
+ int idCount; /* Counter for channel names */
+ Tcl_HashTable fileHash; /* File name to ZipEntry mapping */
+ Tcl_HashTable zipHash; /* Mount to ZipFile mapping */
+} ZipFS = {
+ 0, 0, 0, DEFAULT_WRITE_MAX_SIZE, 0,
+};
+
+/*
+ * For password rotation.
+ */
+
+static const char pwrot[16] = {
+ 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
+ 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0
+};
+
+/*
+ * Table to compute CRC32.
+ */
+#ifdef Z_U4
+ typedef Z_U4 z_crc_t;
+#else
+ typedef unsigned long z_crc_t;
+#endif
+
+static const z_crc_t crc32tab[256] = {
+ 0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
+ 0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
+ 0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
+ 0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
+ 0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
+ 0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
+ 0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
+ 0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
+ 0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
+ 0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
+ 0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
+ 0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
+ 0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
+ 0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
+ 0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
+ 0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
+ 0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
+ 0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
+ 0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
+ 0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
+ 0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
+ 0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
+ 0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
+ 0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
+ 0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
+ 0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
+ 0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
+ 0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
+ 0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
+ 0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
+ 0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
+ 0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
+ 0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
+ 0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
+ 0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
+ 0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
+ 0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
+ 0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
+ 0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
+ 0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
+ 0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
+ 0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
+ 0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
+ 0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
+ 0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
+ 0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
+ 0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
+ 0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
+ 0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
+ 0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
+ 0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
+ 0x2d02ef8d,
+};
+
+static const char *zipfs_literal_tcl_library = NULL;
+
+/* Function prototypes */
+
+static inline int DescribeMounted(Tcl_Interp *interp,
+ const char *mountPoint);
+static inline int ListMountPoints(Tcl_Interp *interp);
+static int ZipfsAppHookFindTclInit(const char *archive);
+static int ZipFSPathInFilesystemProc(Tcl_Obj *pathPtr,
+ void **clientDataPtr);
+static Tcl_Obj * ZipFSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
+static Tcl_Obj * ZipFSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
+static int ZipFSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+static int ZipFSAccessProc(Tcl_Obj *pathPtr, int mode);
+static Tcl_Channel ZipFSOpenFileChannelProc(Tcl_Interp *interp,
+ Tcl_Obj *pathPtr, int mode, int permissions);
+static int ZipFSMatchInDirectoryProc(Tcl_Interp *interp,
+ Tcl_Obj *result, Tcl_Obj *pathPtr,
+ const char *pattern, Tcl_GlobTypeData *types);
+static Tcl_Obj * ZipFSListVolumesProc(void);
+static const char *const *ZipFSFileAttrStringsProc(Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef);
+static int ZipFSFileAttrsGetProc(Tcl_Interp *interp, int index,
+ Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef);
+static int ZipFSFileAttrsSetProc(Tcl_Interp *interp, int index,
+ Tcl_Obj *pathPtr, Tcl_Obj *objPtr);
+static int ZipFSLoadFile(Tcl_Interp *interp, Tcl_Obj *path,
+ Tcl_LoadHandle *loadHandle,
+ Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
+static void ZipfsSetup(void);
+static int ZipChannelClose(void *instanceData,
+ Tcl_Interp *interp);
+static int ZipChannelGetFile(void *instanceData,
+ int direction, void **handlePtr);
+static int ZipChannelRead(void *instanceData, char *buf,
+ int toRead, int *errloc);
+static int ZipChannelSeek(void *instanceData, long offset,
+ int mode, int *errloc);
+static void ZipChannelWatchChannel(void *instanceData,
+ int mask);
+static int ZipChannelWrite(void *instanceData,
+ const char *buf, int toWrite, int *errloc);
+
+/*
+ * Define the ZIP filesystem dispatch table.
+ */
+
+MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem;
+
+const Tcl_Filesystem zipfsFilesystem = {
+ "zipfs",
+ sizeof(Tcl_Filesystem),
+ TCL_FILESYSTEM_VERSION_2,
+ ZipFSPathInFilesystemProc,
+ NULL, /* dupInternalRepProc */
+ NULL, /* freeInternalRepProc */
+ NULL, /* internalToNormalizedProc */
+ NULL, /* createInternalRepProc */
+ NULL, /* normalizePathProc */
+ ZipFSFilesystemPathTypeProc,
+ ZipFSFilesystemSeparatorProc,
+ ZipFSStatProc,
+ ZipFSAccessProc,
+ ZipFSOpenFileChannelProc,
+ ZipFSMatchInDirectoryProc,
+ NULL, /* utimeProc */
+ NULL, /* linkProc */
+ ZipFSListVolumesProc,
+ ZipFSFileAttrStringsProc,
+ ZipFSFileAttrsGetProc,
+ ZipFSFileAttrsSetProc,
+ NULL, /* createDirectoryProc */
+ NULL, /* removeDirectoryProc */
+ NULL, /* deleteFileProc */
+ NULL, /* copyFileProc */
+ NULL, /* renameFileProc */
+ NULL, /* copyDirectoryProc */
+ NULL, /* lstatProc */
+ (Tcl_FSLoadFileProc *) ZipFSLoadFile,
+ NULL, /* getCwdProc */
+ NULL, /* chdirProc */
+};
+
+/*
+ * The channel type/driver definition used for ZIP archive members.
+ */
+
+static Tcl_ChannelType ZipChannelType = {
+ "zip", /* Type name. */
+ TCL_CHANNEL_VERSION_5,
+ ZipChannelClose, /* Close channel, clean instance data */
+ ZipChannelRead, /* Handle read request */
+ ZipChannelWrite, /* Handle write request */
+ ZipChannelSeek, /* Move location of access point, NULL'able */
+ NULL, /* Set options, NULL'able */
+ NULL, /* Get options, NULL'able */
+ ZipChannelWatchChannel, /* Initialize notifier */
+ ZipChannelGetFile, /* Get OS handle from the channel */
+ NULL, /* 2nd version of close channel, NULL'able */
+ NULL, /* Set blocking mode for raw channel, NULL'able */
+ NULL, /* Function to flush channel, NULL'able */
+ NULL, /* Function to handle event, NULL'able */
+ NULL, /* Wide seek function, NULL'able */
+ NULL, /* Thread action function, NULL'able */
+ NULL, /* Truncate function, NULL'able */
+};
+
+/*
+ * Miscellaneous constants.
+ */
+
+#define ERROR_LENGTH ((size_t) -1)
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReadLock, WriteLock, Unlock --
+ *
+ * POSIX like rwlock functions to support multiple readers and single
+ * writer on internal structs.
+ *
+ * Limitations:
+ * - a read lock cannot be promoted to a write lock
+ * - a write lock may not be nested
+ *
+ *-------------------------------------------------------------------------
+ */
+
+TCL_DECLARE_MUTEX(ZipFSMutex)
+
+#if TCL_THREADS
+
+static Tcl_Condition ZipFSCond;
+
+static void
+ReadLock(void)
+{
+ Tcl_MutexLock(&ZipFSMutex);
+ while (ZipFS.lock < 0) {
+ ZipFS.waiters++;
+ Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
+ ZipFS.waiters--;
+ }
+ ZipFS.lock++;
+ Tcl_MutexUnlock(&ZipFSMutex);
+}
+
+static void
+WriteLock(void)
+{
+ Tcl_MutexLock(&ZipFSMutex);
+ while (ZipFS.lock != 0) {
+ ZipFS.waiters++;
+ Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
+ ZipFS.waiters--;
+ }
+ ZipFS.lock = -1;
+ Tcl_MutexUnlock(&ZipFSMutex);
+}
+
+static void
+Unlock(void)
+{
+ Tcl_MutexLock(&ZipFSMutex);
+ if (ZipFS.lock > 0) {
+ --ZipFS.lock;
+ } else if (ZipFS.lock < 0) {
+ ZipFS.lock = 0;
+ }
+ if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) {
+ Tcl_ConditionNotify(&ZipFSCond);
+ }
+ Tcl_MutexUnlock(&ZipFSMutex);
+}
+
+#else /* !TCL_THREADS */
+#define ReadLock() do {} while (0)
+#define WriteLock() do {} while (0)
+#define Unlock() do {} while (0)
+#endif /* TCL_THREADS */
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * DosTimeDate, ToDosTime, ToDosDate --
+ *
+ * Functions to perform conversions between DOS time stamps and POSIX
+ * time_t.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static time_t
+DosTimeDate(
+ int dosDate,
+ int dosTime)
+{
+ struct tm tm;
+ time_t ret;
+
+ memset(&tm, 0, sizeof(tm));
+ tm.tm_isdst = -1; /* let mktime() deal with DST */
+ tm.tm_year = ((dosDate & 0xfe00) >> 9) + 80;
+ tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1;
+ tm.tm_mday = dosDate & 0x1f;
+ tm.tm_hour = (dosTime & 0xf800) >> 11;
+ tm.tm_min = (dosTime & 0x7e0) >> 5;
+ tm.tm_sec = (dosTime & 0x1f) << 1;
+ ret = mktime(&tm);
+ if (ret == (time_t) -1) {
+ /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */
+ ret = (time_t) 315532800;
+ }
+ return ret;
+}
+
+static int
+ToDosTime(
+ time_t when)
+{
+ struct tm *tmp, tm;
+
+#if !TCL_THREADS || defined(_WIN32)
+ /* Not threaded, or on Win32 which uses thread local storage */
+ tmp = localtime(&when);
+ tm = *tmp;
+#elif defined(HAVE_LOCALTIME_R)
+ /* Threaded, have reentrant API */
+ tmp = &tm;
+ localtime_r(&when, tmp);
+#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
+ /* Only using a mutex is safe. */
+ Tcl_MutexLock(&localtimeMutex);
+ tmp = localtime(&when);
+ tm = *tmp;
+ Tcl_MutexUnlock(&localtimeMutex);
+#endif
+ return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1);
+}
+
+static int
+ToDosDate(
+ time_t when)
+{
+ struct tm *tmp, tm;
+
+#if !TCL_THREADS || defined(_WIN32)
+ /* Not threaded, or on Win32 which uses thread local storage */
+ tmp = localtime(&when);
+ tm = *tmp;
+#elif /* TCL_THREADS && !_WIN32 && */ defined(HAVE_LOCALTIME_R)
+ /* Threaded, have reentrant API */
+ tmp = &tm;
+ localtime_r(&when, tmp);
+#else /* TCL_THREADS && !_WIN32 && !HAVE_LOCALTIME_R */
+ /* Only using a mutex is safe. */
+ Tcl_MutexLock(&localtimeMutex);
+ tmp = localtime(&when);
+ tm = *tmp;
+ Tcl_MutexUnlock(&localtimeMutex);
+#endif
+ return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CountSlashes --
+ *
+ * This function counts the number of slashes in a pathname string.
+ *
+ * Results:
+ * Number of slashes found in string.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+CountSlashes(
+ const char *string)
+{
+ int count = 0;
+ const char *p = string;
+
+ while (*p != '\0') {
+ if (*p == '/') {
+ count++;
+ }
+ p++;
+ }
+ return count;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanonicalPath --
+ *
+ * This function computes the canonical path from a directory and file
+ * name components into the specified Tcl_DString.
+ *
+ * Results:
+ * Returns the pointer to the canonical path contained in the specified
+ * Tcl_DString.
+ *
+ * Side effects:
+ * Modifies the specified Tcl_DString.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static char *
+CanonicalPath(
+ const char *root,
+ const char *tail,
+ Tcl_DString *dsPtr,
+ int inZipfs)
+{
+ char *path;
+ int i, j, c, isUNC = 0, isVfs = 0, n = 0;
+ int haveZipfsPath = 1;
+
+#ifdef _WIN32
+ if (tail[0] != '\0' && strchr(drvletters, tail[0]) && tail[1] == ':') {
+ tail += 2;
+ haveZipfsPath = 0;
+ }
+ /* UNC style path */
+ if (tail[0] == '\\') {
+ root = "";
+ ++tail;
+ haveZipfsPath = 0;
+ }
+ if (tail[0] == '\\') {
+ root = "/";
+ ++tail;
+ haveZipfsPath = 0;
+ }
+#endif /* _WIN32 */
+
+ if (haveZipfsPath) {
+ /* UNC style path */
+ if (root && strncmp(root, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
+ isVfs = 1;
+ } else if (tail &&
+ strncmp(tail, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) == 0) {
+ isVfs = 2;
+ }
+ if (isVfs != 1 && (root[0] == '/') && (root[1] == '/')) {
+ isUNC = 1;
+ }
+ }
+
+ if (isVfs != 2) {
+ if (tail[0] == '/') {
+ if (isVfs != 1) {
+ root = "";
+ }
+ ++tail;
+ isUNC = 0;
+ }
+ if (tail[0] == '/') {
+ if (isVfs != 1) {
+ root = "/";
+ }
+ ++tail;
+ isUNC = 1;
+ }
+ }
+ i = strlen(root);
+ j = strlen(tail);
+
+ switch (isVfs) {
+ case 1:
+ if (i > ZIPFS_VOLUME_LEN) {
+ Tcl_DStringSetLength(dsPtr, i + j + 1);
+ path = Tcl_DStringValue(dsPtr);
+ memcpy(path, root, i);
+ path[i++] = '/';
+ memcpy(path + i, tail, j);
+ } else {
+ Tcl_DStringSetLength(dsPtr, i + j);
+ path = Tcl_DStringValue(dsPtr);
+ memcpy(path, root, i);
+ memcpy(path + i, tail, j);
+ }
+ break;
+ case 2:
+ Tcl_DStringSetLength(dsPtr, j);
+ path = Tcl_DStringValue(dsPtr);
+ memcpy(path, tail, j);
+ break;
+ default:
+ if (inZipfs) {
+ Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN);
+ path = Tcl_DStringValue(dsPtr);
+ memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN);
+ memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j);
+ } else {
+ Tcl_DStringSetLength(dsPtr, i + j + 1);
+ path = Tcl_DStringValue(dsPtr);
+ memcpy(path, root, i);
+ path[i++] = '/';
+ memcpy(path + i, tail, j);
+ }
+ break;
+ }
+
+#ifdef _WIN32
+ for (i = 0; path[i] != '\0'; i++) {
+ if (path[i] == '\\') {
+ path[i] = '/';
+ }
+ }
+#endif /* _WIN32 */
+
+ if (inZipfs) {
+ n = ZIPFS_VOLUME_LEN;
+ } else {
+ n = 0;
+ }
+
+ for (i = j = n; (c = path[i]) != '\0'; i++) {
+ if (c == '/') {
+ int c2 = path[i + 1];
+
+ if (c2 == '\0' || c2 == '/') {
+ continue;
+ }
+ if (c2 == '.') {
+ int c3 = path[i + 2];
+
+ if ((c3 == '/') || (c3 == '\0')) {
+ i++;
+ continue;
+ }
+ if ((c3 == '.')
+ && ((path[i + 3] == '/') || (path[i + 3] == '\0'))) {
+ i += 2;
+ while ((j > 0) && (path[j - 1] != '/')) {
+ j--;
+ }
+ if (j > isUNC) {
+ --j;
+ while ((j > 1 + isUNC) && (path[j - 2] == '/')) {
+ j--;
+ }
+ }
+ continue;
+ }
+ }
+ }
+ path[j++] = c;
+ }
+ if (j == 0) {
+ path[j++] = '/';
+ }
+ path[j] = 0;
+ Tcl_DStringSetLength(dsPtr, j);
+ return Tcl_DStringValue(dsPtr);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSLookup --
+ *
+ * This function returns the ZIP entry struct corresponding to the ZIP
+ * archive member of the given file name. Caller must hold the right
+ * lock.
+ *
+ * Results:
+ * Returns the pointer to ZIP entry struct or NULL if the the given file
+ * name could not be found in the global list of ZIP archive members.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static ZipEntry *
+ZipFSLookup(
+ char *filename)
+{
+ Tcl_HashEntry *hPtr;
+ ZipEntry *z = NULL;
+
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
+ if (hPtr) {
+ z = Tcl_GetHashValue(hPtr);
+ }
+ return z;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSLookupMount --
+ *
+ * This function returns an indication if the given file name corresponds
+ * to a mounted ZIP archive file.
+ *
+ * Results:
+ * Returns true, if the given file name is a mounted ZIP archive file.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+#ifdef NEVER_USED
+static int
+ZipFSLookupMount(
+ char *filename)
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ ZipFile *zf = Tcl_GetHashValue(hPtr);
+
+ if (strcmp(zf->mountPoint, filename) == 0) {
+ return 1;
+ }
+ }
+ return 0;
+}
+#endif /* NEVER_USED */
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSCloseArchive --
+ *
+ * This function closes a mounted ZIP archive file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A memory mapped ZIP archive is unmapped, allocated memory is released.
+ * The ZipFile pointer is *NOT* deallocated by this function.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+ZipFSCloseArchive(
+ Tcl_Interp *interp, /* Current interpreter. */
+ ZipFile *zf)
+{
+ if (zf->nameLength) {
+ ckfree(zf->name);
+ }
+ if (zf->isMemBuffer) {
+ /* Pointer to memory */
+ if (zf->ptrToFree) {
+ ckfree(zf->ptrToFree);
+ zf->ptrToFree = NULL;
+ }
+ zf->data = NULL;
+ return;
+ }
+
+#ifdef _WIN32
+ if (zf->data && !zf->ptrToFree) {
+ UnmapViewOfFile(zf->data);
+ zf->data = NULL;
+ }
+ if (zf->mountHandle != INVALID_HANDLE_VALUE) {
+ CloseHandle(zf->mountHandle);
+ }
+#else /* !_WIN32 */
+ if ((zf->data != MAP_FAILED) && !zf->ptrToFree) {
+ munmap(zf->data, zf->length);
+ zf->data = MAP_FAILED;
+ }
+#endif /* _WIN32 */
+
+ if (zf->ptrToFree) {
+ ckfree(zf->ptrToFree);
+ zf->ptrToFree = NULL;
+ }
+ if (zf->chan) {
+ Tcl_Close(interp, zf->chan);
+ zf->chan = NULL;
+ }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSFindTOC --
+ *
+ * This function takes a memory mapped zip file and indexes the contents.
+ * When "needZip" is zero an embedded ZIP archive in an executable file
+ * is accepted.
+ *
+ * Results:
+ * TCL_OK on success, TCL_ERROR otherwise with an error message placed
+ * into the given "interp" if it is not NULL.
+ *
+ * Side effects:
+ * The given ZipFile struct is filled with information about the ZIP
+ * archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSFindTOC(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ int needZip,
+ ZipFile *zf)
+{
+ size_t i;
+ unsigned char *p, *q;
+
+ p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
+ while (p >= zf->data) {
+ if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
+ if (ZipReadInt(p) == ZIP_CENTRAL_END_SIG) {
+ break;
+ }
+ p -= ZIP_SIG_LEN;
+ } else {
+ --p;
+ }
+ }
+ if (p < zf->data) {
+ if (!needZip) {
+ zf->baseOffset = zf->passOffset = zf->length;
+ return TCL_OK;
+ }
+ ZIPFS_ERROR(interp, "wrong end signature");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "END_SIG", NULL);
+ }
+ goto error;
+ }
+ zf->numFiles = ZipReadShort(p + ZIP_CENTRAL_ENTS_OFFS);
+ if (zf->numFiles == 0) {
+ if (!needZip) {
+ zf->baseOffset = zf->passOffset = zf->length;
+ return TCL_OK;
+ }
+ ZIPFS_ERROR(interp, "empty archive");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
+ }
+ goto error;
+ }
+ q = zf->data + ZipReadInt(p + ZIP_CENTRAL_DIRSTART_OFFS);
+ p -= ZipReadInt(p + ZIP_CENTRAL_DIRSIZE_OFFS);
+ if ((p < zf->data) || (p > zf->data + zf->length)
+ || (q < zf->data) || (q > zf->data + zf->length)) {
+ if (!needZip) {
+ zf->baseOffset = zf->passOffset = zf->length;
+ return TCL_OK;
+ }
+ ZIPFS_ERROR(interp, "archive directory not found");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_DIR", NULL);
+ }
+ goto error;
+ }
+ zf->baseOffset = zf->passOffset = p - q;
+ zf->directoryOffset = p - zf->data;
+ q = p;
+ for (i = 0; i < zf->numFiles; i++) {
+ int pathlen, comlen, extra;
+
+ if (q + ZIP_CENTRAL_HEADER_LEN > zf->data + zf->length) {
+ ZIPFS_ERROR(interp, "wrong header length");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_LEN", NULL);
+ }
+ goto error;
+ }
+ if (ZipReadInt(q) != ZIP_CENTRAL_HEADER_SIG) {
+ ZIPFS_ERROR(interp, "wrong header signature");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "HDR_SIG", NULL);
+ }
+ goto error;
+ }
+ pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
+ comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
+ extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
+ q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
+ }
+ q = zf->data + zf->baseOffset;
+ if ((zf->baseOffset >= 6) && (ZipReadInt(q - 4) == ZIP_PASSWORD_END_SIG)) {
+ i = q[-5];
+ if (q - 5 - i > zf->data) {
+ zf->passBuf[0] = i;
+ memcpy(zf->passBuf + 1, q - 5 - i, i);
+ zf->passOffset -= i ? (5 + i) : 0;
+ }
+ }
+ return TCL_OK;
+
+ error:
+ ZipFSCloseArchive(interp, zf);
+ return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSOpenArchive --
+ *
+ * This function opens a ZIP archive file for reading. An attempt is made
+ * to memory map that file. Otherwise it is read into an allocated memory
+ * buffer. The ZIP archive header is verified and must be valid for the
+ * function to succeed. When "needZip" is zero an embedded ZIP archive in
+ * an executable file is accepted.
+ *
+ * Results:
+ * TCL_OK on success, TCL_ERROR otherwise with an error message placed
+ * into the given "interp" if it is not NULL.
+ *
+ * Side effects:
+ * ZIP archive is memory mapped or read into allocated memory, the given
+ * ZipFile struct is filled with information about the ZIP archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSOpenArchive(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ const char *zipname, /* Path to ZIP file to open. */
+ int needZip,
+ ZipFile *zf)
+{
+ size_t i;
+ void *handle;
+
+ zf->nameLength = 0;
+ zf->isMemBuffer = 0;
+#ifdef _WIN32
+ zf->data = NULL;
+ zf->mountHandle = INVALID_HANDLE_VALUE;
+#else /* !_WIN32 */
+ zf->data = MAP_FAILED;
+#endif /* _WIN32 */
+ zf->length = 0;
+ zf->numFiles = 0;
+ zf->baseOffset = zf->passOffset = 0;
+ zf->ptrToFree = NULL;
+ zf->passBuf[0] = 0;
+ zf->chan = Tcl_OpenFileChannel(interp, zipname, "rb", 0);
+ if (!zf->chan) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
+ zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
+ if (zf->length == ERROR_LENGTH) {
+ ZIPFS_POSIX_ERROR(interp, "seek error");
+ goto error;
+ }
+ if ((zf->length - ZIP_CENTRAL_END_LEN)
+ > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
+ ZIPFS_ERROR(interp, "illegal file size");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
+ }
+ goto error;
+ }
+ if (Tcl_Seek(zf->chan, 0, SEEK_SET) == -1) {
+ ZIPFS_POSIX_ERROR(interp, "seek error");
+ goto error;
+ }
+ zf->ptrToFree = zf->data = attemptckalloc(zf->length);
+ if (!zf->ptrToFree) {
+ ZIPFS_ERROR(interp, "out of memory");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ goto error;
+ }
+ i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
+ if (i != zf->length) {
+ ZIPFS_POSIX_ERROR(interp, "file read error");
+ goto error;
+ }
+ Tcl_Close(interp, zf->chan);
+ zf->chan = NULL;
+ } else {
+#ifdef _WIN32
+ int readSuccessful;
+# ifdef _WIN64
+ i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER) &zf->length);
+ readSuccessful = (i != 0);
+# else /* !_WIN64 */
+ zf->length = GetFileSize((HANDLE) handle, 0);
+ readSuccessful = (zf->length != (size_t) INVALID_FILE_SIZE);
+# endif /* _WIN64 */
+ if (!readSuccessful || (zf->length < ZIP_CENTRAL_END_LEN)) {
+ ZIPFS_POSIX_ERROR(interp, "invalid file size");
+ goto error;
+ }
+ zf->mountHandle = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY,
+ 0, zf->length, 0);
+ if (zf->mountHandle == INVALID_HANDLE_VALUE) {
+ ZIPFS_POSIX_ERROR(interp, "file mapping failed");
+ goto error;
+ }
+ zf->data = MapViewOfFile(zf->mountHandle, FILE_MAP_READ, 0, 0,
+ zf->length);
+ if (!zf->data) {
+ ZIPFS_POSIX_ERROR(interp, "file mapping failed");
+ goto error;
+ }
+#else /* !_WIN32 */
+ zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
+ if (zf->length == ERROR_LENGTH || zf->length < ZIP_CENTRAL_END_LEN) {
+ ZIPFS_POSIX_ERROR(interp, "invalid file size");
+ goto error;
+ }
+ lseek(PTR2INT(handle), 0, SEEK_SET);
+ zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
+ MAP_FILE | MAP_PRIVATE, PTR2INT(handle), 0);
+ if (zf->data == MAP_FAILED) {
+ ZIPFS_POSIX_ERROR(interp, "file mapping failed");
+ goto error;
+ }
+#endif /* _WIN32 */
+ }
+ return ZipFSFindTOC(interp, needZip, zf);
+
+ error:
+ ZipFSCloseArchive(interp, zf);
+ return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSRootNode --
+ *
+ * This function generates the root node for a ZIPFS filesystem.
+ *
+ * Results:
+ * TCL_OK on success, TCL_ERROR otherwise with an error message placed
+ * into the given "interp" if it is not NULL.
+ *
+ * Side effects:
+ * ...
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSCatalogFilesystem(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ ZipFile *zf0,
+ const char *mountPoint, /* Mount point path. */
+ const char *passwd, /* Password for opening the ZIP, or NULL if
+ * the ZIP is unprotected. */
+ const char *zipname) /* Path to ZIP file to build a catalog of. */
+{
+ int pwlen, isNew;
+ size_t i;
+ ZipFile *zf;
+ ZipEntry *z;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString ds, dsm, fpBuf;
+ unsigned char *q;
+
+ /*
+ * Basic verification of the password for sanity.
+ */
+
+ pwlen = 0;
+ if (passwd) {
+ pwlen = strlen(passwd);
+ if ((pwlen > 255) || strchr(passwd, 0xff)) {
+ if (interp) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("illegal password", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+
+ WriteLock();
+
+ /*
+ * Mount point sometimes is a relative or otherwise denormalized path.
+ * But an absolute name is needed as mount point here.
+ */
+
+ Tcl_DStringInit(&ds);
+ Tcl_DStringInit(&dsm);
+ if (strcmp(mountPoint, "/") == 0) {
+ mountPoint = "";
+ } else {
+ mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
+ }
+ hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mountPoint, &isNew);
+ if (!isNew) {
+ if (interp) {
+ zf = Tcl_GetHashValue(hPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s is already mounted on %s", zf->name, mountPoint));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "MOUNTED", NULL);
+ }
+ Unlock();
+ ZipFSCloseArchive(interp, zf0);
+ return TCL_ERROR;
+ }
+ zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
+ if (!zf) {
+ if (interp) {
+ Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ Unlock();
+ ZipFSCloseArchive(interp, zf0);
+ return TCL_ERROR;
+ }
+ Unlock();
+
+ *zf = *zf0;
+ zf->mountPoint = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
+ zf->mountPointLen = strlen(zf->mountPoint);
+ zf->nameLength = strlen(zipname);
+ zf->name = ckalloc(zf->nameLength + 1);
+ memcpy(zf->name, zipname, zf->nameLength + 1);
+ zf->entries = NULL;
+ zf->topEnts = NULL;
+ zf->numOpen = 0;
+ Tcl_SetHashValue(hPtr, zf);
+ if ((zf->passBuf[0] == 0) && pwlen) {
+ int k = 0;
+
+ zf->passBuf[k++] = pwlen;
+ for (i = pwlen; i-- > 0 ;) {
+ zf->passBuf[k++] = (passwd[i] & 0x0f)
+ | pwrot[(passwd[i] >> 4) & 0x0f];
+ }
+ zf->passBuf[k] = '\0';
+ }
+ if (mountPoint[0] != '\0') {
+ hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mountPoint, &isNew);
+ if (isNew) {
+ z = ckalloc(sizeof(ZipEntry));
+ Tcl_SetHashValue(hPtr, z);
+
+ z->tnext = NULL;
+ z->depth = CountSlashes(mountPoint);
+ z->zipFilePtr = zf;
+ z->isDirectory = (zf->baseOffset == 0) ? 1 : -1; /* root marker */
+ z->isEncrypted = 0;
+ z->offset = zf->baseOffset;
+ z->crc32 = 0;
+ z->timestamp = 0;
+ z->numBytes = z->numCompressedBytes = 0;
+ z->compressMethod = ZIP_COMPMETH_STORED;
+ z->data = NULL;
+ z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+ z->next = zf->entries;
+ zf->entries = z;
+ }
+ }
+ q = zf->data + zf->directoryOffset;
+ Tcl_DStringInit(&fpBuf);
+ for (i = 0; i < zf->numFiles; i++) {
+ int extra, isdir = 0, dosTime, dosDate, nbcompr;
+ size_t offs, pathlen, comlen;
+ unsigned char *lq, *gq = NULL;
+ char *fullpath, *path;
+
+ pathlen = ZipReadShort(q + ZIP_CENTRAL_PATHLEN_OFFS);
+ comlen = ZipReadShort(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
+ extra = ZipReadShort(q + ZIP_CENTRAL_EXTRALEN_OFFS);
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
+ path = Tcl_DStringValue(&ds);
+ if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
+ Tcl_DStringSetLength(&ds, pathlen - 1);
+ path = Tcl_DStringValue(&ds);
+ isdir = 1;
+ }
+ if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
+ goto nextent;
+ }
+ lq = zf->data + zf->baseOffset
+ + ZipReadInt(q + ZIP_CENTRAL_LOCALHDR_OFFS);
+ if ((lq < zf->data) || (lq > zf->data + zf->length)) {
+ goto nextent;
+ }
+ nbcompr = ZipReadInt(lq + ZIP_LOCAL_COMPLEN_OFFS);
+ if (!isdir && (nbcompr == 0)
+ && (ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
+ && (ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS) == 0)) {
+ gq = q;
+ nbcompr = ZipReadInt(gq + ZIP_CENTRAL_COMPLEN_OFFS);
+ }
+ offs = (lq - zf->data)
+ + ZIP_LOCAL_HEADER_LEN
+ + ZipReadShort(lq + ZIP_LOCAL_PATHLEN_OFFS)
+ + ZipReadShort(lq + ZIP_LOCAL_EXTRALEN_OFFS);
+ if (offs + nbcompr > zf->length) {
+ goto nextent;
+ }
+ if (!isdir && (mountPoint[0] == '\0') && !CountSlashes(path)) {
+#ifdef ANDROID
+ /*
+ * When mounting the ZIP archive on the root directory try to
+ * remap top level regular files of the archive to
+ * /assets/.root/... since this directory should not be in a valid
+ * APK due to the leading dot in the file name component. This
+ * trick should make the files AndroidManifest.xml,
+ * resources.arsc, and classes.dex visible to Tcl.
+ */
+ Tcl_DString ds2;
+
+ Tcl_DStringInit(&ds2);
+ Tcl_DStringAppend(&ds2, "assets/.root/", -1);
+ Tcl_DStringAppend(&ds2, path, -1);
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
+ if (hPtr) {
+ /* should not happen but skip it anyway */
+ Tcl_DStringFree(&ds2);
+ goto nextent;
+ }
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2),
+ Tcl_DStringLength(&ds2));
+ path = Tcl_DStringValue(&ds);
+ Tcl_DStringFree(&ds2);
+#else /* !ANDROID */
+ /*
+ * Regular files skipped when mounting on root.
+ */
+ goto nextent;
+#endif /* ANDROID */
+ }
+ Tcl_DStringSetLength(&fpBuf, 0);
+ fullpath = CanonicalPath(mountPoint, path, &fpBuf, 1);
+ z = ckalloc(sizeof(ZipEntry));
+ z->name = NULL;
+ z->tnext = NULL;
+ z->depth = CountSlashes(fullpath);
+ z->zipFilePtr = zf;
+ z->isDirectory = isdir;
+ z->isEncrypted = (ZipReadShort(lq + ZIP_LOCAL_FLAGS_OFFS) & 1)
+ && (nbcompr > 12);
+ z->offset = offs;
+ if (gq) {
+ z->crc32 = ZipReadInt(gq + ZIP_CENTRAL_CRC32_OFFS);
+ dosDate = ZipReadShort(gq + ZIP_CENTRAL_MDATE_OFFS);
+ dosTime = ZipReadShort(gq + ZIP_CENTRAL_MTIME_OFFS);
+ z->timestamp = DosTimeDate(dosDate, dosTime);
+ z->numBytes = ZipReadInt(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
+ z->compressMethod = ZipReadShort(gq + ZIP_CENTRAL_COMPMETH_OFFS);
+ } else {
+ z->crc32 = ZipReadInt(lq + ZIP_LOCAL_CRC32_OFFS);
+ dosDate = ZipReadShort(lq + ZIP_LOCAL_MDATE_OFFS);
+ dosTime = ZipReadShort(lq + ZIP_LOCAL_MTIME_OFFS);
+ z->timestamp = DosTimeDate(dosDate, dosTime);
+ z->numBytes = ZipReadInt(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
+ z->compressMethod = ZipReadShort(lq + ZIP_LOCAL_COMPMETH_OFFS);
+ }
+ z->numCompressedBytes = nbcompr;
+ z->data = NULL;
+ hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
+ if (!isNew) {
+ /* should not happen but skip it anyway */
+ ckfree(z);
+ } else {
+ Tcl_SetHashValue(hPtr, z);
+ z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+ z->next = zf->entries;
+ zf->entries = z;
+ if (isdir && (mountPoint[0] == '\0') && (z->depth == 1)) {
+ z->tnext = zf->topEnts;
+ zf->topEnts = z;
+ }
+ if (!z->isDirectory && (z->depth > 1)) {
+ char *dir, *end;
+ ZipEntry *zd;
+
+ Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, z->name, -1);
+ dir = Tcl_DStringValue(&ds);
+ for (end = strrchr(dir, '/'); end && (end != dir);
+ end = strrchr(dir, '/')) {
+ Tcl_DStringSetLength(&ds, end - dir);
+ hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
+ if (!isNew) {
+ break;
+ }
+ zd = ckalloc(sizeof(ZipEntry));
+ zd->name = NULL;
+ zd->tnext = NULL;
+ zd->depth = CountSlashes(dir);
+ zd->zipFilePtr = zf;
+ zd->isDirectory = 1;
+ zd->isEncrypted = 0;
+ zd->offset = z->offset;
+ zd->crc32 = 0;
+ zd->timestamp = z->timestamp;
+ zd->numBytes = zd->numCompressedBytes = 0;
+ zd->compressMethod = ZIP_COMPMETH_STORED;
+ zd->data = NULL;
+ Tcl_SetHashValue(hPtr, zd);
+ zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+ zd->next = zf->entries;
+ zf->entries = zd;
+ if ((mountPoint[0] == '\0') && (zd->depth == 1)) {
+ zd->tnext = zf->topEnts;
+ zf->topEnts = zd;
+ }
+ }
+ }
+ }
+ nextent:
+ q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
+ }
+ Tcl_DStringFree(&fpBuf);
+ Tcl_DStringFree(&ds);
+ Tcl_FSMountsChanged(NULL);
+ Unlock();
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipfsSetup --
+ *
+ * Common initialisation code. ZipFS.initialized must *not* be set prior
+ * to the call.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+ZipfsSetup(void)
+{
+#if TCL_THREADS
+ static const Tcl_Time t = { 0, 0 };
+
+ /*
+ * Inflate condition variable.
+ */
+
+ Tcl_MutexLock(&ZipFSMutex);
+ Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t);
+ Tcl_MutexUnlock(&ZipFSMutex);
+#endif /* TCL_THREADS */
+
+ Tcl_FSRegister(NULL, &zipfsFilesystem);
+ Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
+ ZipFS.idCount = 1;
+ ZipFS.wrmax = DEFAULT_WRITE_MAX_SIZE;
+ ZipFS.initialized = 1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ListMountPoints --
+ *
+ * This procedure lists the mount points and what's mounted there, or
+ * reports whether there are any mounts (if there's no interpreter). The
+ * read lock must be held by the caller.
+ *
+ * Results:
+ * A standard Tcl result. TCL_OK (or TCL_BREAK if no mounts and no
+ * interpreter).
+ *
+ * Side effects:
+ * Interpreter result may be updated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static inline int
+ListMountPoints(
+ Tcl_Interp *interp)
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ ZipFile *zf;
+
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ if (!interp) {
+ return TCL_OK;
+ }
+ zf = Tcl_GetHashValue(hPtr);
+ Tcl_AppendElement(interp, zf->mountPoint);
+ Tcl_AppendElement(interp, zf->name);
+ }
+ return (interp ? TCL_OK : TCL_BREAK);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * DescribeMounted --
+ *
+ * This procedure describes what is mounted at the given the mount point.
+ * The interpreter result is not updated if there is nothing mounted at
+ * the given point. The read lock must be held by the caller.
+ *
+ * Results:
+ * A standard Tcl result. TCL_OK (or TCL_BREAK if nothing mounted there
+ * and no interpreter).
+ *
+ * Side effects:
+ * Interpreter result may be updated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static inline int
+DescribeMounted(
+ Tcl_Interp *interp,
+ const char *mountPoint)
+{
+ Tcl_HashEntry *hPtr;
+ ZipFile *zf;
+
+ if (interp) {
+ hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
+ if (hPtr) {
+ zf = Tcl_GetHashValue(hPtr);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(zf->name, -1));
+ return TCL_OK;
+ }
+ }
+ return (interp ? TCL_OK : TCL_BREAK);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Mount --
+ *
+ * This procedure is invoked to mount a given ZIP archive file on a given
+ * mountpoint with optional ZIP password.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A ZIP archive file is read, analyzed and mounted, resources are
+ * allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Mount(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ const char *mountPoint, /* Mount point path. */
+ const char *zipname, /* Path to ZIP file to mount. */
+ const char *passwd) /* Password for opening the ZIP, or NULL if
+ * the ZIP is unprotected. */
+{
+ ZipFile *zf;
+
+ ReadLock();
+ if (!ZipFS.initialized) {
+ ZipfsSetup();
+ }
+
+ /*
+ * No mount point, so list all mount points and what is mounted there.
+ */
+
+ if (!mountPoint) {
+ int ret = ListMountPoints(interp);
+ Unlock();
+ return ret;
+ }
+
+ /*
+ * Mount point but no file, so describe what is mounted at that mount
+ * point.
+ */
+
+ if (!zipname) {
+ DescribeMounted(interp, mountPoint);
+ Unlock();
+ return TCL_OK;
+ }
+ Unlock();
+
+ /*
+ * Have both a mount point and a file (name) to mount there.
+ */
+
+ if (passwd) {
+ if ((strlen(passwd) > 255) || strchr(passwd, 0xff)) {
+ if (interp) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("illegal password", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+ zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
+ if (!zf) {
+ if (interp) {
+ Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return ZipFSCatalogFilesystem(interp, zf, mountPoint, passwd, zipname);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_MountBuffer --
+ *
+ * This procedure is invoked to mount a given ZIP archive file on a given
+ * mountpoint with optional ZIP password.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A ZIP archive file is read, analyzed and mounted, resources are
+ * allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_MountBuffer(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ const char *mountPoint, /* Mount point path. */
+ unsigned char *data,
+ size_t datalen,
+ int copy)
+{
+ ZipFile *zf;
+
+ ReadLock();
+ if (!ZipFS.initialized) {
+ ZipfsSetup();
+ }
+
+ /*
+ * No mount point, so list all mount points and what is mounted there.
+ */
+
+ if (!mountPoint) {
+ int ret = ListMountPoints(interp);
+ Unlock();
+ return ret;
+ }
+
+ /*
+ * Mount point but no data, so describe what is mounted at that mount
+ * point.
+ */
+
+ if (!data) {
+ DescribeMounted(interp, mountPoint);
+ Unlock();
+ return TCL_OK;
+ }
+ Unlock();
+
+ /*
+ * Have both a mount point and data to mount there.
+ */
+
+ zf = attemptckalloc(sizeof(ZipFile) + strlen(mountPoint) + 1);
+ if (!zf) {
+ if (interp) {
+ Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ zf->isMemBuffer = 1;
+ zf->length = datalen;
+ if (copy) {
+ zf->data = attemptckalloc(datalen);
+ if (!zf->data) {
+ if (interp) {
+ Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ return TCL_ERROR;
+ }
+ memcpy(zf->data, data, datalen);
+ zf->ptrToFree = zf->data;
+ } else {
+ zf->data = data;
+ zf->ptrToFree = NULL;
+ }
+ if (ZipFSFindTOC(interp, 0, zf) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return ZipFSCatalogFilesystem(interp, zf, mountPoint, NULL,
+ "Memory Buffer");
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Unmount --
+ *
+ * This procedure is invoked to unmount a given ZIP archive.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A mounted ZIP archive file is unmounted, resources are free'd.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Unmount(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ const char *mountPoint) /* Mount point path. */
+{
+ ZipFile *zf;
+ ZipEntry *z, *znext;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString dsm;
+ int ret = TCL_OK, unmounted = 0;
+
+ WriteLock();
+ if (!ZipFS.initialized) {
+ goto done;
+ }
+
+ /*
+ * Mount point sometimes is a relative or otherwise denormalized path.
+ * But an absolute name is needed as mount point here.
+ */
+
+ Tcl_DStringInit(&dsm);
+ mountPoint = CanonicalPath("", mountPoint, &dsm, 1);
+
+ hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mountPoint);
+ /* don't report no-such-mount as an error */
+ if (!hPtr) {
+ goto done;
+ }
+
+ zf = Tcl_GetHashValue(hPtr);
+ if (zf->numOpen > 0) {
+ ZIPFS_ERROR(interp, "filesystem is busy");
+ ret = TCL_ERROR;
+ goto done;
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ for (z = zf->entries; z; z = znext) {
+ znext = z->next;
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ if (z->data) {
+ ckfree(z->data);
+ }
+ ckfree(z);
+ }
+ ZipFSCloseArchive(interp, zf);
+ ckfree(zf);
+ unmounted = 1;
+ done:
+ Unlock();
+ if (unmounted) {
+ Tcl_FSMountsChanged(NULL);
+ }
+ return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMountObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs mount] command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A ZIP archive file is mounted, resources are allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMountObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?mountpoint? ?zipfile? ?password?");
+ return TCL_ERROR;
+ }
+
+ return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
+ (objc > 2) ? Tcl_GetString(objv[2]) : NULL,
+ (objc > 3) ? Tcl_GetString(objv[3]) : NULL);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMountBufferObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs mount_data] command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A ZIP archive file is mounted, resources are allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMountBufferObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ const char *mountPoint; /* Mount point path. */
+ unsigned char *data;
+ int length;
+
+ if (objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
+ return TCL_ERROR;
+ }
+ if (objc < 2) {
+ int ret;
+
+ ReadLock();
+ ret = ListMountPoints(interp);
+ Unlock();
+ return ret;
+ }
+
+ mountPoint = Tcl_GetString(objv[1]);
+ if (objc < 3) {
+ ReadLock();
+ DescribeMounted(interp, mountPoint);
+ Unlock();
+ return TCL_OK;
+ }
+
+ data = Tcl_GetByteArrayFromObj(objv[2], &length);
+ return TclZipfs_MountBuffer(interp, mountPoint, data, length, 1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSRootObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs root] command. It
+ * returns the root that all zipfs file systems are mounted under.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSRootObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(ZIPFS_VOLUME, -1));
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSUnmountObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs unmount] command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A mounted ZIP archive file is unmounted, resources are free'd.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSUnmountObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
+ return TCL_ERROR;
+ }
+ return TclZipfs_Unmount(interp, Tcl_GetString(objv[1]));
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkKeyObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs mkkey] command. It
+ * produces a rotated password to be embedded into an image file.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkKeyObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ int len, i = 0;
+ char *pw, passBuf[264];
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "password");
+ return TCL_ERROR;
+ }
+ pw = Tcl_GetString(objv[1]);
+ len = strlen(pw);
+ if (len == 0) {
+ return TCL_OK;
+ }
+ if ((len > 255) || strchr(pw, 0xff)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
+ return TCL_ERROR;
+ }
+ while (len > 0) {
+ int ch = pw[len - 1];
+
+ passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+ i++;
+ len--;
+ }
+ passBuf[i] = i;
+ ++i;
+ passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
+ passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
+ passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
+ passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
+ passBuf[i] = '\0';
+ Tcl_AppendResult(interp, passBuf, (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipAddFile --
+ *
+ * This procedure is used by ZipFSMkZipOrImgCmd() to add a single file to
+ * the output ZIP archive file being written. A ZipEntry struct about the
+ * input file is added to the given fileHash table for later creation of
+ * the central ZIP directory.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Input file is read and (compressed and) written to the output ZIP
+ * archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipAddFile(
+ Tcl_Interp *interp, /* Current interpreter. */
+ const char *path,
+ const char *name,
+ Tcl_Channel out,
+ const char *passwd, /* Password for encoding the file, or NULL if
+ * the file is to be unprotected. */
+ char *buf,
+ int bufsize,
+ Tcl_HashTable *fileHash)
+{
+ Tcl_Channel in;
+ Tcl_HashEntry *hPtr;
+ ZipEntry *z;
+ z_stream stream;
+ const char *zpath;
+ int crc, flush, zpathlen;
+ size_t nbyte, nbytecompr, len, olen, align = 0;
+ Tcl_WideInt pos[3];
+ int mtime = 0, isNew, compMeth;
+ unsigned long keys[3], keys0[3];
+ char obuf[4096];
+
+ /*
+ * Trim leading '/' characters. If this results in an empty string, we've
+ * nothing to do.
+ */
+
+ zpath = name;
+ while (zpath && zpath[0] == '/') {
+ zpath++;
+ }
+ if (!zpath || (zpath[0] == '\0')) {
+ return TCL_OK;
+ }
+
+ zpathlen = strlen(zpath);
+ if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "path too long for \"%s\"", path));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "PATH_LEN", NULL);
+ return TCL_ERROR;
+ }
+ in = Tcl_OpenFileChannel(interp, path, "rb", 0);
+ if (!in) {
+#ifdef _WIN32
+ /* hopefully a directory */
+ if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
+ Tcl_Close(interp, in);
+ return TCL_OK;
+ }
+#endif /* _WIN32 */
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ } else {
+ Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
+ Tcl_StatBuf statBuf;
+
+ Tcl_IncrRefCount(pathObj);
+ if (Tcl_FSStat(pathObj, &statBuf) != -1) {
+ mtime = statBuf.st_mtime;
+ }
+ Tcl_DecrRefCount(pathObj);
+ }
+ Tcl_ResetResult(interp);
+ crc = 0;
+ nbyte = nbytecompr = 0;
+ while (1) {
+ len = Tcl_Read(in, buf, bufsize);
+ if (len == ERROR_LENGTH) {
+ if (nbyte == 0 && errno == EISDIR) {
+ Tcl_Close(interp, in);
+ return TCL_OK;
+ }
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("read error on \"%s\": %s",
+ path, Tcl_PosixError(interp)));
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ if (len == 0) {
+ break;
+ }
+ crc = crc32(crc, (unsigned char *) buf, len);
+ nbyte += len;
+ }
+ if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf("seek error on \"%s\": %s",
+ path, Tcl_PosixError(interp)));
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ pos[0] = Tcl_Tell(out);
+ memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
+ memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
+ len = zpathlen + ZIP_LOCAL_HEADER_LEN;
+ if ((size_t) Tcl_Write(out, buf, len) != len) {
+ wrerr:
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error on %s: %s", path, Tcl_PosixError(interp)));
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ if ((len + pos[0]) & 3) {
+ unsigned char abuf[8];
+
+ /*
+ * Align payload to next 4-byte boundary using a dummy extra entry
+ * similar to the zipalign tool from Android's SDK.
+ */
+
+ align = 4 + ((len + pos[0]) & 3);
+ ZipWriteShort(abuf, 0xffff);
+ ZipWriteShort(abuf + 2, align - 4);
+ ZipWriteInt(abuf + 4, 0x03020100);
+ if ((size_t) Tcl_Write(out, (const char *) abuf, align) != align) {
+ goto wrerr;
+ }
+ }
+ if (passwd) {
+ int i, ch, tmp;
+ unsigned char kvbuf[24];
+ Tcl_Obj *ret;
+
+ init_keys(passwd, keys, crc32tab);
+ for (i = 0; i < 12 - 2; i++) {
+ double r;
+
+ if (Tcl_EvalEx(interp, "::tcl::mathfunc::rand", -1, 0) != TCL_OK) {
+ Tcl_Obj *eiPtr = Tcl_ObjPrintf(
+ "\n (evaluating PRNG step %d for password encoding)",
+ i);
+
+ Tcl_AppendObjToErrorInfo(interp, eiPtr);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ ret = Tcl_GetObjResult(interp);
+ if (Tcl_GetDoubleFromObj(interp, ret, &r) != TCL_OK) {
+ Tcl_Obj *eiPtr = Tcl_ObjPrintf(
+ "\n (evaluating PRNG step %d for password encoding)",
+ i);
+
+ Tcl_AppendObjToErrorInfo(interp, eiPtr);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ ch = (int) (r * 256);
+ kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp);
+ }
+ Tcl_ResetResult(interp);
+ init_keys(passwd, keys, crc32tab);
+ for (i = 0; i < 12 - 2; i++) {
+ kvbuf[i] = (unsigned char)
+ zencode(keys, crc32tab, kvbuf[i + 12], tmp);
+ }
+ kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp);
+ kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp);
+ len = Tcl_Write(out, (char *) kvbuf, 12);
+ memset(kvbuf, 0, 24);
+ if (len != 12) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error on %s: %s", path, Tcl_PosixError(interp)));
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ memcpy(keys0, keys, sizeof(keys0));
+ nbytecompr += 12;
+ }
+ Tcl_Flush(out);
+ pos[2] = Tcl_Tell(out);
+ compMeth = ZIP_COMPMETH_DEFLATED;
+ memset(&stream, 0, sizeof(z_stream));
+ stream.zalloc = Z_NULL;
+ stream.zfree = Z_NULL;
+ stream.opaque = Z_NULL;
+ if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8,
+ Z_DEFAULT_STRATEGY) != Z_OK) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "compression init error on \"%s\"", path));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE_INIT", NULL);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ do {
+ len = Tcl_Read(in, buf, bufsize);
+ if (len == ERROR_LENGTH) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "read error on %s: %s", path, Tcl_PosixError(interp)));
+ deflateEnd(&stream);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ stream.avail_in = len;
+ stream.next_in = (unsigned char *) buf;
+ flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
+ do {
+ stream.avail_out = sizeof(obuf);
+ stream.next_out = (unsigned char *) obuf;
+ len = deflate(&stream, flush);
+ if (len == (size_t) Z_STREAM_ERROR) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "deflate error on %s", path));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DEFLATE", NULL);
+ deflateEnd(&stream);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ olen = sizeof(obuf) - stream.avail_out;
+ if (passwd) {
+ size_t i;
+ int tmp;
+
+ for (i = 0; i < olen; i++) {
+ obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp);
+ }
+ }
+ if (olen && ((size_t) Tcl_Write(out, obuf, olen) != olen)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ deflateEnd(&stream);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ nbytecompr += olen;
+ } while (stream.avail_out == 0);
+ } while (flush != Z_FINISH);
+ deflateEnd(&stream);
+ Tcl_Flush(out);
+ pos[1] = Tcl_Tell(out);
+ if (nbyte - nbytecompr <= 0) {
+ /*
+ * Compressed file larger than input, write it again uncompressed.
+ */
+ if (Tcl_Seek(in, 0, SEEK_SET) != 0) {
+ goto seekErr;
+ }
+ if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
+ seekErr:
+ Tcl_Close(interp, in);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "seek error: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ nbytecompr = (passwd ? 12 : 0);
+ while (1) {
+ len = Tcl_Read(in, buf, bufsize);
+ if (len == ERROR_LENGTH) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "read error on \"%s\": %s",
+ path, Tcl_PosixError(interp)));
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ } else if (len == 0) {
+ break;
+ }
+ if (passwd) {
+ size_t i;
+ int tmp;
+
+ for (i = 0; i < len; i++) {
+ buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp);
+ }
+ }
+ if ((size_t) Tcl_Write(out, buf, len) != len) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ nbytecompr += len;
+ }
+ compMeth = ZIP_COMPMETH_STORED;
+ Tcl_Flush(out);
+ pos[1] = Tcl_Tell(out);
+ Tcl_TruncateChannel(out, pos[1]);
+ }
+ Tcl_Close(interp, in);
+
+ hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
+ if (!isNew) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "non-unique path name \"%s\"", path));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DUPLICATE_PATH", NULL);
+ return TCL_ERROR;
+ }
+
+ z = ckalloc(sizeof(ZipEntry));
+ Tcl_SetHashValue(hPtr, z);
+ z->name = NULL;
+ z->tnext = NULL;
+ z->depth = 0;
+ z->zipFilePtr = NULL;
+ z->isDirectory = 0;
+ z->isEncrypted = (passwd ? 1 : 0);
+ z->offset = pos[0];
+ z->crc32 = crc;
+ z->timestamp = mtime;
+ z->numBytes = nbyte;
+ z->numCompressedBytes = nbytecompr;
+ z->compressMethod = compMeth;
+ z->data = NULL;
+ z->name = Tcl_GetHashKey(fileHash, hPtr);
+ z->next = NULL;
+
+ /*
+ * Write final local header information.
+ */
+ ZipWriteInt(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
+ ZipWriteShort(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
+ ZipWriteShort(buf + ZIP_LOCAL_FLAGS_OFFS, z->isEncrypted);
+ ZipWriteShort(buf + ZIP_LOCAL_COMPMETH_OFFS, z->compressMethod);
+ ZipWriteShort(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
+ ZipWriteShort(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
+ ZipWriteInt(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
+ ZipWriteInt(buf + ZIP_LOCAL_COMPLEN_OFFS, z->numCompressedBytes);
+ ZipWriteInt(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->numBytes);
+ ZipWriteShort(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
+ ZipWriteShort(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
+ if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree(z);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "seek error: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree(z);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ Tcl_Flush(out);
+ if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) {
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree(z);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "seek error: %s", Tcl_PosixError(interp)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkZipOrImgObjCmd --
+ *
+ * This procedure is creates a new ZIP archive file or image file given
+ * output filename, input directory of files to be archived, optional
+ * password, and optional image to be prepended to the output ZIP archive
+ * file.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new ZIP archive file or image file is written.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkZipOrImgObjCmd(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int isImg,
+ int isList,
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ Tcl_Channel out;
+ int pwlen = 0, count, ret = TCL_ERROR, lobjc;
+ size_t len, slen = 0, i = 0;
+ Tcl_WideInt pos[3];
+ Tcl_Obj **lobjv, *list = NULL;
+ ZipEntry *z;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_HashTable fileHash;
+ char *strip = NULL, *pw = NULL, passBuf[264], buf[4096];
+
+ /*
+ * Caller has verified that the number of arguments is correct.
+ */
+
+ passBuf[0] = 0;
+ if (objc > (isList ? 3 : 4)) {
+ pw = Tcl_GetString(objv[isList ? 3 : 4]);
+ pwlen = strlen(pw);
+ if ((pwlen > 255) || strchr(pw, 0xff)) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("illegal password", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_PASS", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (isList) {
+ list = objv[2];
+ Tcl_IncrRefCount(list);
+ } else {
+ Tcl_Obj *cmd[3];
+
+ cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
+ cmd[2] = objv[2];
+ cmd[0] = Tcl_NewListObj(2, cmd + 1);
+ Tcl_IncrRefCount(cmd[0]);
+ if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
+ Tcl_DecrRefCount(cmd[0]);
+ return TCL_ERROR;
+ }
+ Tcl_DecrRefCount(cmd[0]);
+ list = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(list);
+ }
+ if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
+ Tcl_DecrRefCount(list);
+ return TCL_ERROR;
+ }
+ if (isList && (lobjc % 2)) {
+ Tcl_DecrRefCount(list);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("need even number of elements", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "LIST_LENGTH", NULL);
+ return TCL_ERROR;
+ }
+ if (lobjc == 0) {
+ Tcl_DecrRefCount(list);
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "EMPTY", NULL);
+ return TCL_ERROR;
+ }
+ out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "wb", 0755);
+ if (out == NULL) {
+ Tcl_DecrRefCount(list);
+ return TCL_ERROR;
+ }
+ if (pwlen <= 0) {
+ pw = NULL;
+ pwlen = 0;
+ }
+ if (isImg) {
+ ZipFile *zf, zf0;
+ int isMounted = 0;
+ const char *imgName;
+
+ if (isList) {
+ imgName = (objc > 4) ? Tcl_GetString(objv[4]) :
+ Tcl_GetNameOfExecutable();
+ } else {
+ imgName = (objc > 5) ? Tcl_GetString(objv[5]) :
+ Tcl_GetNameOfExecutable();
+ }
+ if (pwlen) {
+ i = 0;
+ for (len = pwlen; len-- > 0;) {
+ int ch = pw[len];
+
+ passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+ i++;
+ }
+ passBuf[i] = i;
+ ++i;
+ passBuf[i++] = (char) ZIP_PASSWORD_END_SIG;
+ passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
+ passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
+ passBuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
+ passBuf[i] = '\0';
+ }
+
+ /*
+ * Check for mounted image.
+ */
+
+ WriteLock();
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ zf = Tcl_GetHashValue(hPtr);
+ if (strcmp(zf->name, imgName) == 0) {
+ isMounted = 1;
+ zf->numOpen++;
+ break;
+ }
+ }
+ Unlock();
+ if (!isMounted) {
+ zf = &zf0;
+ }
+ if (isMounted || ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK) {
+ if ((size_t) Tcl_Write(out, (char *) zf->data,
+ zf->passOffset) != zf->passOffset) {
+ memset(passBuf, 0, sizeof(passBuf));
+ Tcl_DecrRefCount(list);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ Tcl_Close(interp, out);
+ if (zf == &zf0) {
+ ZipFSCloseArchive(interp, zf);
+ } else {
+ WriteLock();
+ zf->numOpen--;
+ Unlock();
+ }
+ return TCL_ERROR;
+ }
+ if (zf == &zf0) {
+ ZipFSCloseArchive(interp, zf);
+ } else {
+ WriteLock();
+ zf->numOpen--;
+ Unlock();
+ }
+ } else {
+ size_t k;
+ int m, n;
+ Tcl_Channel in;
+ const char *errMsg = "seek error";
+
+ /*
+ * Fall back to read it as plain file which hopefully is a static
+ * tclsh or wish binary with proper zipfs infrastructure built in.
+ */
+
+ Tcl_ResetResult(interp);
+ in = Tcl_OpenFileChannel(interp, imgName, "rb", 0644);
+ if (!in) {
+ memset(passBuf, 0, sizeof(passBuf));
+ Tcl_DecrRefCount(list);
+ Tcl_Close(interp, out);
+ return TCL_ERROR;
+ }
+ i = Tcl_Seek(in, 0, SEEK_END);
+ if (i == ERROR_LENGTH) {
+ cperr:
+ memset(passBuf, 0, sizeof(passBuf));
+ Tcl_DecrRefCount(list);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "%s: %s", errMsg, Tcl_PosixError(interp)));
+ Tcl_Close(interp, out);
+ Tcl_Close(interp, in);
+ return TCL_ERROR;
+ }
+ Tcl_Seek(in, 0, SEEK_SET);
+ for (k = 0; k < i; k += m) {
+ m = i - k;
+ if (m > (int) sizeof(buf)) {
+ m = (int) sizeof(buf);
+ }
+ n = Tcl_Read(in, buf, m);
+ if (n == -1) {
+ errMsg = "read error";
+ goto cperr;
+ } else if (n == 0) {
+ break;
+ }
+ m = Tcl_Write(out, buf, n);
+ if (m != n) {
+ errMsg = "write error";
+ goto cperr;
+ }
+ }
+ Tcl_Close(interp, in);
+ }
+ len = strlen(passBuf);
+ if (len > 0) {
+ i = Tcl_Write(out, passBuf, len);
+ if (i != len) {
+ Tcl_DecrRefCount(list);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ Tcl_Close(interp, out);
+ return TCL_ERROR;
+ }
+ }
+ memset(passBuf, 0, sizeof(passBuf));
+ Tcl_Flush(out);
+ }
+ Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
+ pos[0] = Tcl_Tell(out);
+ if (!isList && (objc > 3)) {
+ strip = Tcl_GetString(objv[3]);
+ slen = strlen(strip);
+ }
+ for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
+ const char *path, *name;
+
+ path = Tcl_GetString(lobjv[i]);
+ if (isList) {
+ name = Tcl_GetString(lobjv[i + 1]);
+ } else {
+ name = path;
+ if (slen > 0) {
+ len = strlen(name);
+ if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
+ continue;
+ }
+ name += slen;
+ }
+ }
+ while (name[0] == '/') {
+ ++name;
+ }
+ if (name[0] == '\0') {
+ continue;
+ }
+ if (ZipAddFile(interp, path, name, out, pw, buf, sizeof(buf),
+ &fileHash) != TCL_OK) {
+ goto done;
+ }
+ }
+ pos[1] = Tcl_Tell(out);
+ count = 0;
+ for (i = 0; i < (size_t) lobjc; i += (isList ? 2 : 1)) {
+ const char *path, *name;
+
+ path = Tcl_GetString(lobjv[i]);
+ if (isList) {
+ name = Tcl_GetString(lobjv[i + 1]);
+ } else {
+ name = path;
+ if (slen > 0) {
+ len = strlen(name);
+ if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
+ continue;
+ }
+ name += slen;
+ }
+ }
+ while (name[0] == '/') {
+ ++name;
+ }
+ if (name[0] == '\0') {
+ continue;
+ }
+ hPtr = Tcl_FindHashEntry(&fileHash, name);
+ if (!hPtr) {
+ continue;
+ }
+ z = Tcl_GetHashValue(hPtr);
+ len = strlen(z->name);
+ ZipWriteInt(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
+ ZipWriteShort(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
+ ZipWriteShort(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
+ ZipWriteShort(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isEncrypted);
+ ZipWriteShort(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->compressMethod);
+ ZipWriteShort(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
+ ZipWriteShort(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
+ ZipWriteInt(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
+ ZipWriteInt(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->numCompressedBytes);
+ ZipWriteInt(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->numBytes);
+ ZipWriteShort(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
+ ZipWriteShort(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
+ ZipWriteShort(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
+ ZipWriteShort(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
+ ZipWriteShort(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
+ ZipWriteInt(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
+ ZipWriteInt(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
+ if ((Tcl_Write(out, buf,
+ ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN)
+ || ((size_t) Tcl_Write(out, z->name, len) != len)) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ goto done;
+ }
+ count++;
+ }
+ Tcl_Flush(out);
+ pos[2] = Tcl_Tell(out);
+ ZipWriteInt(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
+ ZipWriteShort(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
+ ZipWriteShort(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
+ ZipWriteShort(buf + ZIP_CENTRAL_ENTS_OFFS, count);
+ ZipWriteShort(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
+ ZipWriteInt(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
+ ZipWriteInt(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
+ ZipWriteShort(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
+ if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "write error: %s", Tcl_PosixError(interp)));
+ goto done;
+ }
+ Tcl_Flush(out);
+ ret = TCL_OK;
+
+ done:
+ if (ret == TCL_OK) {
+ ret = Tcl_Close(interp, out);
+ } else {
+ Tcl_Close(interp, out);
+ }
+ Tcl_DecrRefCount(list);
+ for (hPtr = Tcl_FirstHashEntry(&fileHash, &search); hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ z = Tcl_GetHashValue(hPtr);
+ ckfree(z);
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tcl_DeleteHashTable(&fileHash);
+ return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkZipObjCmd, ZipFSLMkZipObjCmd --
+ *
+ * These procedures are invoked to process the [zipfs mkzip] and [zipfs
+ * lmkzip] commands. See description of ZipFSMkZipOrImgCmd().
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See description of ZipFSMkZipOrImgCmd().
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkZipObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "outfile indir ?strip? ?password?");
+ return TCL_ERROR;
+ }
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "operation not permitted in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
+ return TCL_ERROR;
+ }
+ return ZipFSMkZipOrImgObjCmd(interp, 0, 0, objc, objv);
+}
+
+static int
+ZipFSLMkZipObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password?");
+ return TCL_ERROR;
+ }
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "operation not permitted in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
+ return TCL_ERROR;
+ }
+ return ZipFSMkZipOrImgObjCmd(interp, 0, 1, objc, objv);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkImgObjCmd, ZipFSLMkImgObjCmd --
+ *
+ * These procedures are invoked to process the [zipfs mkimg] and [zipfs
+ * lmkimg] commands. See description of ZipFSMkZipOrImgCmd().
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See description of ZipFSMkZipOrImgCmd().
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkImgObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc < 3 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "outfile indir ?strip? ?password? ?infile?");
+ return TCL_ERROR;
+ }
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "operation not permitted in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
+ return TCL_ERROR;
+ }
+ return ZipFSMkZipOrImgObjCmd(interp, 1, 0, objc, objv);
+}
+
+static int
+ZipFSLMkImgObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (objc < 3 || objc > 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "outfile inlist ?password infile?");
+ return TCL_ERROR;
+ }
+ if (Tcl_IsSafe(interp)) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "operation not permitted in a safe interpreter", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "SAFE_INTERP", NULL);
+ return TCL_ERROR;
+ }
+ return ZipFSMkZipOrImgObjCmd(interp, 1, 1, objc, objv);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSCanonicalObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs canonical] command.
+ * It returns the canonical name for a file within zipfs
+ *
+ * Results:
+ * Always TCL_OK provided the right number of arguments are supplied.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSCanonicalObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ char *mntpoint = NULL;
+ char *filename = NULL;
+ char *result;
+ Tcl_DString dPath;
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? filename ?inZipfs?");
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&dPath);
+ if (objc == 2) {
+ filename = Tcl_GetString(objv[1]);
+ result = CanonicalPath("", filename, &dPath, 1);
+ } else if (objc == 3) {
+ mntpoint = Tcl_GetString(objv[1]);
+ filename = Tcl_GetString(objv[2]);
+ result = CanonicalPath(mntpoint, filename, &dPath, 1);
+ } else {
+ int zipfs = 0;
+
+ if (Tcl_GetBooleanFromObj(interp, objv[3], &zipfs)) {
+ return TCL_ERROR;
+ }
+ mntpoint = Tcl_GetString(objv[1]);
+ filename = Tcl_GetString(objv[2]);
+ result = CanonicalPath(mntpoint, filename, &dPath, zipfs);
+ }
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSExistsObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs exists] command. It
+ * tests for the existence of a file in the ZIP filesystem and places a
+ * boolean into the interp's result.
+ *
+ * Results:
+ * Always TCL_OK provided the right number of arguments are supplied.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSExistsObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ char *filename;
+ int exists;
+ Tcl_DString ds;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "filename");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Prepend ZIPFS_VOLUME to filename, eliding the final /
+ */
+
+ filename = Tcl_GetString(objv[1]);
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN - 1);
+ Tcl_DStringAppend(&ds, filename, -1);
+ filename = Tcl_DStringValue(&ds);
+
+ ReadLock();
+ exists = ZipFSLookup(filename) != NULL;
+ Unlock();
+
+ Tcl_SetObjResult(interp, Tcl_NewBooleanObj(exists));
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSInfoObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs info] command. On
+ * success, it returns a Tcl list made up of name of ZIP archive file,
+ * size uncompressed, size compressed, and archive offset of a file in
+ * the ZIP filesystem.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSInfoObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ char *filename;
+ ZipEntry *z;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "filename");
+ return TCL_ERROR;
+ }
+ filename = Tcl_GetString(objv[1]);
+ ReadLock();
+ z = ZipFSLookup(filename);
+ if (z) {
+ Tcl_Obj *result = Tcl_GetObjResult(interp);
+
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewStringObj(z->zipFilePtr->name, -1));
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewWideIntObj(z->numBytes));
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewWideIntObj(z->numCompressedBytes));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset));
+ }
+ Unlock();
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSListObjCmd --
+ *
+ * This procedure is invoked to process the [zipfs list] command. On
+ * success, it returns a Tcl list of files of the ZIP filesystem which
+ * match a search pattern (glob or regexp).
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSListObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ char *pattern = NULL;
+ Tcl_RegExp regexp = NULL;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *result = Tcl_GetObjResult(interp);
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
+ return TCL_ERROR;
+ }
+ if (objc == 3) {
+ int n;
+ char *what = Tcl_GetStringFromObj(objv[1], &n);
+
+ if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
+ pattern = Tcl_GetString(objv[2]);
+ } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
+ regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2]));
+ if (!regexp) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown option \"%s\"", what));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_OPT", NULL);
+ return TCL_ERROR;
+ }
+ } else if (objc == 2) {
+ pattern = Tcl_GetString(objv[1]);
+ }
+ ReadLock();
+ if (pattern) {
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ZipEntry *z = Tcl_GetHashValue(hPtr);
+
+ if (Tcl_StringMatch(z->name, pattern)) {
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewStringObj(z->name, -1));
+ }
+ }
+ } else if (regexp) {
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+ hPtr; hPtr = Tcl_NextHashEntry(&search)) {
+ ZipEntry *z = Tcl_GetHashValue(hPtr);
+
+ if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewStringObj(z->name, -1));
+ }
+ }
+ } else {
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+ hPtr; hPtr = Tcl_NextHashEntry(&search)) {
+ ZipEntry *z = Tcl_GetHashValue(hPtr);
+
+ Tcl_ListObjAppendElement(interp, result,
+ Tcl_NewStringObj(z->name, -1));
+ }
+ }
+ Unlock();
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_TclLibrary --
+ *
+ * This procedure gets (and possibly finds) the root that Tcl's library
+ * files are mounted under.
+ *
+ * Results:
+ * A Tcl object holding the location (with zero refcount), or NULL if no
+ * Tcl library can be found.
+ *
+ * Side effects:
+ * May initialise the cache of where such library files are to be found.
+ * This cache is never cleared.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+#ifdef _WIN32
+#define LIBRARY_SIZE 64
+
+static inline int
+WCharToUtf(
+ const WCHAR *wSrc,
+ char *dst)
+{
+ char *start = dst;
+
+ while (*wSrc != '\0') {
+ dst += Tcl_UniCharToUtf(*wSrc, dst);
+ wSrc++;
+ }
+ *dst = '\0';
+ return (int) (dst - start);
+}
+#endif /* _WIN32 */
+
+Tcl_Obj *
+TclZipfs_TclLibrary(void)
+{
+ Tcl_Obj *vfsInitScript;
+ int found;
+#ifdef _WIN32
+ HMODULE hModule;
+ WCHAR wName[MAX_PATH + LIBRARY_SIZE];
+ char dllName[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+#endif /* _WIN32 */
+
+ /*
+ * Use the cached value if that has been set; we don't want to repeat the
+ * searching and mounting.
+ */
+
+ if (zipfs_literal_tcl_library) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+
+ /*
+ * Look for the library file system within the executable.
+ */
+
+ vfsInitScript = Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",
+ -1);
+ Tcl_IncrRefCount(vfsInitScript);
+ found = Tcl_FSAccess(vfsInitScript, F_OK);
+ Tcl_DecrRefCount(vfsInitScript);
+ if (found == TCL_OK) {
+ zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+
+ /*
+ * Look for the library file system within the DLL/shared library. Note
+ * that we must mount the zip file and dll before releasing to search.
+ */
+
+#if defined(_WIN32)
+ hModule = TclWinGetTclInstance();
+ if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
+ GetModuleFileNameA(hModule, dllName, MAX_PATH);
+ } else {
+ WCharToUtf(wName, dllName);
+ }
+
+ if (ZipfsAppHookFindTclInit(dllName) == TCL_OK) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+#elif /* !_WIN32 && */ defined(CFG_RUNTIME_DLLFILE)
+ if (ZipfsAppHookFindTclInit(
+ CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE) == TCL_OK) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+#endif /* _WIN32 || CFG_RUNTIME_DLLFILE */
+
+ /*
+ * If we're configured to know about a ZIP archive we should use, do that.
+ */
+
+#ifdef CFG_RUNTIME_ZIPFILE
+ if (ZipfsAppHookFindTclInit(
+ CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+ if (ZipfsAppHookFindTclInit(
+ CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE) == TCL_OK) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+ if (ZipfsAppHookFindTclInit(CFG_RUNTIME_ZIPFILE) == TCL_OK) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+#endif /* CFG_RUNTIME_ZIPFILE */
+
+ /*
+ * If anything set the cache (but subsequently failed) go with that
+ * anyway.
+ */
+
+ if (zipfs_literal_tcl_library) {
+ return Tcl_NewStringObj(zipfs_literal_tcl_library, -1);
+ }
+ return NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSTclLibraryObjCmd --
+ *
+ * This procedure is invoked to process the
+ * [::tcl::zipfs::tcl_library_init] command, usually called during the
+ * execution of Tcl's interpreter startup. It returns the root that Tcl's
+ * library files are mounted under.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * May initialise the cache of where such library files are to be found.
+ * This cache is never cleared.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSTclLibraryObjCmd(
+ void *clientData, /* Not used. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Argument objects. */
+{
+ if (!Tcl_IsSafe(interp)) {
+ Tcl_Obj *pResult = TclZipfs_TclLibrary();
+
+ if (!pResult) {
+ pResult = Tcl_NewObj();
+ }
+ Tcl_SetObjResult(interp, pResult);
+ }
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelClose --
+ *
+ * This function is called to close a channel.
+ *
+ * Results:
+ * Always TCL_OK.
+ *
+ * Side effects:
+ * Resources are free'd.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelClose(
+ void *instanceData,
+ Tcl_Interp *interp) /* Current interpreter. */
+{
+ ZipChannel *info = instanceData;
+
+ if (info->iscompr && info->ubuf) {
+ ckfree(info->ubuf);
+ info->ubuf = NULL;
+ }
+ if (info->isEncrypted) {
+ info->isEncrypted = 0;
+ memset(info->keys, 0, sizeof(info->keys));
+ }
+ if (info->isWriting) {
+ ZipEntry *z = info->zipEntryPtr;
+ unsigned char *newdata = attemptckrealloc(info->ubuf, info->numRead);
+
+ if (newdata) {
+ if (z->data) {
+ ckfree(z->data);
+ }
+ z->data = newdata;
+ z->numBytes = z->numCompressedBytes = info->numBytes;
+ z->compressMethod = ZIP_COMPMETH_STORED;
+ z->timestamp = time(NULL);
+ z->isDirectory = 0;
+ z->isEncrypted = 0;
+ z->offset = 0;
+ z->crc32 = 0;
+ } else {
+ ckfree(info->ubuf);
+ }
+ }
+ WriteLock();
+ info->zipFilePtr->numOpen--;
+ Unlock();
+ ckfree(info);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelRead --
+ *
+ * This function is called to read data from channel.
+ *
+ * Results:
+ * Number of bytes read or -1 on error with error number set.
+ *
+ * Side effects:
+ * Data is read and file pointer is advanced.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelRead(
+ void *instanceData,
+ char *buf,
+ int toRead,
+ int *errloc)
+{
+ ZipChannel *info = (ZipChannel *) instanceData;
+ unsigned long nextpos;
+
+ if (info->isDirectory < 0) {
+ /*
+ * Special case: when executable combined with ZIP archive file read
+ * data in front of ZIP, i.e. the executable itself.
+ */
+
+ nextpos = info->numRead + toRead;
+ if (nextpos > info->zipFilePtr->baseOffset) {
+ toRead = info->zipFilePtr->baseOffset - info->numRead;
+ nextpos = info->zipFilePtr->baseOffset;
+ }
+ if (toRead == 0) {
+ return 0;
+ }
+ memcpy(buf, info->zipFilePtr->data, toRead);
+ info->numRead = nextpos;
+ *errloc = 0;
+ return toRead;
+ }
+ if (info->isDirectory) {
+ *errloc = EISDIR;
+ return -1;
+ }
+ nextpos = info->numRead + toRead;
+ if (nextpos > info->numBytes) {
+ toRead = info->numBytes - info->numRead;
+ nextpos = info->numBytes;
+ }
+ if (toRead == 0) {
+ return 0;
+ }
+ if (info->isEncrypted) {
+ int i;
+
+ for (i = 0; i < toRead; i++) {
+ int ch = info->ubuf[i + info->numRead];
+
+ buf[i] = zdecode(info->keys, crc32tab, ch);
+ }
+ } else {
+ memcpy(buf, info->ubuf + info->numRead, toRead);
+ }
+ info->numRead = nextpos;
+ *errloc = 0;
+ return toRead;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelWrite --
+ *
+ * This function is called to write data into channel.
+ *
+ * Results:
+ * Number of bytes written or -1 on error with error number set.
+ *
+ * Side effects:
+ * Data is written and file pointer is advanced.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelWrite(
+ void *instanceData,
+ const char *buf,
+ int toWrite,
+ int *errloc)
+{
+ ZipChannel *info = (ZipChannel *) instanceData;
+ unsigned long nextpos;
+
+ if (!info->isWriting) {
+ *errloc = EINVAL;
+ return -1;
+ }
+ nextpos = info->numRead + toWrite;
+ if (nextpos > info->maxWrite) {
+ toWrite = info->maxWrite - info->numRead;
+ nextpos = info->maxWrite;
+ }
+ if (toWrite == 0) {
+ return 0;
+ }
+ memcpy(info->ubuf + info->numRead, buf, toWrite);
+ info->numRead = nextpos;
+ if (info->numRead > info->numBytes) {
+ info->numBytes = info->numRead;
+ }
+ *errloc = 0;
+ return toWrite;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelSeek --
+ *
+ * This function is called to position file pointer of channel.
+ *
+ * Results:
+ * New file position or -1 on error with error number set.
+ *
+ * Side effects:
+ * File pointer is repositioned according to offset and mode.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelSeek(
+ void *instanceData,
+ long offset,
+ int mode,
+ int *errloc)
+{
+ ZipChannel *info = (ZipChannel *) instanceData;
+ unsigned long end;
+
+ if (!info->isWriting && (info->isDirectory < 0)) {
+ /*
+ * Special case: when executable combined with ZIP archive file, seek
+ * within front of ZIP, i.e. the executable itself.
+ */
+ end = info->zipFilePtr->baseOffset;
+ } else if (info->isDirectory) {
+ *errloc = EINVAL;
+ return -1;
+ } else {
+ end = info->numBytes;
+ }
+ switch (mode) {
+ case SEEK_CUR:
+ offset += info->numRead;
+ break;
+ case SEEK_END:
+ offset += end;
+ break;
+ case SEEK_SET:
+ break;
+ default:
+ *errloc = EINVAL;
+ return -1;
+ }
+ if (offset < 0) {
+ *errloc = EINVAL;
+ return -1;
+ }
+ if (info->isWriting) {
+ if ((unsigned long) offset > info->maxWrite) {
+ *errloc = EINVAL;
+ return -1;
+ }
+ if ((unsigned long) offset > info->numBytes) {
+ info->numBytes = offset;
+ }
+ } else if ((unsigned long) offset > end) {
+ *errloc = EINVAL;
+ return -1;
+ }
+ info->numRead = (unsigned long) offset;
+ return info->numRead;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelWatchChannel --
+ *
+ * This function is called for event notifications on channel. Does
+ * nothing.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+ZipChannelWatchChannel(
+ void *instanceData,
+ int mask)
+{
+ return;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelGetFile --
+ *
+ * This function is called to retrieve OS handle for channel.
+ *
+ * Results:
+ * Always TCL_ERROR since there's never an OS handle for a file within a
+ * ZIP archive.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelGetFile(
+ void *instanceData,
+ int direction,
+ void **handlePtr)
+{
+ return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelOpen --
+ *
+ * This function opens a Tcl_Channel on a file from a mounted ZIP archive
+ * according to given open mode.
+ *
+ * Results:
+ * Tcl_Channel on success, or NULL on error.
+ *
+ * Side effects:
+ * Memory is allocated, the file from the ZIP archive is uncompressed.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+ZipChannelOpen(
+ Tcl_Interp *interp, /* Current interpreter. */
+ char *filename,
+ int mode,
+ int permissions)
+{
+ ZipEntry *z;
+ ZipChannel *info;
+ int i, ch, trunc, wr, flags = 0;
+ char cname[128];
+
+ if ((mode & O_APPEND)
+ || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))) {
+ if (interp) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("unsupported open mode", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "BAD_MODE", NULL);
+ }
+ return NULL;
+ }
+ WriteLock();
+ z = ZipFSLookup(filename);
+ if (!z) {
+ Tcl_SetErrno(ENOENT);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "file not found \"%s\": %s", filename,
+ Tcl_PosixError(interp)));
+ }
+ goto error;
+ }
+ trunc = (mode & O_TRUNC) != 0;
+ wr = (mode & (O_WRONLY | O_RDWR)) != 0;
+ if ((z->compressMethod != ZIP_COMPMETH_STORED)
+ && (z->compressMethod != ZIP_COMPMETH_DEFLATED)) {
+ ZIPFS_ERROR(interp, "unsupported compression method");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "COMP_METHOD", NULL);
+ }
+ goto error;
+ }
+ if (wr && z->isDirectory) {
+ ZIPFS_ERROR(interp, "unsupported file type");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_TYPE", NULL);
+ }
+ goto error;
+ }
+ if (!trunc) {
+ flags |= TCL_READABLE;
+ if (z->isEncrypted && (z->zipFilePtr->passBuf[0] == 0)) {
+ ZIPFS_ERROR(interp, "decryption failed");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "DECRYPT", NULL);
+ }
+ goto error;
+ } else if (wr && !z->data && (z->numBytes > ZipFS.wrmax)) {
+ ZIPFS_ERROR(interp, "file too large");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "FILE_SIZE", NULL);
+ }
+ goto error;
+ }
+ } else {
+ flags = TCL_WRITABLE;
+ }
+ info = attemptckalloc(sizeof(ZipChannel));
+ if (!info) {
+ ZIPFS_ERROR(interp, "out of memory");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ goto error;
+ }
+ info->zipFilePtr = z->zipFilePtr;
+ info->zipEntryPtr = z;
+ info->numRead = 0;
+ if (wr) {
+ flags |= TCL_WRITABLE;
+ info->isWriting = 1;
+ info->isDirectory = 0;
+ info->maxWrite = ZipFS.wrmax;
+ info->iscompr = 0;
+ info->isEncrypted = 0;
+ info->ubuf = attemptckalloc(info->maxWrite);
+ if (!info->ubuf) {
+ merror0:
+ if (info->ubuf) {
+ ckfree(info->ubuf);
+ }
+ ckfree(info);
+ ZIPFS_ERROR(interp, "out of memory");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ goto error;
+ }
+ memset(info->ubuf, 0, info->maxWrite);
+ if (trunc) {
+ info->numBytes = 0;
+ } else if (z->data) {
+ unsigned int j = z->numBytes;
+
+ if (j > info->maxWrite) {
+ j = info->maxWrite;
+ }
+ memcpy(info->ubuf, z->data, j);
+ info->numBytes = j;
+ } else {
+ unsigned char *zbuf = z->zipFilePtr->data + z->offset;
+
+ if (z->isEncrypted) {
+ int len = z->zipFilePtr->passBuf[0] & 0xFF;
+ char passBuf[260];
+
+ for (i = 0; i < len; i++) {
+ ch = z->zipFilePtr->passBuf[len - i];
+ passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+ }
+ passBuf[i] = '\0';
+ init_keys(passBuf, info->keys, crc32tab);
+ memset(passBuf, 0, sizeof(passBuf));
+ for (i = 0; i < 12; i++) {
+ ch = info->ubuf[i];
+ zdecode(info->keys, crc32tab, ch);
+ }
+ zbuf += i;
+ }
+ if (z->compressMethod == ZIP_COMPMETH_DEFLATED) {
+ z_stream stream;
+ int err;
+ unsigned char *cbuf = NULL;
+
+ memset(&stream, 0, sizeof(z_stream));
+ stream.zalloc = Z_NULL;
+ stream.zfree = Z_NULL;
+ stream.opaque = Z_NULL;
+ stream.avail_in = z->numCompressedBytes;
+ if (z->isEncrypted) {
+ unsigned int j;
+
+ stream.avail_in -= 12;
+ cbuf = attemptckalloc(stream.avail_in);
+ if (!cbuf) {
+ goto merror0;
+ }
+ for (j = 0; j < stream.avail_in; j++) {
+ ch = info->ubuf[j];
+ cbuf[j] = zdecode(info->keys, crc32tab, ch);
+ }
+ stream.next_in = cbuf;
+ } else {
+ stream.next_in = zbuf;
+ }
+ stream.next_out = info->ubuf;
+ stream.avail_out = info->maxWrite;
+ if (inflateInit2(&stream, -15) != Z_OK) {
+ goto cerror0;
+ }
+ err = inflate(&stream, Z_SYNC_FLUSH);
+ inflateEnd(&stream);
+ if ((err == Z_STREAM_END)
+ || ((err == Z_OK) && (stream.avail_in == 0))) {
+ if (cbuf) {
+ memset(info->keys, 0, sizeof(info->keys));
+ ckfree(cbuf);
+ }
+ goto wrapchan;
+ }
+ cerror0:
+ if (cbuf) {
+ memset(info->keys, 0, sizeof(info->keys));
+ ckfree(cbuf);
+ }
+ if (info->ubuf) {
+ ckfree(info->ubuf);
+ }
+ ckfree(info);
+ ZIPFS_ERROR(interp, "decompression error");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
+ }
+ goto error;
+ } else if (z->isEncrypted) {
+ for (i = 0; i < z->numBytes - 12; i++) {
+ ch = zbuf[i];
+ info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
+ }
+ } else {
+ memcpy(info->ubuf, zbuf, z->numBytes);
+ }
+ memset(info->keys, 0, sizeof(info->keys));
+ goto wrapchan;
+ }
+ } else if (z->data) {
+ flags |= TCL_READABLE;
+ info->isWriting = 0;
+ info->iscompr = 0;
+ info->isDirectory = 0;
+ info->isEncrypted = 0;
+ info->numBytes = z->numBytes;
+ info->maxWrite = 0;
+ info->ubuf = z->data;
+ } else {
+ flags |= TCL_READABLE;
+ info->isWriting = 0;
+ info->iscompr = (z->compressMethod == ZIP_COMPMETH_DEFLATED);
+ info->ubuf = z->zipFilePtr->data + z->offset;
+ info->isDirectory = z->isDirectory;
+ info->isEncrypted = z->isEncrypted;
+ info->numBytes = z->numBytes;
+ info->maxWrite = 0;
+ if (info->isEncrypted) {
+ int len = z->zipFilePtr->passBuf[0] & 0xFF;
+ char passBuf[260];
+
+ for (i = 0; i < len; i++) {
+ ch = z->zipFilePtr->passBuf[len - i];
+ passBuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+ }
+ passBuf[i] = '\0';
+ init_keys(passBuf, info->keys, crc32tab);
+ memset(passBuf, 0, sizeof(passBuf));
+ for (i = 0; i < 12; i++) {
+ ch = info->ubuf[i];
+ zdecode(info->keys, crc32tab, ch);
+ }
+ info->ubuf += i;
+ }
+ if (info->iscompr) {
+ z_stream stream;
+ int err;
+ unsigned char *ubuf = NULL;
+ unsigned int j;
+
+ memset(&stream, 0, sizeof(z_stream));
+ stream.zalloc = Z_NULL;
+ stream.zfree = Z_NULL;
+ stream.opaque = Z_NULL;
+ stream.avail_in = z->numCompressedBytes;
+ if (info->isEncrypted) {
+ stream.avail_in -= 12;
+ ubuf = attemptckalloc(stream.avail_in);
+ if (!ubuf) {
+ info->ubuf = NULL;
+ goto merror;
+ }
+ for (j = 0; j < stream.avail_in; j++) {
+ ch = info->ubuf[j];
+ ubuf[j] = zdecode(info->keys, crc32tab, ch);
+ }
+ stream.next_in = ubuf;
+ } else {
+ stream.next_in = info->ubuf;
+ }
+ stream.next_out = info->ubuf = attemptckalloc(info->numBytes);
+ if (!info->ubuf) {
+ merror:
+ if (ubuf) {
+ info->isEncrypted = 0;
+ memset(info->keys, 0, sizeof(info->keys));
+ ckfree(ubuf);
+ }
+ ckfree(info);
+ if (interp) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("out of memory", -1));
+ Tcl_SetErrorCode(interp, "TCL", "MALLOC", NULL);
+ }
+ goto error;
+ }
+ stream.avail_out = info->numBytes;
+ if (inflateInit2(&stream, -15) != Z_OK) {
+ goto cerror;
+ }
+ err = inflate(&stream, Z_SYNC_FLUSH);
+ inflateEnd(&stream);
+ if ((err == Z_STREAM_END)
+ || ((err == Z_OK) && (stream.avail_in == 0))) {
+ if (ubuf) {
+ info->isEncrypted = 0;
+ memset(info->keys, 0, sizeof(info->keys));
+ ckfree(ubuf);
+ }
+ goto wrapchan;
+ }
+ cerror:
+ if (ubuf) {
+ info->isEncrypted = 0;
+ memset(info->keys, 0, sizeof(info->keys));
+ ckfree(ubuf);
+ }
+ if (info->ubuf) {
+ ckfree(info->ubuf);
+ }
+ ckfree(info);
+ ZIPFS_ERROR(interp, "decompression error");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "CORRUPT", NULL);
+ }
+ goto error;
+ } else if (info->isEncrypted) {
+ unsigned char *ubuf = NULL;
+ unsigned int j, len;
+
+ /*
+ * Decode encrypted but uncompressed file, since we support
+ * Tcl_Seek() on it, and it can be randomly accessed later.
+ */
+
+ len = z->numCompressedBytes - 12;
+ ubuf = (unsigned char *) attemptckalloc(len);
+ if (ubuf == NULL) {
+ ckfree((char *) info);
+ if (interp != NULL) {
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("out of memory", -1));
+ }
+ goto error;
+ }
+ for (j = 0; j < len; j++) {
+ ch = info->ubuf[j];
+ ubuf[j] = zdecode(info->keys, crc32tab, ch);
+ }
+ info->ubuf = ubuf;
+ info->isEncrypted = 0;
+ }
+ }
+
+ wrapchan:
+ sprintf(cname, "zipfs_%" TCL_LL_MODIFIER "x_%d", z->offset,
+ ZipFS.idCount++);
+ z->zipFilePtr->numOpen++;
+ Unlock();
+ return Tcl_CreateChannel(&ZipChannelType, cname, info, flags);
+
+ error:
+ Unlock();
+ return NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipEntryStat --
+ *
+ * This function implements the ZIP filesystem specific version of the
+ * library version of stat.
+ *
+ * Results:
+ * See stat documentation.
+ *
+ * Side effects:
+ * See stat documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipEntryStat(
+ char *path,
+ Tcl_StatBuf *buf)
+{
+ ZipEntry *z;
+ int ret = -1;
+
+ ReadLock();
+ z = ZipFSLookup(path);
+ if (z) {
+ memset(buf, 0, sizeof(Tcl_StatBuf));
+ if (z->isDirectory) {
+ buf->st_mode = S_IFDIR | 0555;
+ } else {
+ buf->st_mode = S_IFREG | 0555;
+ }
+ buf->st_size = z->numBytes;
+ buf->st_mtime = z->timestamp;
+ buf->st_ctime = z->timestamp;
+ buf->st_atime = z->timestamp;
+ ret = 0;
+ }
+ Unlock();
+ return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipEntryAccess --
+ *
+ * This function implements the ZIP filesystem specific version of the
+ * library version of access.
+ *
+ * Results:
+ * See access documentation.
+ *
+ * Side effects:
+ * See access documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipEntryAccess(
+ char *path,
+ int mode)
+{
+ ZipEntry *z;
+
+ if (mode & 3) {
+ return -1;
+ }
+ ReadLock();
+ z = ZipFSLookup(path);
+ Unlock();
+ return (z ? 0 : -1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSOpenFileChannelProc --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+ZipFSOpenFileChannelProc(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *pathPtr,
+ int mode,
+ int permissions)
+{
+ int len;
+
+ pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (!pathPtr) {
+ return NULL;
+ }
+ return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode,
+ permissions);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSStatProc --
+ *
+ * This function implements the ZIP filesystem specific version of the
+ * library version of stat.
+ *
+ * Results:
+ * See stat documentation.
+ *
+ * Side effects:
+ * See stat documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSStatProc(
+ Tcl_Obj *pathPtr,
+ Tcl_StatBuf *buf)
+{
+ int len;
+
+ pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (!pathPtr) {
+ return -1;
+ }
+ return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSAccessProc --
+ *
+ * This function implements the ZIP filesystem specific version of the
+ * library version of access.
+ *
+ * Results:
+ * See access documentation.
+ *
+ * Side effects:
+ * See access documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSAccessProc(
+ Tcl_Obj *pathPtr,
+ int mode)
+{
+ int len;
+
+ pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (!pathPtr) {
+ return -1;
+ }
+ return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSFilesystemSeparatorProc --
+ *
+ * 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, and should
+ * otherwise free the object.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ZipFSFilesystemSeparatorProc(
+ Tcl_Obj *pathPtr)
+{
+ return Tcl_NewStringObj("/", -1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMatchInDirectoryProc --
+ *
+ * This routine is used by the globbing code to search a directory for
+ * all files which match a given pattern.
+ *
+ * Results:
+ * The return value is a standard Tcl result indicating whether an error
+ * occurred in globbing. Errors are left in interp, good results are
+ * lappend'ed to resultPtr (which must be a valid object).
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMatchInDirectoryProc(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *result,
+ Tcl_Obj *pathPtr,
+ const char *pattern,
+ Tcl_GlobTypeData *types)
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_Obj *normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ int scnt, l, dirOnly = -1, prefixLen, strip = 0;
+ size_t len;
+ char *pat, *prefix, *path;
+ Tcl_DString dsPref;
+
+ if (!normPathPtr) {
+ return -1;
+ }
+ if (types) {
+ dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
+ }
+
+ /*
+ * The prefix that gets prepended to results.
+ */
+
+ prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);
+
+ /*
+ * The (normalized) path we're searching.
+ */
+
+ path = Tcl_GetString(normPathPtr);
+ len = normPathPtr->length;
+
+ Tcl_DStringInit(&dsPref);
+ Tcl_DStringAppend(&dsPref, prefix, prefixLen);
+
+ if (strcmp(prefix, path) == 0) {
+ prefix = NULL;
+ } else {
+ strip = len + 1;
+ }
+ if (prefix) {
+ Tcl_DStringAppend(&dsPref, "/", 1);
+ prefixLen++;
+ prefix = Tcl_DStringValue(&dsPref);
+ }
+ ReadLock();
+ if (types && (types->type == TCL_GLOB_TYPE_MOUNT)) {
+ l = CountSlashes(path);
+ if (path[len - 1] == '/') {
+ len--;
+ } else {
+ l++;
+ }
+ if (!pattern || (pattern[0] == '\0')) {
+ pattern = "*";
+ }
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ ZipFile *zf = Tcl_GetHashValue(hPtr);
+
+ if (zf->mountPointLen == 0) {
+ ZipEntry *z;
+
+ for (z = zf->topEnts; z; z = z->tnext) {
+ size_t lenz = strlen(z->name);
+
+ if ((lenz > len + 1) && (strncmp(z->name, path, len) == 0)
+ && (z->name[len] == '/')
+ && (CountSlashes(z->name) == l)
+ && Tcl_StringCaseMatch(z->name + len + 1, pattern,
+ 0)) {
+ if (prefix) {
+ Tcl_DStringAppend(&dsPref, z->name, lenz);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+ Tcl_DStringLength(&dsPref)));
+ Tcl_DStringSetLength(&dsPref, prefixLen);
+ } else {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(z->name, lenz));
+ }
+ }
+ }
+ } else if ((zf->mountPointLen > len + 1)
+ && (strncmp(zf->mountPoint, path, len) == 0)
+ && (zf->mountPoint[len] == '/')
+ && (CountSlashes(zf->mountPoint) == l)
+ && Tcl_StringCaseMatch(zf->mountPoint + len + 1,
+ pattern, 0)) {
+ if (prefix) {
+ Tcl_DStringAppend(&dsPref, zf->mountPoint,
+ zf->mountPointLen);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+ Tcl_DStringLength(&dsPref)));
+ Tcl_DStringSetLength(&dsPref, prefixLen);
+ } else {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(zf->mountPoint,
+ zf->mountPointLen));
+ }
+ }
+ }
+ goto end;
+ }
+
+ if (!pattern || (pattern[0] == '\0')) {
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
+ if (hPtr) {
+ ZipEntry *z = Tcl_GetHashValue(hPtr);
+
+ if ((dirOnly < 0) || (!dirOnly && !z->isDirectory)
+ || (dirOnly && z->isDirectory)) {
+ if (prefix) {
+ Tcl_DStringAppend(&dsPref, z->name, -1);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+ Tcl_DStringLength(&dsPref)));
+ Tcl_DStringSetLength(&dsPref, prefixLen);
+ } else {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(z->name, -1));
+ }
+ }
+ }
+ goto end;
+ }
+
+ l = strlen(pattern);
+ pat = ckalloc(len + l + 2);
+ memcpy(pat, path, len);
+ while ((len > 1) && (pat[len - 1] == '/')) {
+ --len;
+ }
+ if ((len > 1) || (pat[0] != '/')) {
+ pat[len] = '/';
+ ++len;
+ }
+ memcpy(pat + len, pattern, l + 1);
+ scnt = CountSlashes(pat);
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+ hPtr; hPtr = Tcl_NextHashEntry(&search)) {
+ ZipEntry *z = Tcl_GetHashValue(hPtr);
+
+ if ((dirOnly >= 0) && ((dirOnly && !z->isDirectory)
+ || (!dirOnly && z->isDirectory))) {
+ continue;
+ }
+ if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
+ if (prefix) {
+ Tcl_DStringAppend(&dsPref, z->name + strip, -1);
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+ Tcl_DStringLength(&dsPref)));
+ Tcl_DStringSetLength(&dsPref, prefixLen);
+ } else {
+ Tcl_ListObjAppendElement(NULL, result,
+ Tcl_NewStringObj(z->name + strip, -1));
+ }
+ }
+ }
+ ckfree(pat);
+
+ end:
+ Unlock();
+ Tcl_DStringFree(&dsPref);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSPathInFilesystemProc --
+ *
+ * This function determines if the given path object is in the ZIP
+ * filesystem.
+ *
+ * Results:
+ * TCL_OK when the path object is in the ZIP filesystem, -1 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSPathInFilesystemProc(
+ Tcl_Obj *pathPtr,
+ void **clientDataPtr)
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ int ret = -1;
+ size_t len;
+ char *path;
+
+ pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (!pathPtr) {
+ return -1;
+ }
+
+ path = Tcl_GetString(pathPtr);
+ if (strncmp(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN) != 0) {
+ return -1;
+ }
+
+ len = pathPtr->length;
+
+ ReadLock();
+ hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
+ if (hPtr) {
+ ret = TCL_OK;
+ goto endloop;
+ }
+
+ for (hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search); hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ ZipFile *zf = Tcl_GetHashValue(hPtr);
+
+ if (zf->mountPointLen == 0) {
+ ZipEntry *z;
+
+ for (z = zf->topEnts; z != NULL; z = z->tnext) {
+ size_t lenz = strlen(z->name);
+
+ if ((len >= lenz) && (strncmp(path, z->name, lenz) == 0)) {
+ ret = TCL_OK;
+ goto endloop;
+ }
+ }
+ } else if ((len >= zf->mountPointLen) &&
+ (strncmp(path, zf->mountPoint, zf->mountPointLen) == 0)) {
+ ret = TCL_OK;
+ break;
+ }
+ }
+
+ endloop:
+ Unlock();
+ return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSListVolumesProc --
+ *
+ * Lists the currently mounted ZIP filesystem volumes.
+ *
+ * Results:
+ * The list of volumes.
+ *
+ * Side effects:
+ * None
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ZipFSListVolumesProc(void)
+{
+ return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSFileAttrStringsProc --
+ *
+ * This function implements the ZIP filesystem dependent 'file
+ * attributes' subcommand, for listing the set of possible attribute
+ * strings.
+ *
+ * Results:
+ * An array of strings
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static const char *const *
+ZipFSFileAttrStringsProc(
+ Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
+{
+ static const char *const attrs[] = {
+ "-uncompsize",
+ "-compsize",
+ "-offset",
+ "-mount",
+ "-archive",
+ "-permissions",
+ NULL,
+ };
+ return attrs;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSFileAttrsGetProc --
+ *
+ * This function implements the ZIP filesystem specific 'file attributes'
+ * subcommand, for 'get' operations.
+ *
+ * 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
+ZipFSFileAttrsGetProc(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int index,
+ Tcl_Obj *pathPtr,
+ Tcl_Obj **objPtrRef)
+{
+ int len, ret = TCL_OK;
+ char *path;
+ ZipEntry *z;
+
+ pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr);
+ if (!pathPtr) {
+ return -1;
+ }
+ path = Tcl_GetStringFromObj(pathPtr, &len);
+ ReadLock();
+ z = ZipFSLookup(path);
+ if (!z) {
+ Tcl_SetErrno(ENOENT);
+ ZIPFS_POSIX_ERROR(interp, "file not found");
+ ret = TCL_ERROR;
+ goto done;
+ }
+ switch (index) {
+ case 0:
+ *objPtrRef = Tcl_NewWideIntObj(z->numBytes);
+ break;
+ case 1:
+ *objPtrRef = Tcl_NewWideIntObj(z->numCompressedBytes);
+ break;
+ case 2:
+ *objPtrRef = Tcl_NewWideIntObj(z->offset);
+ break;
+ case 3:
+ *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->mountPoint,
+ z->zipFilePtr->mountPointLen);
+ break;
+ case 4:
+ *objPtrRef = Tcl_NewStringObj(z->zipFilePtr->name, -1);
+ break;
+ case 5:
+ *objPtrRef = Tcl_NewStringObj("0o555", -1);
+ break;
+ default:
+ ZIPFS_ERROR(interp, "unknown attribute");
+ ret = TCL_ERROR;
+ }
+
+ done:
+ Unlock();
+ return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSFileAttrsSetProc --
+ *
+ * This function implements the ZIP filesystem specific 'file attributes'
+ * subcommand, for 'set' operations.
+ *
+ * Results:
+ * Standard Tcl return code.
+ *
+ * Side effects:
+ * None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSFileAttrsSetProc(
+ Tcl_Interp *interp, /* Current interpreter. */
+ int index,
+ Tcl_Obj *pathPtr,
+ Tcl_Obj *objPtr)
+{
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "UNSUPPORTED_OP", NULL);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSFilesystemPathTypeProc --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+ZipFSFilesystemPathTypeProc(
+ Tcl_Obj *pathPtr)
+{
+ return Tcl_NewStringObj("zip", -1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSLoadFile --
+ *
+ * This functions deals with loading native object code. If the given
+ * path object refers to a file within the ZIP filesystem, an approriate
+ * error code is returned to delegate loading to the caller (by copying
+ * the file to temp store and loading from there). As fallback when the
+ * file refers to the ZIP file system but is not present, it is looked up
+ * relative to the executable and loaded from there when available.
+ *
+ * Results:
+ * TCL_OK on success, TCL_ERROR otherwise with error message left.
+ *
+ * Side effects:
+ * Loads native code into the process address space.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSLoadFile(
+ Tcl_Interp *interp, /* Current interpreter. */
+ Tcl_Obj *path,
+ Tcl_LoadHandle *loadHandle,
+ Tcl_FSUnloadFileProc **unloadProcPtr,
+ int flags)
+{
+ Tcl_FSLoadFileProc2 *loadFileProc;
+#ifdef ANDROID
+ /*
+ * Force loadFileProc to native implementation since the package manager
+ * already extracted the shared libraries from the APK at install time.
+ */
+
+ loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
+ if (loadFileProc) {
+ return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
+ }
+ Tcl_SetErrno(ENOENT);
+ ZIPFS_ERROR(interp, Tcl_PosixError(interp));
+ return TCL_ERROR;
+#else /* !ANDROID */
+ Tcl_Obj *altPath = NULL;
+ int ret = TCL_ERROR;
+ Tcl_Obj *objs[2] = { NULL, NULL };
+
+ if (Tcl_FSAccess(path, R_OK) == 0) {
+ /*
+ * EXDEV should trigger loading by copying to temp store.
+ */
+
+ Tcl_SetErrno(EXDEV);
+ ZIPFS_ERROR(interp, Tcl_PosixError(interp));
+ return ret;
+ }
+
+ objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME);
+ if (objs[1] && (ZipFSAccessProc(objs[1], R_OK) == 0)) {
+ const char *execName = Tcl_GetNameOfExecutable();
+
+ /*
+ * Shared object is not in ZIP but its path prefix is, thus try to
+ * load from directory where the executable came from.
+ */
+
+ TclDecrRefCount(objs[1]);
+ objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL);
+
+ /*
+ * Get directory name of executable manually to deal with cases where
+ * [file dirname [info nameofexecutable]] is equal to [info
+ * nameofexecutable] due to VFS effects.
+ */
+
+ if (execName) {
+ const char *p = strrchr(execName, '/');
+
+ if (p > execName + 1) {
+ --p;
+ objs[0] = Tcl_NewStringObj(execName, p - execName);
+ }
+ }
+ if (!objs[0]) {
+ objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
+ TCL_PATH_DIRNAME);
+ }
+ if (objs[0]) {
+ altPath = TclJoinPath(2, objs, 0);
+ if (altPath) {
+ Tcl_IncrRefCount(altPath);
+ if (Tcl_FSAccess(altPath, R_OK) == 0) {
+ path = altPath;
+ }
+ }
+ }
+ }
+ if (objs[0]) {
+ Tcl_DecrRefCount(objs[0]);
+ }
+ if (objs[1]) {
+ Tcl_DecrRefCount(objs[1]);
+ }
+
+ loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
+ if (loadFileProc) {
+ ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
+ } else {
+ Tcl_SetErrno(ENOENT);
+ ZIPFS_ERROR(interp, Tcl_PosixError(interp));
+ }
+ if (altPath) {
+ Tcl_DecrRefCount(altPath);
+ }
+ return ret;
+#endif /* ANDROID */
+}
+
+#endif /* HAVE_ZLIB */
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Init --
+ *
+ * Perform per interpreter initialization of this module.
+ *
+ * Results:
+ * The return value is a standard Tcl result.
+ *
+ * Side effects:
+ * Initializes this module if not already initialized, and adds module
+ * related commands to the given interpreter.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int
+TclZipfs_Init(
+ Tcl_Interp *interp) /* Current interpreter. */
+{
+#ifdef HAVE_ZLIB
+ static const EnsembleImplMap initMap[] = {
+ {"mkimg", ZipFSMkImgObjCmd, NULL, NULL, NULL, 1},
+ {"mkzip", ZipFSMkZipObjCmd, NULL, NULL, NULL, 1},
+ {"lmkimg", ZipFSLMkImgObjCmd, NULL, NULL, NULL, 1},
+ {"lmkzip", ZipFSLMkZipObjCmd, NULL, NULL, NULL, 1},
+ /* The 4 entries above are not available in safe interpreters */
+ {"mount", ZipFSMountObjCmd, NULL, NULL, NULL, 1},
+ {"mount_data", ZipFSMountBufferObjCmd, NULL, NULL, NULL, 1},
+ {"unmount", ZipFSUnmountObjCmd, NULL, NULL, NULL, 1},
+ {"mkkey", ZipFSMkKeyObjCmd, NULL, NULL, NULL, 1},
+ {"exists", ZipFSExistsObjCmd, NULL, NULL, NULL, 0},
+ {"info", ZipFSInfoObjCmd, NULL, NULL, NULL, 0},
+ {"list", ZipFSListObjCmd, NULL, NULL, NULL, 0},
+ {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 0},
+ {"root", ZipFSRootObjCmd, NULL, NULL, NULL, 0},
+ {NULL, NULL, NULL, NULL, NULL, 0}
+ };
+ static const char findproc[] =
+ "namespace eval ::tcl::zipfs {}\n"
+ "proc ::tcl::zipfs::Find dir {\n"
+ " set result {}\n"
+ " if {[catch {glob -directory $dir -nocomplain * .*} list]} {\n"
+ " return $result\n"
+ " }\n"
+ " foreach file $list {\n"
+ " if {[file tail $file] in {. ..}} {\n"
+ " continue\n"
+ " }\n"
+ " lappend result $file {*}[Find $file]\n"
+ " }\n"
+ " return $result\n"
+ "}\n"
+ "proc ::tcl::zipfs::find {directoryName} {\n"
+ " return [lsort [Find $directoryName]]\n"
+ "}\n";
+
+ /*
+ * One-time initialization.
+ */
+
+ WriteLock();
+ if (!ZipFS.initialized) {
+ ZipfsSetup();
+ }
+ Unlock();
+
+ if (interp) {
+ Tcl_Command ensemble;
+ Tcl_Obj *mapObj;
+
+ Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
+ Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,
+ TCL_LINK_INT);
+ ensemble = TclMakeEnsemble(interp, "zipfs",
+ Tcl_IsSafe(interp) ? (initMap + 4) : initMap);
+
+ /*
+ * Add the [zipfs find] subcommand.
+ */
+
+ Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
+ Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
+ Tcl_NewStringObj("::tcl::zipfs::find", -1));
+ Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
+ ZipFSTclLibraryObjCmd, NULL, NULL);
+ Tcl_PkgProvide(interp, "zipfs", "2.0");
+ }
+ return TCL_OK;
+#else /* !HAVE_ZLIB */
+ ZIPFS_ERROR(interp, "no zlib available");
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
+ return TCL_ERROR;
+#endif /* HAVE_ZLIB */
+}
+
+static int
+ZipfsAppHookFindTclInit(
+ const char *archive)
+{
+ Tcl_Obj *vfsInitScript;
+ int found;
+
+ if (zipfs_literal_tcl_library) {
+ return TCL_ERROR;
+ }
+ if (TclZipfs_Mount(NULL, ZIPFS_ZIP_MOUNT, archive, NULL)) {
+ /* Either the file doesn't exist or it is not a zip archive */
+ return TCL_ERROR;
+ }
+
+ TclNewLiteralStringObj(vfsInitScript, ZIPFS_ZIP_MOUNT "/init.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ found = Tcl_FSAccess(vfsInitScript, F_OK);
+ Tcl_DecrRefCount(vfsInitScript);
+ if (found == 0) {
+ zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT;
+ return TCL_OK;
+ }
+
+ TclNewLiteralStringObj(vfsInitScript,
+ ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ found = Tcl_FSAccess(vfsInitScript, F_OK);
+ Tcl_DecrRefCount(vfsInitScript);
+ if (found == 0) {
+ zipfs_literal_tcl_library = ZIPFS_ZIP_MOUNT "/tcl_library";
+ return TCL_OK;
+ }
+
+ return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_AppHook --
+ *
+ * Performs the argument munging for the shell
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_AppHook(
+ int *argcPtr, /* Pointer to argc */
+#ifdef _WIN32
+ TCHAR
+#else /* !_WIN32 */
+ char
+#endif /* _WIN32 */
+ ***argvPtr) /* Pointer to argv */
+{
+ char *archive;
+
+ Tcl_FindExecutable((*argvPtr)[0]);
+ archive = (char *) Tcl_GetNameOfExecutable();
+ TclZipfs_Init(NULL);
+
+ /*
+ * Look for init.tcl in one of the locations mounted later in this
+ * function.
+ */
+
+ if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
+ int found;
+ Tcl_Obj *vfsInitScript;
+
+ TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
+ /*
+ * Startup script should be set before calling Tcl_AppInit
+ */
+
+ Tcl_SetStartupScript(vfsInitScript, NULL);
+ } else {
+ Tcl_DecrRefCount(vfsInitScript);
+ }
+
+ /*
+ * Set Tcl Encodings
+ */
+
+ if (!zipfs_literal_tcl_library) {
+ TclNewLiteralStringObj(vfsInitScript,
+ ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ found = Tcl_FSAccess(vfsInitScript, F_OK);
+ Tcl_DecrRefCount(vfsInitScript);
+ if (found == TCL_OK) {
+ zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+ return TCL_OK;
+ }
+ }
+#ifdef SUPPORT_BUILTIN_ZIP_INSTALL
+ } else if (*argcPtr > 1) {
+ /*
+ * If the first argument is "install", run the supplied installer
+ * script.
+ */
+
+#ifdef _WIN32
+ Tcl_DString ds;
+
+ archive = Tcl_WinTCharToUtf((*argvPtr)[1], -1, &ds);
+#else /* !_WIN32 */
+ archive = (*argvPtr)[1];
+#endif /* _WIN32 */
+ if (strcmp(archive, "install") == 0) {
+ Tcl_Obj *vfsInitScript;
+
+ /*
+ * Run this now to ensure the file is present by the time Tcl_Main
+ * wants it.
+ */
+
+ TclZipfs_TclLibrary();
+ TclNewLiteralStringObj(vfsInitScript,
+ ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
+ Tcl_SetStartupScript(vfsInitScript, NULL);
+ }
+ return TCL_OK;
+ } else if (!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
+ int found;
+ Tcl_Obj *vfsInitScript;
+
+ TclNewLiteralStringObj(vfsInitScript, ZIPFS_APP_MOUNT "/main.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ if (Tcl_FSAccess(vfsInitScript, F_OK) == 0) {
+ /*
+ * Startup script should be set before calling Tcl_AppInit
+ */
+
+ Tcl_SetStartupScript(vfsInitScript, NULL);
+ } else {
+ Tcl_DecrRefCount(vfsInitScript);
+ }
+ /* Set Tcl Encodings */
+ TclNewLiteralStringObj(vfsInitScript,
+ ZIPFS_APP_MOUNT "/tcl_library/init.tcl");
+ Tcl_IncrRefCount(vfsInitScript);
+ found = Tcl_FSAccess(vfsInitScript, F_OK);
+ Tcl_DecrRefCount(vfsInitScript);
+ if (found == TCL_OK) {
+ zipfs_literal_tcl_library = ZIPFS_APP_MOUNT "/tcl_library";
+ return TCL_OK;
+ }
+ }
+#ifdef _WIN32
+ Tcl_DStringFree(&ds);
+#endif /* _WIN32 */
+#endif /* SUPPORT_BUILTIN_ZIP_INSTALL */
+ }
+ return TCL_OK;
+}
+
+#ifndef HAVE_ZLIB
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Mount, TclZipfs_MountBuffer, TclZipfs_Unmount --
+ *
+ * Dummy version when no ZLIB support available.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Mount(
+ Tcl_Interp *interp, /* Current interpreter. */
+ const char *mountPoint, /* Mount point path. */
+ const char *zipname, /* Path to ZIP file to mount. */
+ const char *passwd) /* Password for opening the ZIP, or NULL if
+ * the ZIP is unprotected. */
+{
+ ZIPFS_ERROR(interp, "no zlib available");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
+ }
+ return TCL_ERROR;
+}
+
+int
+TclZipfs_MountBuffer(
+ Tcl_Interp *interp, /* Current interpreter. NULLable. */
+ const char *mountPoint, /* Mount point path. */
+ unsigned char *data,
+ size_t datalen,
+ int copy)
+{
+ ZIPFS_ERROR(interp, "no zlib available");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
+ }
+ return TCL_ERROR;
+}
+
+int
+TclZipfs_Unmount(
+ Tcl_Interp *interp, /* Current interpreter. */
+ const char *mountPoint) /* Mount point path. */
+{
+ ZIPFS_ERROR(interp, "no zlib available");
+ if (interp) {
+ Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
+ }
+ return TCL_ERROR;
+}
+#endif /* !HAVE_ZLIB */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index aed38c3..32268af 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -117,7 +117,7 @@ typedef struct {
z_stream outStream; /* Structure used by zlib for compression of
* output. */
char *inBuffer, *outBuffer; /* Working buffers. */
- int inAllocated, outAllocated;
+ size_t inAllocated, outAllocated;
/* Sizes of working buffers. */
GzipHeader inHeader; /* Header read from input stream, when
* decompressing a gzip stream. */
@@ -196,7 +196,7 @@ static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr);
static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd);
-static void ZlibTransformTimerRun(ClientData clientData);
+static void ZlibTransformTimerRun(void *clientData);
/*
* Type of zlib-based compressing and decompressing channels.
@@ -440,7 +440,7 @@ GenerateHeader(
if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) {
goto error;
} else if (value != NULL) {
- valueStr = Tcl_GetStringFromObj(value, &len);
+ valueStr = TclGetStringFromObj(value, &len);
Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len,
NULL);
@@ -461,7 +461,7 @@ GenerateHeader(
if (GetValue(interp, dictObj, "filename", &value) != TCL_OK) {
goto error;
} else if (value != NULL) {
- valueStr = Tcl_GetStringFromObj(value, &len);
+ valueStr = TclGetStringFromObj(value, &len);
Tcl_UtfToExternal(NULL, latin1enc, valueStr, len, 0, NULL,
headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, NULL);
headerPtr->nativeFilenameBuf[len] = '\0';
@@ -565,10 +565,10 @@ ExtractHeader(
SetValue(dictObj, "filename", TclDStringToObj(&tmp));
}
if (headerPtr->os != 255) {
- SetValue(dictObj, "os", Tcl_NewIntObj(headerPtr->os));
+ SetValue(dictObj, "os", Tcl_NewWideIntObj(headerPtr->os));
}
if (headerPtr->time != 0 /* magic - no time */) {
- SetValue(dictObj, "time", Tcl_NewLongObj((long) headerPtr->time));
+ SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time));
}
if (headerPtr->text != Z_UNKNOWN) {
SetValue(dictObj, "type",
@@ -593,7 +593,7 @@ SetInflateDictionary(
int length;
unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
- return inflateSetDictionary(strm, bytes, (unsigned) length);
+ return inflateSetDictionary(strm, bytes, length);
}
return Z_OK;
}
@@ -607,7 +607,7 @@ SetDeflateDictionary(
int length;
unsigned char *bytes = Tcl_GetByteArrayFromObj(compDictObj, &length);
- return deflateSetDictionary(strm, bytes, (unsigned) length);
+ return deflateSetDictionary(strm, bytes, length);
}
return Z_OK;
}
@@ -623,7 +623,7 @@ Deflate(
int e;
strm->next_out = (Bytef *) bufferPtr;
- strm->avail_out = (unsigned) bufferSize;
+ strm->avail_out = bufferSize;
e = deflate(strm, flush);
if (writtenPtr != NULL) {
*writtenPtr = bufferSize - strm->avail_out;
@@ -882,7 +882,7 @@ Tcl_ZlibStreamInit(
static void
ZlibStreamCmdDelete(
- ClientData cd)
+ void *cd)
{
ZlibStreamHandle *zshPtr = cd;
@@ -1515,7 +1515,7 @@ Tcl_ZlibStreamGet(
Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
if (itemLen-zshPtr->outPos >= count-dataPos) {
- unsigned len = count - dataPos;
+ size_t len = count - dataPos;
memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
zshPtr->outPos += len;
@@ -1524,7 +1524,7 @@ Tcl_ZlibStreamGet(
zshPtr->outPos = 0;
}
} else {
- unsigned len = itemLen - zshPtr->outPos;
+ size_t len = itemLen - zshPtr->outPos;
memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
dataPos += len;
@@ -1858,7 +1858,7 @@ Tcl_ZlibInflate(
if (headerPtr != NULL) {
ExtractHeader(&header, gzipHeaderDictObj);
SetValue(gzipHeaderDictObj, "size",
- Tcl_NewLongObj((long) stream.total_out));
+ Tcl_NewWideIntObj(stream.total_out));
ckfree(nameBuf);
ckfree(commentBuf);
}
@@ -1894,7 +1894,7 @@ Tcl_ZlibCRC32(
int len)
{
/* Nothing much to do, just wrap the crc32(). */
- return crc32(crc, (Bytef *) buf, (unsigned) len);
+ return crc32(crc, (Bytef *) buf, len);
}
unsigned int
@@ -1903,7 +1903,7 @@ Tcl_ZlibAdler32(
const unsigned char *buf,
int len)
{
- return adler32(adler, (Bytef *) buf, (unsigned) len);
+ return adler32(adler, (Bytef *) buf, len);
}
/*
@@ -1918,7 +1918,7 @@ Tcl_ZlibAdler32(
static int
ZlibCmd(
- ClientData notUsed,
+ void *notUsed,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -2514,7 +2514,7 @@ ZlibPushSubcmd(
static int
ZlibStreamCmd(
- ClientData cd,
+ void *cd,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -2617,7 +2617,7 @@ ZlibStreamCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(Tcl_ZlibStreamEof(zstream)));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(Tcl_ZlibStreamEof(zstream)));
return TCL_OK;
case zs_checksum: /* $strm checksum */
if (objc != 2) {
@@ -2640,7 +2640,7 @@ ZlibStreamCmd(
static int
ZlibStreamAddCmd(
- ClientData cd,
+ void *cd,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -2764,7 +2764,7 @@ ZlibStreamAddCmd(
static int
ZlibStreamPutCmd(
- ClientData cd,
+ void *cd,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -2853,7 +2853,7 @@ ZlibStreamPutCmd(
static int
ZlibStreamHeaderCmd(
- ClientData cd,
+ void *cd,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -2892,7 +2892,7 @@ ZlibStreamHeaderCmd(
static int
ZlibTransformClose(
- ClientData instanceData,
+ void *instanceData,
Tcl_Interp *interp)
{
ZlibChannelData *cd = instanceData;
@@ -2931,7 +2931,7 @@ ZlibTransformClose(
result = TCL_ERROR;
break;
}
- if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) {
+ if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) {
/* TODO: is this the right way to do errors on close?
* Note: when close is called from FinalizeIOSubsystem then
* interp may be NULL */
@@ -2983,7 +2983,7 @@ ZlibTransformClose(
static int
ZlibTransformInput(
- ClientData instanceData,
+ void *instanceData,
char *buf,
int toRead,
int *errorCodePtr)
@@ -3097,7 +3097,7 @@ ZlibTransformInput(
static int
ZlibTransformOutput(
- ClientData instanceData,
+ void *instanceData,
const char *buf,
int toWrite,
int *errorCodePtr)
@@ -3130,7 +3130,7 @@ ZlibTransformOutput(
break;
}
- if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) {
+ if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) {
*errorCodePtr = Tcl_GetErrno();
return -1;
}
@@ -3186,7 +3186,7 @@ ZlibTransformFlush(
* Write the bytes we've received to the next layer.
*/
- if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) < 0) {
+ if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"problem flushing channel: %s",
Tcl_PosixError(interp)));
@@ -3218,7 +3218,7 @@ ZlibTransformFlush(
static int
ZlibTransformSetOption( /* not used */
- ClientData instanceData,
+ void *instanceData,
Tcl_Interp *interp,
const char *optionName,
const char *value)
@@ -3331,7 +3331,7 @@ ZlibTransformSetOption( /* not used */
static int
ZlibTransformGetOption(
- ClientData instanceData,
+ void *instanceData,
Tcl_Interp *interp,
const char *optionName,
Tcl_DString *dsPtr)
@@ -3387,7 +3387,7 @@ ZlibTransformGetOption(
} else {
if (cd->compDictObj) {
int len;
- const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
+ const char *str = TclGetStringFromObj(cd->compDictObj, &len);
Tcl_DStringAppend(dsPtr, str, len);
}
@@ -3451,7 +3451,7 @@ ZlibTransformGetOption(
static void
ZlibTransformWatch(
- ClientData instanceData,
+ void *instanceData,
int mask)
{
ZlibChannelData *cd = instanceData;
@@ -3474,7 +3474,7 @@ ZlibTransformWatch(
static int
ZlibTransformEventHandler(
- ClientData instanceData,
+ void *instanceData,
int interestMask)
{
ZlibChannelData *cd = instanceData;
@@ -3495,7 +3495,7 @@ ZlibTransformEventTimerKill(
static void
ZlibTransformTimerRun(
- ClientData clientData)
+ void *clientData)
{
ZlibChannelData *cd = clientData;
@@ -3516,9 +3516,9 @@ ZlibTransformTimerRun(
static int
ZlibTransformGetHandle(
- ClientData instanceData,
+ void *instanceData,
int direction,
- ClientData *handlePtr)
+ void **handlePtr)
{
ZlibChannelData *cd = instanceData;
@@ -3537,7 +3537,7 @@ ZlibTransformGetHandle(
static int
ZlibTransformBlockMode(
- ClientData instanceData,
+ void *instanceData,
int mode)
{
ZlibChannelData *cd = instanceData;
@@ -3909,6 +3909,12 @@ TclZlibInit(
Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
/*
+ * Allow command type introspection to do something sensible with streams.
+ */
+
+ TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");
+
+ /*
* Formally provide the package as a Tcl built-in.
*/
diff --git a/library/auto.tcl b/library/auto.tcl
index a7a8979..7ef5681 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -74,6 +74,57 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
lappend dirs $env($enVarName)
}
+ catch {
+ set found 0
+ set root [zipfs root]
+ set mountpoint [file join $root lib [string tolower $basename]]
+ lappend dirs [file join $root app ${basename}_library]
+ lappend dirs [file join $root lib $mountpoint ${basename}_library]
+ lappend dirs [file join $root lib $mountpoint]
+ if {![zipfs exists [file join $root app ${basename}_library]] \
+ && ![zipfs exists $mountpoint]} {
+ set found 0
+ foreach pkgdat [info loaded] {
+ lassign $pkgdat dllfile dllpkg
+ if {[string tolower $dllpkg] ne [string tolower $basename]} continue
+ if {$dllfile eq {}} {
+ # Loaded statically
+ break
+ }
+ set found 1
+ zipfs mount $mountpoint $dllfile
+ break
+ }
+ if {!$found} {
+ set paths {}
+ lappend paths [file join $root app]
+ lappend paths [::${basename}::pkgconfig get libdir,runtime]
+ lappend paths [::${basename}::pkgconfig get bindir,runtime]
+ if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
+ set zipfile [string tolower \
+ "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
+ }
+ lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
+ foreach path $paths {
+ set archive [file join $path $zipfile]
+ if {![file exists $archive]} continue
+ zipfs mount $mountpoint $archive
+ if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
+ lappend dirs [file join $mountpoint ${basename}_library]
+ set found 1
+ break
+ } elseif {[zipfs exists [file join $mountpoint $initScript]]} {
+ lappend dirs [file join $mountpoint $initScript]
+ set found 1
+ break
+ } else {
+ catch {zipfs unmount $archive}
+ }
+ }
+ }
+ }
+ }
+
# 2. In the package script directory registered within the
# configuration of the package itself.
diff --git a/library/http/cookiejar.tcl b/library/http/cookiejar.tcl
new file mode 100644
index 0000000..2eae877
--- /dev/null
+++ b/library/http/cookiejar.tcl
@@ -0,0 +1,745 @@
+# cookiejar.tcl --
+#
+# Implementation of an HTTP cookie storage engine using SQLite. The
+# implementation is done as a TclOO class, and includes a punycode
+# encoder and decoder (though only the encoder is currently used).
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# Dependencies
+package require Tcl 8.6
+package require http 2.8.4
+package require sqlite3
+package require tcl::idna 1.0
+
+#
+# Configuration for the cookiejar package, plus basic support procedures.
+#
+
+# This is the class that we are creating
+if {![llength [info commands ::http::cookiejar]]} {
+ ::oo::class create ::http::cookiejar
+}
+
+namespace eval [info object namespace ::http::cookiejar] {
+ proc setInt {*var val} {
+ upvar 1 ${*var} var
+ if {[catch {incr dummy $val} msg]} {
+ return -code error $msg
+ }
+ set var $val
+ }
+ proc setInterval {trigger *var val} {
+ upvar 1 ${*var} var
+ if {![string is integer -strict $val] || $val < 1} {
+ return -code error "expected positive integer but got \"$val\""
+ }
+ set var $val
+ {*}$trigger
+ }
+ proc setBool {*var val} {
+ upvar 1 ${*var} var
+ if {[catch {if {$val} {}} msg]} {
+ return -code error $msg
+ }
+ set var [expr {!!$val}]
+ }
+
+ proc setLog {*var val} {
+ upvar 1 ${*var} var
+ set var [::tcl::prefix match -message "log level" \
+ {debug info warn error} $val]
+ }
+
+ # Keep this in sync with pkgIndex.tcl and with the install directories in
+ # Makefiles
+ variable version 0.1
+
+ variable domainlist \
+ http://publicsuffix.org/list/effective_tld_names.dat
+ variable domainfile \
+ [file join [file dirname [info script]] effective_tld_names.txt.gz]
+ # The list is directed to from http://publicsuffix.org/list/
+ variable loglevel info
+ variable vacuumtrigger 200
+ variable retainlimit 100
+ variable offline false
+ variable purgeinterval 60000
+ variable refreshinterval 10000000
+ variable domaincache {}
+
+ # Some support procedures, none particularly useful in general
+ namespace eval support {
+ # Set up a logger if the http package isn't actually loaded yet.
+ if {![llength [info commands ::http::Log]]} {
+ proc ::http::Log args {
+ # Do nothing by default...
+ }
+ }
+
+ namespace export *
+ proc locn {secure domain path {key ""}} {
+ if {$key eq ""} {
+ format "%s://%s%s" [expr {$secure?"https":"http"}] \
+ [::tcl::idna encode $domain] $path
+ } else {
+ format "%s://%s%s?%s" \
+ [expr {$secure?"https":"http"}] [::tcl::idna encode $domain] \
+ $path $key
+ }
+ }
+ proc splitDomain domain {
+ set pieces [split $domain "."]
+ for {set i [llength $pieces]} {[incr i -1] >= 0} {} {
+ lappend result [join [lrange $pieces $i end] "."]
+ }
+ return $result
+ }
+ proc splitPath path {
+ set pieces [split [string trimleft $path "/"] "/"]
+ for {set j -1} {$j < [llength $pieces]} {incr j} {
+ lappend result /[join [lrange $pieces 0 $j] "/"]
+ }
+ return $result
+ }
+ proc isoNow {} {
+ set ms [clock milliseconds]
+ set ts [expr {$ms / 1000}]
+ set ms [format %03d [expr {$ms % 1000}]]
+ clock format $ts -format "%Y%m%dT%H%M%S.${ms}Z" -gmt 1
+ }
+ proc log {level msg args} {
+ namespace upvar [info object namespace ::http::cookiejar] \
+ loglevel loglevel
+ set who [uplevel 1 self class]
+ set mth [uplevel 1 self method]
+ set map {debug 0 info 1 warn 2 error 3}
+ if {[string map $map $level] >= [string map $map $loglevel]} {
+ set msg [format $msg {*}$args]
+ set LVL [string toupper $level]
+ ::http::Log "[isoNow] $LVL $who $mth - $msg"
+ }
+ }
+ }
+}
+
+# Now we have enough information to provide the package.
+package provide cookiejar \
+ [set [info object namespace ::http::cookiejar]::version]
+
+# The implementation of the cookiejar package
+::oo::define ::http::cookiejar {
+ self {
+ method configure {{optionName "\u0000\u0000"} {optionValue "\u0000\u0000"}} {
+ set tbl {
+ -domainfile {domainfile set}
+ -domainlist {domainlist set}
+ -domainrefresh {refreshinterval setInterval}
+ -loglevel {loglevel setLog}
+ -offline {offline setBool}
+ -purgeold {purgeinterval setInterval}
+ -retain {retainlimit setInt}
+ -vacuumtrigger {vacuumtrigger setInt}
+ }
+ dict lappend tbl -domainrefresh [namespace code {
+ my IntervalTrigger PostponeRefresh
+ }]
+ dict lappend tbl -purgeold [namespace code {
+ my IntervalTrigger PostponePurge
+ }]
+ if {$optionName eq "\u0000\u0000"} {
+ return [dict keys $tbl]
+ }
+ set opt [::tcl::prefix match -message "option" \
+ [dict keys $tbl] $optionName]
+ set setter [lassign [dict get $tbl $opt] varname]
+ namespace upvar [namespace current] $varname var
+ if {$optionValue ne "\u0000\u0000"} {
+ {*}$setter var $optionValue
+ }
+ return $var
+ }
+
+ method IntervalTrigger {method} {
+ # TODO: handle subclassing
+ foreach obj [info class instances [self]] {
+ [info object namespace $obj]::my $method
+ }
+ }
+ }
+
+ variable purgeTimer deletions refreshTimer
+ constructor {{path ""}} {
+ namespace import [info object namespace [self class]]::support::*
+
+ if {$path eq ""} {
+ sqlite3 [namespace current]::db :memory:
+ set storeorigin "constructed cookie store in memory"
+ } else {
+ sqlite3 [namespace current]::db $path
+ db timeout 500
+ set storeorigin "loaded cookie store from $path"
+ }
+
+ set deletions 0
+ db transaction {
+ db eval {
+ --;# Store the persistent cookies in this table.
+ --;# Deletion policy: once they expire, or if explicitly
+ --;# killed.
+ CREATE TABLE IF NOT EXISTS persistentCookies (
+ id INTEGER PRIMARY KEY,
+ secure INTEGER NOT NULL,
+ domain TEXT NOT NULL COLLATE NOCASE,
+ path TEXT NOT NULL,
+ key TEXT NOT NULL,
+ value TEXT NOT NULL,
+ originonly INTEGER NOT NULL,
+ expiry INTEGER NOT NULL,
+ lastuse INTEGER NOT NULL,
+ creation INTEGER NOT NULL);
+ CREATE UNIQUE INDEX IF NOT EXISTS persistentUnique
+ ON persistentCookies (domain, path, key);
+ CREATE INDEX IF NOT EXISTS persistentLookup
+ ON persistentCookies (domain, path);
+
+ --;# Store the session cookies in this table.
+ --;# Deletion policy: at cookiejar instance deletion, if
+ --;# explicitly killed, or if the number of session cookies is
+ --;# too large and the cookie has not been used recently.
+ CREATE TEMP TABLE sessionCookies (
+ id INTEGER PRIMARY KEY,
+ secure INTEGER NOT NULL,
+ domain TEXT NOT NULL COLLATE NOCASE,
+ path TEXT NOT NULL,
+ key TEXT NOT NULL,
+ originonly INTEGER NOT NULL,
+ value TEXT NOT NULL,
+ lastuse INTEGER NOT NULL,
+ creation INTEGER NOT NULL);
+ CREATE UNIQUE INDEX sessionUnique
+ ON sessionCookies (domain, path, key);
+ CREATE INDEX sessionLookup ON sessionCookies (domain, path);
+
+ --;# View to allow for simple looking up of a cookie.
+ --;# Deletion policy: NOT SUPPORTED via this view.
+ CREATE TEMP VIEW cookies AS
+ SELECT id, domain, (
+ CASE originonly WHEN 1 THEN path ELSE '.' || path END
+ ) AS path, key, value, secure, 1 AS persistent
+ FROM persistentCookies
+ UNION
+ SELECT id, domain, (
+ CASE originonly WHEN 1 THEN path ELSE '.' || path END
+ ) AS path, key, value, secure, 0 AS persistent
+ FROM sessionCookies;
+
+ --;# Encoded domain permission policy; if forbidden is 1, no
+ --;# cookie may be ever set for the domain, and if forbidden
+ --;# is 0, cookies *may* be created for the domain (overriding
+ --;# the forbiddenSuper table).
+ --;# Deletion policy: normally not modified.
+ CREATE TABLE IF NOT EXISTS domains (
+ domain TEXT PRIMARY KEY NOT NULL,
+ forbidden INTEGER NOT NULL);
+
+ --;# Domains that may not have a cookie defined for direct
+ --;# child domains of them.
+ --;# Deletion policy: normally not modified.
+ CREATE TABLE IF NOT EXISTS forbiddenSuper (
+ domain TEXT PRIMARY KEY);
+
+ --;# When we last retrieved the domain list.
+ CREATE TABLE IF NOT EXISTS domainCacheMetadata (
+ id INTEGER PRIMARY KEY,
+ retrievalDate INTEGER,
+ installDate INTEGER);
+ }
+
+ set cookieCount "no"
+ db eval {
+ SELECT COUNT(*) AS cookieCount FROM persistentCookies
+ }
+ log info "%s with %s entries" $storeorigin $cookieCount
+
+ my PostponePurge
+
+ if {$path ne ""} {
+ if {[db exists {SELECT 1 FROM domains}]} {
+ my RefreshDomains
+ } else {
+ my InitDomainList
+ my PostponeRefresh
+ }
+ } else {
+ set data [my GetDomainListOffline metadata]
+ my InstallDomainData $data $metadata
+ my PostponeRefresh
+ }
+ }
+ }
+
+ method PostponePurge {} {
+ namespace upvar [info object namespace [self class]] \
+ purgeinterval interval
+ catch {after cancel $purgeTimer}
+ set purgeTimer [after $interval [namespace code {my PurgeCookies}]]
+ }
+
+ method PostponeRefresh {} {
+ namespace upvar [info object namespace [self class]] \
+ refreshinterval interval
+ catch {after cancel $refreshTimer}
+ set refreshTimer [after $interval [namespace code {my RefreshDomains}]]
+ }
+
+ method RefreshDomains {} {
+ # TODO: domain list refresh policy
+ my PostponeRefresh
+ }
+
+ method HttpGet {url {timeout 0} {maxRedirects 5}} {
+ for {set r 0} {$r < $maxRedirects} {incr r} {
+ set tok [::http::geturl $url -timeout $timeout]
+ try {
+ if {[::http::status $tok] eq "timeout"} {
+ return -code error "connection timed out"
+ } elseif {[::http::ncode $tok] == 200} {
+ return [::http::data $tok]
+ } elseif {[::http::ncode $tok] >= 400} {
+ return -code error [::http::error $tok]
+ } elseif {[dict exists [::http::meta $tok] Location]} {
+ set url [dict get [::http::meta $tok] Location]
+ continue
+ }
+ return -code error \
+ "unexpected state: [::http::code $tok]"
+ } finally {
+ ::http::cleanup $tok
+ }
+ }
+ return -code error "too many redirects"
+ }
+ method GetDomainListOnline {metaVar} {
+ upvar 1 $metaVar meta
+ namespace upvar [info object namespace [self class]] \
+ domainlist url domaincache cache
+ lassign $cache when data
+ if {$when > [clock seconds] - 3600} {
+ log debug "using cached value created at %s" \
+ [clock format $when -format {%Y%m%dT%H%M%SZ} -gmt 1]
+ dict set meta retrievalDate $when
+ return $data
+ }
+ log debug "loading domain list from %s" $url
+ try {
+ set when [clock seconds]
+ set data [my HttpGet $url]
+ set cache [list $when $data]
+ # TODO: Should we use the Last-Modified header instead?
+ dict set meta retrievalDate $when
+ return $data
+ } on error msg {
+ log error "failed to fetch list of forbidden cookie domains from %s: %s" \
+ $url $msg
+ return {}
+ }
+ }
+ method GetDomainListOffline {metaVar} {
+ upvar 1 $metaVar meta
+ namespace upvar [info object namespace [self class]] \
+ domainfile filename
+ log debug "loading domain list from %s" $filename
+ try {
+ set f [open $filename]
+ try {
+ if {[string match *.gz $filename]} {
+ zlib push gunzip $f
+ }
+ fconfigure $f -encoding utf-8
+ dict set meta retrievalDate [file mtime $filename]
+ return [read $f]
+ } finally {
+ close $f
+ }
+ } on error {msg opt} {
+ log error "failed to read list of forbidden cookie domains from %s: %s" \
+ $filename $msg
+ return -options $opt $msg
+ }
+ }
+ method InitDomainList {} {
+ namespace upvar [info object namespace [self class]] \
+ offline offline
+ if {!$offline} {
+ try {
+ set data [my GetDomainListOnline metadata]
+ if {[string length $data]} {
+ my InstallDomainData $data $metadata
+ return
+ }
+ } on error {} {
+ log warn "attempting to fall back to built in version"
+ }
+ }
+ set data [my GetDomainListOffline metadata]
+ my InstallDomainData $data $metadata
+ }
+
+ method InstallDomainData {data meta} {
+ set n [db total_changes]
+ db transaction {
+ foreach line [split $data "\n"] {
+ if {[string trim $line] eq ""} {
+ continue
+ } elseif {[string match //* $line]} {
+ continue
+ } elseif {[string match !* $line]} {
+ set line [string range $line 1 end]
+ set idna [string tolower [::tcl::idna encode $line]]
+ set utf [::tcl::idna decode [string tolower $line]]
+ db eval {
+ INSERT OR REPLACE INTO domains (domain, forbidden)
+ VALUES ($utf, 0);
+ }
+ if {$idna ne $utf} {
+ db eval {
+ INSERT OR REPLACE INTO domains (domain, forbidden)
+ VALUES ($idna, 0);
+ }
+ }
+ } else {
+ if {[string match {\*.*} $line]} {
+ set line [string range $line 2 end]
+ set idna [string tolower [::tcl::idna encode $line]]
+ set utf [::tcl::idna decode [string tolower $line]]
+ db eval {
+ INSERT OR REPLACE INTO forbiddenSuper (domain)
+ VALUES ($utf);
+ }
+ if {$idna ne $utf} {
+ db eval {
+ INSERT OR REPLACE INTO forbiddenSuper (domain)
+ VALUES ($idna);
+ }
+ }
+ } else {
+ set idna [string tolower [::tcl::idna encode $line]]
+ set utf [::tcl::idna decode [string tolower $line]]
+ }
+ db eval {
+ INSERT OR REPLACE INTO domains (domain, forbidden)
+ VALUES ($utf, 1);
+ }
+ if {$idna ne $utf} {
+ db eval {
+ INSERT OR REPLACE INTO domains (domain, forbidden)
+ VALUES ($idna, 1);
+ }
+ }
+ }
+ if {$utf ne [::tcl::idna decode [string tolower $idna]]} {
+ log warn "mismatch in IDNA handling for %s (%d, %s, %s)" \
+ $idna $line $utf [::tcl::idna decode $idna]
+ }
+ }
+
+ dict with meta {
+ set installDate [clock seconds]
+ db eval {
+ INSERT OR REPLACE INTO domainCacheMetadata
+ (id, retrievalDate, installDate)
+ VALUES (1, $retrievalDate, $installDate);
+ }
+ }
+ }
+ set n [expr {[db total_changes] - $n}]
+ log info "constructed domain info with %d entries" $n
+ }
+
+ # This forces the rebuild of the domain data, loading it from
+ method forceLoadDomainData {} {
+ db transaction {
+ db eval {
+ DELETE FROM domains;
+ DELETE FROM forbiddenSuper;
+ INSERT OR REPLACE INTO domainCacheMetadata
+ (id, retrievalDate, installDate)
+ VALUES (1, -1, -1);
+ }
+ my InitDomainList
+ }
+ }
+
+ destructor {
+ catch {
+ after cancel $purgeTimer
+ }
+ catch {
+ after cancel $refreshTimer
+ }
+ catch {
+ db close
+ }
+ return
+ }
+
+ method GetCookiesForHostAndPath {listVar secure host path fullhost} {
+ upvar 1 $listVar result
+ log debug "check for cookies for %s" [locn $secure $host $path]
+ set exact [expr {$host eq $fullhost}]
+ db eval {
+ SELECT key, value FROM persistentCookies
+ WHERE domain = $host AND path = $path AND secure <= $secure
+ AND (NOT originonly OR domain = $fullhost)
+ AND originonly = $exact
+ } {
+ lappend result $key $value
+ db eval {
+ UPDATE persistentCookies SET lastuse = $now WHERE id = $id
+ }
+ }
+ set now [clock seconds]
+ db eval {
+ SELECT id, key, value FROM sessionCookies
+ WHERE domain = $host AND path = $path AND secure <= $secure
+ AND (NOT originonly OR domain = $fullhost)
+ AND originonly = $exact
+ } {
+ lappend result $key $value
+ db eval {
+ UPDATE sessionCookies SET lastuse = $now WHERE id = $id
+ }
+ }
+ }
+
+ method getCookies {proto host path} {
+ set result {}
+ set paths [splitPath $path]
+ if {[regexp {[^0-9.]} $host]} {
+ set domains [splitDomain [string tolower [::tcl::idna encode $host]]]
+ } else {
+ # Ugh, it's a numeric domain! Restrict it to just itself...
+ set domains [list $host]
+ }
+ set secure [string equal -nocase $proto "https"]
+ # Open question: how to move these manipulations into the database
+ # engine (if that's where they *should* be).
+ #
+ # Suggestion from kbk:
+ #LENGTH(theColumn) <= LENGTH($queryStr) AND
+ #SUBSTR(theColumn, LENGTH($queryStr) LENGTH(theColumn)+1) = $queryStr
+ #
+ # However, we instead do most of the work in Tcl because that lets us
+ # do the splitting exactly right, and it's far easier to work with
+ # strings in Tcl than in SQL.
+ db transaction {
+ foreach domain $domains {
+ foreach p $paths {
+ my GetCookiesForHostAndPath result $secure $domain $p $host
+ }
+ }
+ return $result
+ }
+ }
+
+ method BadDomain options {
+ if {![dict exists $options domain]} {
+ log error "no domain present in options"
+ return 0
+ }
+ dict with options {}
+ if {$domain ne $origin} {
+ log debug "cookie domain varies from origin (%s, %s)" \
+ $domain $origin
+ if {[string match .* $domain]} {
+ set dotd $domain
+ } else {
+ set dotd .$domain
+ }
+ if {![string equal -length [string length $dotd] \
+ [string reverse $dotd] [string reverse $origin]]} {
+ log warn "bad cookie: domain not suffix of origin"
+ return 1
+ }
+ }
+ if {![regexp {[^0-9.]} $domain]} {
+ if {$domain eq $origin} {
+ # May set for itself
+ return 0
+ }
+ log warn "bad cookie: for a numeric address"
+ return 1
+ }
+ db eval {
+ SELECT forbidden FROM domains WHERE domain = $domain
+ } {
+ if {$forbidden} {
+ log warn "bad cookie: for a forbidden address"
+ }
+ return $forbidden
+ }
+ if {[regexp {^[^.]+\.(.+)$} $domain -> super] && [db exists {
+ SELECT 1 FROM forbiddenSuper WHERE domain = $super
+ }]} then {
+ log warn "bad cookie: for a forbidden address"
+ return 1
+ }
+ return 0
+ }
+
+ # A defined extension point to allow users to easily impose extra policies
+ # on whether to accept cookies from a particular domain and path.
+ method policyAllow {operation domain path} {
+ return true
+ }
+
+ method storeCookie {options} {
+ db transaction {
+ if {[my BadDomain $options]} {
+ return
+ }
+ set now [clock seconds]
+ set persistent [dict exists $options expires]
+ dict with options {}
+ if {!$persistent} {
+ if {![my policyAllow session $domain $path]} {
+ log warn "bad cookie: $domain prohibited by user policy"
+ return
+ }
+ db eval {
+ INSERT OR REPLACE INTO sessionCookies (
+ secure, domain, path, key, value, originonly, creation,
+ lastuse)
+ VALUES ($secure, $domain, $path, $key, $value, $hostonly,
+ $now, $now);
+ DELETE FROM persistentCookies
+ WHERE domain = $domain AND path = $path AND key = $key
+ AND secure <= $secure AND originonly = $hostonly
+ }
+ incr deletions [db changes]
+ log debug "defined session cookie for %s" \
+ [locn $secure $domain $path $key]
+ } elseif {$expires < $now} {
+ if {![my policyAllow delete $domain $path]} {
+ log warn "bad cookie: $domain prohibited by user policy"
+ return
+ }
+ db eval {
+ DELETE FROM persistentCookies
+ WHERE domain = $domain AND path = $path AND key = $key
+ AND secure <= $secure AND originonly = $hostonly
+ }
+ set del [db changes]
+ db eval {
+ DELETE FROM sessionCookies
+ WHERE domain = $domain AND path = $path AND key = $key
+ AND secure <= $secure AND originonly = $hostonly
+ }
+ incr deletions [incr del [db changes]]
+ log debug "deleted %d cookies for %s" \
+ $del [locn $secure $domain $path $key]
+ } else {
+ if {![my policyAllow set $domain $path]} {
+ log warn "bad cookie: $domain prohibited by user policy"
+ return
+ }
+ db eval {
+ INSERT OR REPLACE INTO persistentCookies (
+ secure, domain, path, key, value, originonly, expiry,
+ creation, lastuse)
+ VALUES ($secure, $domain, $path, $key, $value, $hostonly,
+ $expires, $now, $now);
+ DELETE FROM sessionCookies
+ WHERE domain = $domain AND path = $path AND key = $key
+ AND secure <= $secure AND originonly = $hostonly
+ }
+ incr deletions [db changes]
+ log debug "defined persistent cookie for %s, expires at %s" \
+ [locn $secure $domain $path $key] \
+ [clock format $expires]
+ }
+ }
+ }
+
+ method PurgeCookies {} {
+ namespace upvar [info object namespace [self class]] \
+ vacuumtrigger trigger retainlimit retain
+ my PostponePurge
+ set now [clock seconds]
+ log debug "purging cookies that expired before %s" [clock format $now]
+ db transaction {
+ db eval {
+ DELETE FROM persistentCookies WHERE expiry < $now
+ }
+ incr deletions [db changes]
+ db eval {
+ DELETE FROM persistentCookies WHERE id IN (
+ SELECT id FROM persistentCookies ORDER BY lastuse ASC
+ LIMIT -1 OFFSET $retain)
+ }
+ incr deletions [db changes]
+ db eval {
+ DELETE FROM sessionCookies WHERE id IN (
+ SELECT id FROM sessionCookies ORDER BY lastuse
+ LIMIT -1 OFFSET $retain)
+ }
+ incr deletions [db changes]
+ }
+
+ # Once we've deleted a fair bit, vacuum the database. Must be done
+ # outside a transaction.
+ if {$deletions > $trigger} {
+ set deletions 0
+ log debug "vacuuming cookie database"
+ catch {
+ db eval {
+ VACUUM
+ }
+ }
+ }
+ }
+
+ forward Database db
+
+ method lookup {{host ""} {key ""}} {
+ set host [string tolower [::tcl::idna encode $host]]
+ db transaction {
+ if {$host eq ""} {
+ set result {}
+ db eval {
+ SELECT DISTINCT domain FROM cookies
+ ORDER BY domain
+ } {
+ lappend result [::tcl::idna decode [string tolower $domain]]
+ }
+ return $result
+ } elseif {$key eq ""} {
+ set result {}
+ db eval {
+ SELECT DISTINCT key FROM cookies
+ WHERE domain = $host
+ ORDER BY key
+ } {
+ lappend result $key
+ }
+ return $result
+ } else {
+ db eval {
+ SELECT value FROM cookies
+ WHERE domain = $host AND key = $key
+ LIMIT 1
+ } {
+ return $value
+ }
+ return -code error "no such key for that host"
+ }
+ }
+ }
+}
+
+# Local variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/library/http/effective_tld_names.txt.gz b/library/http/effective_tld_names.txt.gz
new file mode 100644
index 0000000..9ce2b69
--- /dev/null
+++ b/library/http/effective_tld_names.txt.gz
Binary files differ
diff --git a/library/http/http.tcl b/library/http/http.tcl
index f82bced..7236bae 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -20,6 +20,7 @@ namespace eval http {
if {![info exists http]} {
array set http {
-accept */*
+ -cookiejar {}
-pipeline 1
-postfresh 0
-proxyhost {}
@@ -127,6 +128,18 @@ namespace eval http {
set defaultKeepalive 0
}
+ # Regular expression used to parse cookies
+ variable CookieRE {(?x) # EXPANDED SYNTAX
+ \s* # Ignore leading spaces
+ ([^][\u0000- ()<>@,;:\\""/?={}\u007f-\uffff]+) # Match the name
+ = # LITERAL: Equal sign
+ ([!\u0023-+\u002D-:<-\u005B\u005D-~]*) # Match the value
+ (?:
+ \s* ; \s* # LITERAL: semicolon
+ ([^\u0000]+) # Match the options
+ )?
+ }
+
namespace export geturl config reset wait formatQuery quoteString
namespace export register unregister registerError
# - Useful, but not exported: data, size, status, code, cleanup, error,
@@ -892,8 +905,12 @@ proc http::geturl {url args} {
}
return -code error "Illegal characters in URL path"
}
+ if {![regexp {^[^?#]+} $srvurl state(path)]} {
+ set state(path) /
+ }
} else {
set srvurl /
+ set state(path) /
}
if {$proto eq ""} {
set proto http
@@ -1354,12 +1371,16 @@ proc http::Connected {token proto phost srvurl} {
puts $sock "$how $srvurl HTTP/$state(-protocol)"
if {[dict exists $state(-headers) Host]} {
# Allow Host spoofing. [Bug 928154]
- puts $sock "Host: [dict get $state(-headers) Host]"
+ set hostHdr [dict get $state(-headers) Host]
+ regexp {^[^:]+} $hostHdr state(host)
+ puts $sock "Host: $hostHdr"
} elseif {$port == $defport} {
# Don't add port in this case, to handle broken servers. [Bug
# #504508]
+ set state(host) $host
puts $sock "Host: $host"
} else {
+ set state(host) $host
puts $sock "Host: $host:$port"
}
puts $sock "User-Agent: $http(-useragent)"
@@ -1421,6 +1442,22 @@ proc http::Connected {token proto phost srvurl} {
seek $state(-querychannel) $start
}
+ # Note that we don't do Cookie2; that's much nastier and not normally
+ # observed in practice either. It also doesn't fix the multitude of
+ # bugs in the basic cookie spec.
+ if {$http(-cookiejar) ne ""} {
+ set cookies ""
+ set separator ""
+ foreach {key value} [{*}$http(-cookiejar) \
+ getCookies $proto $host $state(path)] {
+ append cookies $separator $key = $value
+ set separator "; "
+ }
+ if {$cookies ne ""} {
+ puts $sock "Cookie: $cookies"
+ }
+ }
+
# Flush the request header and set up the fileevent that will either
# push the POST data or read the response.
#
@@ -2693,6 +2730,11 @@ proc http::Event {sock token} {
set state(connection) \
[string trim [string tolower $value]]
}
+ set-cookie {
+ if {$http(-cookiejar) ne ""} {
+ ParseCookie $token [string trim $value]
+ }
+ }
}
lappend state(meta) $key [string trim $value]
}
@@ -2990,6 +3032,83 @@ proc http::IsBinaryContentType {type} {
return true
}
+proc http::ParseCookie {token value} {
+ variable http
+ variable CookieRE
+ variable $token
+ upvar 0 $token state
+
+ if {![regexp $CookieRE $value -> cookiename cookieval opts]} {
+ # Bad cookie! No biscuit!
+ return
+ }
+
+ # Convert the options into a list before feeding into the cookie store;
+ # ugly, but quite easy.
+ set realopts {hostonly 1 path / secure 0 httponly 0}
+ dict set realopts origin $state(host)
+ dict set realopts domain $state(host)
+ foreach option [split [regsub -all {;\s+} $opts \u0000] \u0000] {
+ regexp {^(.*?)(?:=(.*))?$} $option -> optname optval
+ switch -exact -- [string tolower $optname] {
+ expires {
+ if {[catch {
+ #Sun, 06 Nov 1994 08:49:37 GMT
+ dict set realopts expires \
+ [clock scan $optval -format "%a, %d %b %Y %T %Z"]
+ }] && [catch {
+ # Google does this one
+ #Mon, 01-Jan-1990 00:00:00 GMT
+ dict set realopts expires \
+ [clock scan $optval -format "%a, %d-%b-%Y %T %Z"]
+ }] && [catch {
+ # This is in the RFC, but it is also in the original
+ # Netscape cookie spec, now online at:
+ # <URL:http://curl.haxx.se/rfc/cookie_spec.html>
+ #Sunday, 06-Nov-94 08:49:37 GMT
+ dict set realopts expires \
+ [clock scan $optval -format "%A, %d-%b-%y %T %Z"]
+ }]} {catch {
+ #Sun Nov 6 08:49:37 1994
+ dict set realopts expires \
+ [clock scan $optval -gmt 1 -format "%a %b %d %T %Y"]
+ }}
+ }
+ max-age {
+ # Normalize
+ if {[string is integer -strict $optval]} {
+ dict set realopts expires [expr {[clock seconds] + $optval}]
+ }
+ }
+ domain {
+ # From the domain-matches definition [RFC 2109, section 2]:
+ # Host A's name domain-matches host B's if [...]
+ # A is a FQDN string and has the form NB, where N is a
+ # non-empty name string, B has the form .B', and B' is a
+ # FQDN string. (So, x.y.com domain-matches .y.com but
+ # not y.com.)
+ if {$optval ne "" && ![string match *. $optval]} {
+ dict set realopts domain [string trimleft $optval "."]
+ dict set realopts hostonly [expr {
+ ! [string match .* $optval]
+ }]
+ }
+ }
+ path {
+ if {[string match /* $optval]} {
+ dict set realopts path $optval
+ }
+ }
+ secure - httponly {
+ dict set realopts [string tolower $optname] 1
+ }
+ }
+ }
+ dict set realopts key $cookiename
+ dict set realopts value $cookieval
+ {*}$http(-cookiejar) storeCookie $realopts
+}
+
# http::getTextLine --
#
# Get one line with the stream in crlf mode.
diff --git a/library/http/idna.tcl b/library/http/idna.tcl
new file mode 100644
index 0000000..2a7d289
--- /dev/null
+++ b/library/http/idna.tcl
@@ -0,0 +1,292 @@
+# cookiejar.tcl --
+#
+# Implementation of IDNA (Internationalized Domain Names for
+# Applications) encoding/decoding system, built on a punycode engine
+# developed directly from the code in RFC 3492, Appendix C (with
+# substantial modifications).
+#
+# This implementation includes code from that RFC, translated to Tcl; the
+# other parts are:
+# Copyright (c) 2014 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+namespace eval ::tcl::idna {
+ namespace ensemble create -command puny -map {
+ encode punyencode
+ decode punydecode
+ }
+ namespace ensemble create -command ::tcl::idna -map {
+ encode IDNAencode
+ decode IDNAdecode
+ puny puny
+ version {::apply {{} {package present tcl::idna} ::}}
+ }
+
+ proc IDNAencode hostname {
+ set parts {}
+ # Split term from RFC 3490, Sec 3.1
+ foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
+ if {[regexp {[^-A-Za-z0-9]} $part]} {
+ if {[regexp {[^-A-Za-z0-9\u00a1-\uffff]} $part ch]} {
+ scan $ch %c c
+ if {$ch < "!" || $ch > "~"} {
+ set ch [format "\\u%04x" $c]
+ }
+ throw [list IDNA INVALID_NAME_CHARACTER $ch] \
+ "bad character \"$ch\" in DNS name"
+ }
+ set part xn--[punyencode $part]
+ # Length restriction from RFC 5890, Sec 2.3.1
+ if {[string length $part] > 63} {
+ throw [list IDNA OVERLONG_PART $part] \
+ "hostname part too long"
+ }
+ }
+ lappend parts $part
+ }
+ return [join $parts .]
+ }
+ proc IDNAdecode hostname {
+ set parts {}
+ # Split term from RFC 3490, Sec 3.1
+ foreach part [split $hostname "\u002E\u3002\uFF0E\uFF61"] {
+ if {[string match -nocase "xn--*" $part]} {
+ set part [punydecode [string range $part 4 end]]
+ }
+ lappend parts $part
+ }
+ return [join $parts .]
+ }
+
+ variable digits [split "abcdefghijklmnopqrstuvwxyz0123456789" ""]
+ # Bootstring parameters for Punycode
+ variable base 36
+ variable tmin 1
+ variable tmax 26
+ variable skew 38
+ variable damp 700
+ variable initial_bias 72
+ variable initial_n 0x80
+
+ variable max_codepoint 0x10FFFF
+
+ proc adapt {delta first numchars} {
+ variable base
+ variable tmin
+ variable tmax
+ variable damp
+ variable skew
+
+ set delta [expr {$delta / ($first ? $damp : 2)}]
+ incr delta [expr {$delta / $numchars}]
+ set k 0
+ while {$delta > ($base - $tmin) * $tmax / 2} {
+ set delta [expr {$delta / ($base-$tmin)}]
+ incr k $base
+ }
+ return [expr {$k + ($base-$tmin+1) * $delta / ($delta+$skew)}]
+ }
+
+ # Main punycode encoding function
+ proc punyencode {string {case ""}} {
+ variable digits
+ variable tmin
+ variable tmax
+ variable base
+ variable initial_n
+ variable initial_bias
+
+ if {![string is boolean $case]} {
+ return -code error "\"$case\" must be boolean"
+ }
+
+ set in {}
+ foreach char [set string [split $string ""]] {
+ scan $char "%c" ch
+ lappend in $ch
+ }
+ set output {}
+
+ # Initialize the state:
+ set n $initial_n
+ set delta 0
+ set bias $initial_bias
+
+ # Handle the basic code points:
+ foreach ch $string {
+ if {$ch < "\u0080"} {
+ if {$case eq ""} {
+ append output $ch
+ } elseif {[string is true $case]} {
+ append output [string toupper $ch]
+ } elseif {[string is false $case]} {
+ append output [string tolower $ch]
+ }
+ }
+ }
+
+ set b [string length $output]
+
+ # h is the number of code points that have been handled, b is the
+ # number of basic code points.
+
+ if {$b > 0} {
+ append output "-"
+ }
+
+ # Main encoding loop:
+
+ for {set h $b} {$h < [llength $in]} {incr delta; incr n} {
+ # All non-basic code points < n have been handled already. Find
+ # the next larger one:
+
+ set m inf
+ foreach ch $in {
+ if {$ch >= $n && $ch < $m} {
+ set m $ch
+ }
+ }
+
+ # Increase delta enough to advance the decoder's <n,i> state to
+ # <m,0>, but guard against overflow:
+
+ if {$m-$n > (0xffffffff-$delta)/($h+1)} {
+ throw {PUNYCODE OVERFLOW} "overflow in delta computation"
+ }
+ incr delta [expr {($m-$n) * ($h+1)}]
+ set n $m
+
+ foreach ch $in {
+ if {$ch < $n && ([incr delta] & 0xffffffff) == 0} {
+ throw {PUNYCODE OVERFLOW} "overflow in delta computation"
+ }
+
+ if {$ch != $n} {
+ continue
+ }
+
+ # Represent delta as a generalized variable-length integer:
+
+ for {set q $delta; set k $base} true {incr k $base} {
+ set t [expr {min(max($k-$bias, $tmin), $tmax)}]
+ if {$q < $t} {
+ break
+ }
+ append output \
+ [lindex $digits [expr {$t + ($q-$t)%($base-$t)}]]
+ set q [expr {($q-$t) / ($base-$t)}]
+ }
+
+ append output [lindex $digits $q]
+ set bias [adapt $delta [expr {$h==$b}] [expr {$h+1}]]
+ set delta 0
+ incr h
+ }
+ }
+
+ return $output
+ }
+
+ # Main punycode decode function
+ proc punydecode {string {case ""}} {
+ variable tmin
+ variable tmax
+ variable base
+ variable initial_n
+ variable initial_bias
+ variable max_codepoint
+
+ if {![string is boolean $case]} {
+ return -code error "\"$case\" must be boolean"
+ }
+
+ # Initialize the state:
+
+ set n $initial_n
+ set i 0
+ set first 1
+ set bias $initial_bias
+
+ # Split the string into the "real" ASCII characters and the ones to
+ # feed into the main decoder. Note that we don't need to check the
+ # result of [regexp] because that RE will technically match any string
+ # at all.
+
+ regexp {^(?:(.*)-)?([^-]*)$} $string -> pre post
+ if {[string is true -strict $case]} {
+ set pre [string toupper $pre]
+ } elseif {[string is false -strict $case]} {
+ set pre [string tolower $pre]
+ }
+ set output [split $pre ""]
+ set out [llength $output]
+
+ # Main decoding loop:
+
+ for {set in 0} {$in < [string length $post]} {incr in} {
+ # Decode a generalized variable-length integer into delta, which
+ # gets added to i. The overflow checking is easier if we increase
+ # i as we go, then subtract off its starting value at the end to
+ # obtain delta.
+
+ for {set oldi $i; set w 1; set k $base} 1 {incr in} {
+ if {[set ch [string index $post $in]] eq ""} {
+ throw {PUNYCODE BAD_INPUT LENGTH} "exceeded input data"
+ }
+ if {[string match -nocase {[a-z]} $ch]} {
+ scan [string toupper $ch] %c digit
+ incr digit -65
+ } elseif {[string match {[0-9]} $ch]} {
+ set digit [expr {$ch + 26}]
+ } else {
+ throw {PUNYCODE BAD_INPUT CHAR} \
+ "bad decode character \"$ch\""
+ }
+ incr i [expr {$digit * $w}]
+ set t [expr {min(max($tmin, $k-$bias), $tmax)}]
+ if {$digit < $t} {
+ set bias [adapt [expr {$i-$oldi}] $first [incr out]]
+ set first 0
+ break
+ }
+ if {[set w [expr {$w * ($base - $t)}]] > 0x7fffffff} {
+ throw {PUNYCODE OVERFLOW} \
+ "excessively large integer computed in digit decode"
+ }
+ incr k $base
+ }
+
+ # i was supposed to wrap around from out+1 to 0, incrementing n
+ # each time, so we'll fix that now:
+
+ if {[incr n [expr {$i / $out}]] > 0x7fffffff} {
+ throw {PUNYCODE OVERFLOW} \
+ "excessively large integer computed in character choice"
+ } elseif {$n > $max_codepoint} {
+ if {$n >= 0x00d800 && $n < 0x00e000} {
+ # Bare surrogate?!
+ throw {PUNYCODE NON_BMP} \
+ [format "unsupported character U+%06x" $n]
+ }
+ throw {PUNYCODE NON_UNICODE} "bad codepoint $n"
+ }
+ set i [expr {$i % $out}]
+
+ # Insert n at position i of the output:
+
+ set output [linsert $output $i [format "%c" $n]]
+ incr i
+ }
+
+ return [join $output ""]
+ }
+}
+
+package provide tcl::idna 1.0
+
+# Local variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 4f74635..3bc111f 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,4 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded cookiejar 0.1 [list source [file join $dir cookiejar.tcl]]
+package ifneeded tcl::idna 1.0 [list source [file join $dir idna.tcl]]
diff --git a/library/http1.0/http.tcl b/library/http1.0/http.tcl
deleted file mode 100644
index 8329de4..0000000
--- a/library/http1.0/http.tcl
+++ /dev/null
@@ -1,377 +0,0 @@
-# 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 http.n man page for documentation
-
-package provide http 1.0
-
-array set http {
- -accept */*
- -proxyhost {}
- -proxyport {}
- -useragent {Tcl http client package 1.0}
- -proxyfilter httpProxyRequired
-}
-proc http_config {args} {
- global 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"
- }
- }
- }
-}
-
- proc httpFinish { token {errormsg ""} } {
- 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)]} {
- if {[catch {eval $state(-command) {$token}} err]} {
- if {[string length $errormsg] == 0} {
- set state(error) [list $err $errorInfo $errorCode]
- set state(status) error
- }
- }
- unset state(-command)
- }
-}
-proc http_reset { token {why reset} } {
- upvar #0 $token state
- set state(status) $why
- catch {fileevent $state(sock) readable {}}
- httpFinish $token
- if {[info exists state(error)]} {
- set errorlist $state(error)
- unset state(error)
- eval error $errorlist
- }
-}
-proc http_get { url args } {
- global http
- if {![info exists http(uid)]} {
- set http(uid) 0
- }
- set token http#[incr http(uid)]
- upvar #0 $token state
- http_reset $token
- array set state {
- -blocksize 8192
- -validate 0
- -headers {}
- -timeout 0
- state header
- meta {}
- currentsize 0
- totalsize 0
- type text/html
- body {}
- status ""
- }
- set options {-blocksize -channel -command -handler -headers \
- -progress -query -validate -timeout}
- 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)] && \
- [regexp {^[0-9]+$} $state($flag)] && \
- ![regexp {^[0-9]+$} $value]} {
- return -code error "Bad value for $flag ($value), must be integer"
- }
- set state($flag) $value
- } else {
- return -code error "Unknown option $flag, can be: $usage"
- }
- }
- if {! [regexp -nocase {^(http://)?([^/:]+)(:([0-9]+))?(/.*)?$} $url \
- x proto host y port srvurl]} {
- error "Unsupported URL: $url"
- }
- if {[string length $port] == 0} {
- set port 80
- }
- 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 {$state(-timeout) > 0} {
- set state(after) [after $state(-timeout) [list http_reset $token timeout]]
- }
- if {[info exists phost] && [string length $phost]} {
- set srvurl $url
- set s [socket $phost $pport]
- } else {
- set s [socket $host $port]
- }
- set state(sock) $s
-
- # 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 len 0
- set how GET
- if {[info exists state(-query)]} {
- set len [string length $state(-query)]
- if {$len > 0} {
- set how POST
- }
- } elseif {$state(-validate)} {
- set how HEAD
- }
- puts $s "$how $srvurl HTTP/1.0"
- puts $s "Accept: $http(-accept)"
- puts $s "Host: $host"
- puts $s "User-Agent: $http(-useragent)"
- foreach {key value} $state(-headers) {
- regsub -all \[\n\r\] $value {} value
- set key [string trim $key]
- if {[string length $key]} {
- puts $s "$key: $value"
- }
- }
- if {$len > 0} {
- puts $s "Content-Length: $len"
- puts $s "Content-Type: application/x-www-form-urlencoded"
- puts $s ""
- fconfigure $s -translation {auto binary}
- puts -nonewline $s $state(-query)
- } else {
- puts $s ""
- }
- flush $s
- fileevent $s readable [list httpEvent $token]
- if {! [info exists state(-command)]} {
- http_wait $token
- }
- return $token
-}
-proc http_data {token} {
- upvar #0 $token state
- return $state(body)
-}
-proc http_status {token} {
- upvar #0 $token state
- return $state(status)
-}
-proc http_code {token} {
- upvar #0 $token state
- return $state(http)
-}
-proc http_size {token} {
- upvar #0 $token state
- return $state(currentsize)
-}
-
- proc httpEvent {token} {
- upvar #0 $token state
- set s $state(sock)
-
- if {[eof $s]} {
- httpEof $token
- return
- }
- if {$state(state) == "header"} {
- set n [gets $s line]
- if {$n == 0} {
- set state(state) body
- if {![regexp -nocase ^text $state(type)]} {
- # Turn off conversions for non-text data
- fconfigure $s -translation binary
- if {[info exists state(-channel)]} {
- fconfigure $state(-channel) -translation binary
- }
- }
- if {[info exists state(-channel)] &&
- ![info exists state(-handler)]} {
- # Initiate a sequence of background fcopies
- fileevent $s readable {}
- httpCopyStart $s $token
- }
- } elseif {$n > 0} {
- if {[regexp -nocase {^content-type:(.+)$} $line x type]} {
- set state(type) [string trim $type]
- }
- if {[regexp -nocase {^content-length:(.+)$} $line x length]} {
- set state(totalsize) [string trim $length]
- }
- if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
- lappend state(meta) $key $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]} {
- httpFinish $token $err
- } else {
- if {[info exists state(-progress)]} {
- eval $state(-progress) {$token $state(totalsize) $state(currentsize)}
- }
- }
- }
-}
- proc httpCopyStart {s token} {
- upvar #0 $token state
- if {[catch {
- fcopy $s $state(-channel) -size $state(-blocksize) -command \
- [list httpCopyDone $token]
- } err]} {
- httpFinish $token $err
- }
-}
- proc httpCopyDone {token count {error {}}} {
- 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)}
- }
- if {([string length $error] != 0)} {
- httpFinish $token $error
- } elseif {[eof $s]} {
- httpEof $token
- } else {
- httpCopyStart $s $token
- }
-}
- proc httpEof {token} {
- upvar #0 $token state
- if {$state(state) == "header"} {
- # Premature eof
- set state(status) eof
- } else {
- set state(status) ok
- }
- set state(state) eof
- httpFinish $token
-}
-proc http_wait {token} {
- upvar #0 $token state
- if {![info exists state(status)] || [string length $state(status)] == 0} {
- vwait $token\(status)
- }
- if {[info exists state(error)]} {
- set errorlist $state(error)
- unset state(error)
- eval error $errorlist
- }
- return $state(status)
-}
-
-# 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.
-
-proc http_formatQuery {args} {
- set result ""
- set sep ""
- foreach i $args {
- append result $sep [httpMapReply $i]
- if {$sep != "="} {
- set sep =
- } else {
- set sep &
- }
- }
- return $result
-}
-
-# do x-www-urlencoded character mapping
-# 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
-
- proc httpMapReply {string} {
- global httpFormMap
- set alphanumeric a-zA-Z0-9
- if {![info exists httpFormMap]} {
-
- for {set i 1} {$i <= 256} {incr i} {
- set c [format %c $i]
- if {![string match \[$alphanumeric\] $c]} {
- set httpFormMap($c) %[format %.2x $i]
- }
- }
- # These are handled specially
- array set httpFormMap {
- " " + \n %0d%0a
- }
- }
- regsub -all \[^$alphanumeric\] $string {$httpFormMap(&)} string
- regsub -all \n $string {\\n} string
- regsub -all \t $string {\\t} string
- regsub -all {[][{})\\]\)} $string {\\&} string
- return [subst $string]
-}
-
-# Default proxy filter.
- proc httpProxyRequired {host} {
- global 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)]
- } else {
- return {}
- }
-}
diff --git a/library/http1.0/pkgIndex.tcl b/library/http1.0/pkgIndex.tcl
deleted file mode 100644
index ab6170f..0000000
--- a/library/http1.0/pkgIndex.tcl
+++ /dev/null
@@ -1,11 +0,0 @@
-# Tcl package index file, version 1.0
-# This file is generated by the "pkg_mkIndex" command
-# and sourced either when an application starts up or
-# by a "package unknown" script. It invokes the
-# "package ifneeded" command to set up package-related
-# information so that packages will be loaded automatically
-# in response to "package require" commands. When this
-# script is sourced, the variable $dir must contain the
-# full path name of this file's directory.
-
-package ifneeded http 1.0 [list tclPkgSetup $dir http 1.0 {{http.tcl source {httpCopyDone httpCopyStart httpEof httpEvent httpFinish httpMapReply httpProxyRequired http_code http_config http_data http_formatQuery http_get http_reset http_size http_status http_wait}}}]
diff --git a/library/init.tcl b/library/init.tcl
index 8952172..1ccce27 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -6,7 +6,10 @@
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 Scriptics Corporation.
-# Copyright (c) 2004 by Kevin B. Kenny. All rights reserved.
+# Copyright (c) 2004 by Kevin B. Kenny.
+# Copyright (c) 2018 by Sean Woods
+#
+# All rights reserved.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -16,7 +19,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.6.9
+package require -exact Tcl 8.7a2
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
@@ -73,45 +76,10 @@ namespace eval tcl {
encoding dirs $Path
}
}
-
- # TIP #255 min and max functions
- namespace eval mathfunc {
- proc min {args} {
- if {![llength $args]} {
- return -code error \
- "too few arguments to math function \"min\""
- }
- set val Inf
- foreach arg $args {
- # This will handle forcing the numeric value without
- # ruining the internal type of a numeric object
- if {[catch {expr {double($arg)}} err]} {
- return -code error $err
- }
- if {$arg < $val} {set val $arg}
- }
- return $val
- }
- proc max {args} {
- if {![llength $args]} {
- return -code error \
- "too few arguments to math function \"max\""
- }
- set val -Inf
- foreach arg $args {
- # This will handle forcing the numeric value without
- # ruining the internal type of a numeric object
- if {[catch {expr {double($arg)}} err]} {
- return -code error $err
- }
- if {$arg > $val} {set val $arg}
- }
- return $val
- }
- namespace export min max
- }
}
+namespace eval tcl::Pkg {}
+
# Windows specific end of initialization
if {(![interp issafe]) && ($tcl_platform(platform) eq "windows")} {
@@ -458,6 +426,22 @@ proc auto_load {cmd {namespace {}}} {
return 0
}
+# ::tcl::Pkg::source --
+# This procedure provides an alternative "source" command, which doesn't
+# register the file for the "package files" command. Safe interpreters
+# don't have to do anything special.
+#
+# Arguments:
+# filename
+
+proc ::tcl::Pkg::source {filename} {
+ if {[interp issafe]} {
+ uplevel 1 [list ::source $filename]
+ } else {
+ uplevel 1 [list ::source -nopkg $filename]
+ }
+}
+
# auto_load_index --
# Loads the contents of tclIndex files on the auto_path directory
# list. This is usually invoked within auto_load to load the index
@@ -500,7 +484,7 @@ proc auto_load_index {} {
}
set name [lindex $line 0]
set auto_index($name) \
- "source [file join $dir [lindex $line 1]]"
+ "::tcl::Pkg::source [file join $dir [lindex $line 1]]"
}
} else {
error "[file join $dir tclIndex] isn't a proper Tcl index file"
@@ -672,10 +656,7 @@ proc auto_execok name {
set windir $env(WINDIR)
}
if {[info exists windir]} {
- if {$tcl_platform(os) eq "Windows NT"} {
- append path "$windir/system32;"
- }
- append path "$windir/system;$windir;"
+ append path "$windir/system32;$windir/system;$windir;"
}
foreach var {PATH Path path} {
diff --git a/library/install.tcl b/library/install.tcl
new file mode 100644
index 0000000..e62226e
--- /dev/null
+++ b/library/install.tcl
@@ -0,0 +1,244 @@
+###
+# Installer actions built into tclsh and invoked
+# if the first command line argument is "install"
+###
+if {[llength $argv] < 2} {
+ exit 0
+}
+namespace eval ::practcl {}
+###
+# Installer tools
+###
+proc ::practcl::_isdirectory name {
+ return [file isdirectory $name]
+}
+###
+# Return true if the pkgindex file contains
+# any statement other than "package ifneeded"
+# and/or if any package ifneeded loads a DLL
+###
+proc ::practcl::_pkgindex_directory {path} {
+ set buffer {}
+ set pkgidxfile [file join $path pkgIndex.tcl]
+ if {![file exists $pkgidxfile]} {
+ # No pkgIndex file, read the source
+ foreach file [glob -nocomplain $path/*.tm] {
+ set file [file normalize $file]
+ set fname [file rootname [file tail $file]]
+ ###
+ # We used to be able to ... Assume the package is correct in the filename
+ # No hunt for a "package provides"
+ ###
+ set package [lindex [split $fname -] 0]
+ set version [lindex [split $fname -] 1]
+ ###
+ # Read the file, and override assumptions as needed
+ ###
+ set fin [open $file r]
+ set dat [read $fin]
+ close $fin
+ # Look for a teapot style Package statement
+ foreach line [split $dat \n] {
+ set line [string trim $line]
+ if { [string range $line 0 9] != "# Package " } continue
+ set package [lindex $line 2]
+ set version [lindex $line 3]
+ break
+ }
+ # Look for a package provide statement
+ foreach line [split $dat \n] {
+ set line [string trim $line]
+ if { [string range $line 0 14] != "package provide" } continue
+ set package [lindex $line 2]
+ set version [lindex $line 3]
+ break
+ }
+ append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
+ }
+ foreach file [glob -nocomplain $path/*.tcl] {
+ if { [file tail $file] == "version_info.tcl" } continue
+ set fin [open $file r]
+ set dat [read $fin]
+ close $fin
+ if {![regexp "package provide" $dat]} continue
+ set fname [file rootname [file tail $file]]
+ # Look for a package provide statement
+ foreach line [split $dat \n] {
+ set line [string trim $line]
+ if { [string range $line 0 14] != "package provide" } continue
+ set package [lindex $line 2]
+ set version [lindex $line 3]
+ if {[string index $package 0] in "\$ \[ @"} continue
+ if {[string index $version 0] in "\$ \[ @"} continue
+ append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
+ break
+ }
+ }
+ return $buffer
+ }
+ set fin [open $pkgidxfile r]
+ set dat [read $fin]
+ close $fin
+ set trace 0
+ #if {[file tail $path] eq "tool"} {
+ # set trace 1
+ #}
+ set thisline {}
+ foreach line [split $dat \n] {
+ append thisline $line \n
+ if {![info complete $thisline]} continue
+ set line [string trim $line]
+ if {[string length $line]==0} {
+ set thisline {} ; continue
+ }
+ if {[string index $line 0] eq "#"} {
+ set thisline {} ; continue
+ }
+ if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} {
+ if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"}
+ set thisline {} ; continue
+ }
+ if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} {
+ if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" }
+ set thisline {} ; continue
+ }
+ if {![regexp "package.*ifneeded" $thisline]} {
+ # This package index contains arbitrary code
+ # source instead of trying to add it to the master
+ # package index
+ if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
+ return {source [file join $dir pkgIndex.tcl]}
+ }
+ append buffer $thisline \n
+ set thisline {}
+ }
+ if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]}
+ return $buffer
+}
+
+
+proc ::practcl::_pkgindex_path_subdir {path} {
+ set result {}
+ foreach subpath [glob -nocomplain [file join $path *]] {
+ if {[file isdirectory $subpath]} {
+ lappend result $subpath {*}[_pkgindex_path_subdir $subpath]
+ }
+ }
+ return $result
+}
+###
+# Index all paths given as though they will end up in the same
+# virtual file system
+###
+proc ::practcl::pkgindex_path args {
+ set stack {}
+ set buffer {
+lappend ::PATHSTACK $dir
+ }
+ foreach base $args {
+ set base [file normalize $base]
+ set paths {}
+ foreach dir [glob -nocomplain [file join $base *]] {
+ if {[file tail $dir] eq "teapot"} continue
+ lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir]
+ }
+ set i [string length $base]
+ # Build a list of all of the paths
+ if {[llength $paths]} {
+ foreach path $paths {
+ if {$path eq $base} continue
+ set path_indexed($path) 0
+ }
+ } else {
+ puts [list WARNING: NO PATHS FOUND IN $base]
+ }
+ set path_indexed($base) 1
+ set path_indexed([file join $base boot tcl]) 1
+ foreach teapath [glob -nocomplain [file join $base teapot *]] {
+ set pkg [file tail $teapath]
+ append buffer [list set pkg $pkg]
+ append buffer {
+set pkginstall [file join $::g(HOME) teapot $pkg]
+if {![file exists $pkginstall]} {
+ installDir [file join $dir teapot $pkg] $pkginstall
+}
+}
+ }
+ foreach path $paths {
+ if {$path_indexed($path)} continue
+ set thisdir [file_relative $base $path]
+ set idxbuf [::practcl::_pkgindex_directory $path]
+ if {[string length $idxbuf]} {
+ incr path_indexed($path)
+ append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n
+ append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n
+ }
+ }
+ }
+ append buffer {
+set dir [lindex $::PATHSTACK end]
+set ::PATHSTACK [lrange $::PATHSTACK 0 end-1]
+}
+ return $buffer
+}
+
+###
+# topic: 64319f4600fb63c82b2258d908f9d066
+# description: Script to build the VFS file system
+###
+proc ::practcl::installDir {d1 d2} {
+
+ puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]]
+ file delete -force -- $d2
+ file mkdir $d2
+
+ foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+ set f [file join $d1 $ftail]
+ if {[file isdirectory $f] && [string compare CVS $ftail]} {
+ installDir $f [file join $d2 $ftail]
+ } elseif {[file isfile $f]} {
+ file copy -force $f [file join $d2 $ftail]
+ if {$::tcl_platform(platform) eq {unix}} {
+ file attributes [file join $d2 $ftail] -permissions 0644
+ } else {
+ file attributes [file join $d2 $ftail] -readonly 1
+ }
+ }
+ }
+
+ if {$::tcl_platform(platform) eq {unix}} {
+ file attributes $d2 -permissions 0755
+ } else {
+ file attributes $d2 -readonly 1
+ }
+}
+
+proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
+ #if {$toplevel} {
+ # puts [list ::practcl::copyDir $d1 -> $d2]
+ #}
+ #file delete -force -- $d2
+ file mkdir $d2
+
+ foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+ set f [file join $d1 $ftail]
+ if {[file isdirectory $f] && [string compare CVS $ftail]} {
+ copyDir $f [file join $d2 $ftail] 0
+ } elseif {[file isfile $f]} {
+ file copy -force $f [file join $d2 $ftail]
+ }
+ }
+}
+
+switch [lindex $argv 1] {
+ mkzip {
+ zipfs mkzip {*}[lrange $argv 2 end]
+ }
+ mkzip {
+ zipfs mkimg {*}[lrange $argv 2 end]
+ }
+ default {
+ ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end]
+ }
+}
+exit 0
diff --git a/library/manifest.txt b/library/manifest.txt
new file mode 100644
index 0000000..11a755a
--- /dev/null
+++ b/library/manifest.txt
@@ -0,0 +1,18 @@
+###
+# Package manifest for all Tcl packages included in the /library file system
+###
+apply {{dir} {
+ set ::test [info script]
+ set isafe [interp issafe]
+ foreach {safe package version file} {
+ 0 http 2.9.0 {http http.tcl}
+ 1 msgcat 1.7.0 {msgcat msgcat.tcl}
+ 1 opt 0.4.7 {opt optparse.tcl}
+ 0 platform 1.0.14 {platform platform.tcl}
+ 0 platform::shell 1.1.4 {platform shell.tcl}
+ 1 tcltest 2.5.0 {tcltest tcltest.tcl}
+ } {
+ if {$isafe && !$safe} continue
+ package ifneeded $package $version [list source [file join $dir {*}$file]]
+ }
+}} $dir
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 646bc17..9f7d54a 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -4,22 +4,24 @@
# message catalog facility for Tcl programs. It should be
# loaded with the command "package require msgcat".
#
-# Copyright (c) 2010-2015 by Harald Oehlmann.
+# Copyright (c) 2010-2018 by Harald Oehlmann.
# 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.
-package require Tcl 8.5-
+# We use oo::define::self, which is new in Tcl 8.7
+package require Tcl 8.7-
# When the version number changes, be sure to update the pkgIndex.tcl file,
# and the installation directory in the Makefiles.
-package provide msgcat 1.6.1
+package provide msgcat 1.7.0
namespace eval msgcat {
- namespace export mc mcexists mcload mclocale mcmax mcmset mcpreferences mcset\
+ namespace export mc mcn mcexists mcload mclocale mcmax\
+ mcmset mcpreferences mcset\
mcunknown mcflset mcflmset mcloadedlocales mcforgetpackage\
- mcpackageconfig mcpackagelocale
+ mcpackagenamespaceget mcpackageconfig mcpackagelocale mcutil
# Records the list of locales to search
variable Loclist {}
@@ -41,6 +43,12 @@ namespace eval msgcat {
# namespace should be themselves dict values and the value is
# the translated string.
variable Msgs [dict create]
+}
+
+# create ensemble namespace for mcutil command
+namespace eval msgcat::mcutil {
+ namespace export getsystemlocale getpreferences
+ namespace ensemble create -prefix 0
# Map of language codes used in Windows registry to those of ISO-639
if {[info sharedlibextension] eq ".dll"} {
@@ -179,12 +187,35 @@ namespace eval msgcat {
# 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
+# specified, use the format command to work them into the translated
+# string.
+# If no catalog item is found, mcunknown is called in the caller frame
+# and its result is returned.
+#
+# Arguments:
+# src The string to translate.
+# args Args to pass to the format command
+#
+# Results:
+# Returns the translated string. Propagates errors thrown by the
+# format command.
+
+proc msgcat::mc {args} {
+ tailcall mcn [PackageNamespaceGet] {*}$args
+}
+
+# msgcat::mcn --
+#
+# Find the translation for the given string based on the current
+# locale setting. Check the passed 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 translated
# string.
# If no catalog item is found, mcunknown is called in the caller frame
# and its result is returned.
#
# Arguments:
+# ns Package namespace of the translation
# src The string to translate.
# args Args to pass to the format command
#
@@ -192,10 +223,7 @@ namespace eval msgcat {
# Returns the translated string. Propagates errors thrown by the
# format command.
-proc msgcat::mc {src args} {
- # this may be replaced by:
- # return [mcget -namespace [uplevel 1 [list ::namespace current]] --\
- # $src {*}$args]
+proc msgcat::mcn {ns src args} {
# Check for the src in each namespace starting from the local and
# ending in the global.
@@ -203,7 +231,6 @@ proc msgcat::mc {src args} {
variable Msgs
variable Loclist
- set ns [uplevel 1 [list ::namespace current]]
set loclist [PackagePreferences $ns]
set nscur $ns
@@ -219,7 +246,7 @@ proc msgcat::mc {src args} {
# call package local or default unknown command
set args [linsert $args 0 [lindex $loclist 0] $src]
switch -exact -- [Invoke unknowncmd $args $ns result 1] {
- 0 { return [uplevel 1 [linsert $args 0 [namespace origin mcunknown]]] }
+ 0 { tailcall mcunknown {*}$args }
1 { return [DefaultUnknown {*}$args] }
default { return $result }
}
@@ -245,31 +272,39 @@ proc msgcat::mcexists {args} {
variable Loclist
variable PackageConfig
- set ns [uplevel 1 [list ::namespace current]]
- set loclist [PackagePreferences $ns]
-
while {[llength $args] != 1} {
set args [lassign $args option]
switch -glob -- $option {
- -exactnamespace { set exactnamespace 1 }
- -exactlocale { set loclist [lrange $loclist 0 0] }
+ -exactnamespace - -exactlocale { set $option 1 }
+ -namespace {
+ if {[llength $args] < 2} {
+ return -code error\
+ "Argument missing for switch \"-namespace\""
+ }
+ set args [lassign $args ns]
+ }
-* { return -code error "unknown option \"$option\"" }
default {
return -code error "wrong # args: should be\
\"[lindex [info level 0] 0] ?-exactnamespace?\
- ?-exactlocale? src\""
+ ?-exactlocale? ?-namespace ns? src\""
}
}
}
set src [lindex $args 0]
+ if {![info exists ns]} { set ns [PackageNamespaceGet] }
+
+ set loclist [PackagePreferences $ns]
+ if {[info exists -exactlocale]} { set loclist [lrange $loclist 0 0] }
+
while {$ns ne ""} {
foreach loc $loclist {
if {[dict exists $Msgs $ns $loc $src]} {
return 1
}
}
- if {[info exists exactnamespace]} {return 0}
+ if {[info exists -exactnamespace]} {return 0}
set ns [namespace parent $ns]
}
return 0
@@ -303,32 +338,27 @@ proc msgcat::mclocale {args} {
return -code error "invalid newLocale value \"$newLocale\":\
could be path to unsafe code."
}
- if {[lindex $Loclist 0] ne $newLocale} {
- set Loclist [GetPreferences $newLocale]
-
- # locale not loaded jet
- LoadAll $Loclist
- # Invoke callback
- Invoke changecmd $Loclist
- }
+ mcpreferences {*}[mcutil getpreferences $newLocale]
}
return [lindex $Loclist 0]
}
-# msgcat::GetPreferences --
+# msgcat::mcutil::getpreferences --
#
# Get list of locales from a locale.
# The first element is always the lowercase locale.
# Other elements have one component separated by "_" less.
# Multiple "_" are seen as one separator: de__ch_spec de__ch de {}
#
+# This method is part of the ensemble mcutil
+#
# Arguments:
# Locale.
#
# Results:
# Locale list
-proc msgcat::GetPreferences {locale} {
+proc msgcat::mcutil::getpreferences {locale} {
set locale [string tolower $locale]
set loclist [list $locale]
while {-1 !=[set pos [string last "_" $locale]]} {
@@ -349,16 +379,51 @@ proc msgcat::GetPreferences {locale} {
# most preferred to least preferred.
#
# Arguments:
-# None.
+# New location list
#
# Results:
# Returns an ordered list of the locales preferred by the user.
-proc msgcat::mcpreferences {} {
+proc msgcat::mcpreferences {args} {
variable Loclist
+
+ if {[llength $args] > 0} {
+ # args is the new loclist
+ if {![ListEqualString $args $Loclist]} {
+ set Loclist $args
+
+ # locale not loaded jet
+ LoadAll $Loclist
+ # Invoke callback
+ Invoke changecmd $Loclist
+ }
+ }
return $Loclist
}
+# msgcat::ListStringEqual --
+#
+# Compare two strings for equal string contents
+#
+# Arguments:
+# list1 first list
+# list2 second list
+#
+# Results:
+# 1 if lists of strings are identical, 0 otherwise
+
+proc msgcat::ListEqualString {list1 list2} {
+ if {[llength $list1] != [llength $list2]} {
+ return 0
+ }
+ foreach item1 $list1 item2 $list2 {
+ if {$item1 ne $item2} {
+ return 0
+ }
+ }
+ return 1
+}
+
# msgcat::mcloadedlocales --
#
# Get or change the list of currently loaded default locales
@@ -442,7 +507,7 @@ proc msgcat::mcloadedlocales {subcommand} {
# Results:
# Empty string, if not stated differently for the subcommand
-proc msgcat::mcpackagelocale {subcommand {locale ""}} {
+proc msgcat::mcpackagelocale {subcommand args} {
# todo: implement using an ensemble
variable Loclist
variable LoadedLocales
@@ -450,27 +515,39 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
variable PackageConfig
# Check option
# check if required item is exactly provided
- if {[llength [info level 0]] == 2} {
- # locale not given
- unset locale
- } else {
- # locale given
- if {$subcommand in
- {"get" "isset" "unset" "preferences" "loaded" "clear"} } {
- return -code error "wrong # args: should be\
- \"[lrange [info level 0] 0 1]\""
- }
- set locale [string tolower $locale]
+ if { [llength $args] > 0
+ && $subcommand in {"get" "isset" "unset" "loaded" "clear"} } {
+ return -code error "wrong # args: should be\
+ \"[lrange [info level 0] 0 1]\""
}
- set ns [uplevel 1 {::namespace current}]
+ set ns [PackageNamespaceGet]
switch -exact -- $subcommand {
get { return [lindex [PackagePreferences $ns] 0] }
- preferences { return [PackagePreferences $ns] }
loaded { return [PackageLocales $ns] }
- present { return [expr {$locale in [PackageLocales $ns]} ]}
+ present {
+ if {[llength $args] != 1} {
+ return -code error "wrong # args: should be\
+ \"[lrange [info level 0] 0 1] locale\""
+ }
+ return [expr {[string tolower [lindex $args 0]]
+ in [PackageLocales $ns]} ]
+ }
isset { return [dict exists $PackageConfig loclist $ns] }
- set { # set a package locale or add a package locale
+ set - preferences {
+ # set a package locale or add a package locale
+ set fSet [expr {$subcommand eq "set"}]
+
+ # Check parameter
+ if {$fSet && 1 < [llength $args] } {
+ return -code error "wrong # args: should be\
+ \"[lrange [info level 0] 0 1] ?locale?\""
+ }
+
+ # > Return preferences if no parameter
+ if {!$fSet && 0 == [llength $args] } {
+ return [PackagePreferences $ns]
+ }
# Copy the default locale if no package locale set so far
if {![dict exists $PackageConfig loclist $ns]} {
@@ -478,25 +555,43 @@ proc msgcat::mcpackagelocale {subcommand {locale ""}} {
dict set PackageConfig loadedlocales $ns $LoadedLocales
}
- # Check if changed
- set loclist [dict get $PackageConfig loclist $ns]
- if {! [info exists locale] || $locale eq [lindex $loclist 0] } {
- return [lindex $loclist 0]
+ # No argument for set: return current package locale
+ # The difference to no argument and subcommand "preferences" is,
+ # that "preferences" does not set the package locale property.
+ # This case is processed above, so no check for fSet here
+ if { 0 == [llength $args] } {
+ return [lindex [dict get $PackageConfig loclist $ns] 0]
+ }
+
+ # Get new loclist
+ if {$fSet} {
+ set loclist [mcutil getpreferences [lindex $args 0]]
+ } else {
+ set loclist $args
+ }
+
+ # Check if not changed to return imediately
+ if { [ListEqualString $loclist\
+ [dict get $PackageConfig loclist $ns]] } {
+ if {$fSet} {
+ return [lindex $loclist 0]
+ }
+ return $loclist
}
# Change loclist
- set loclist [GetPreferences $locale]
- set locale [lindex $loclist 0]
dict set PackageConfig loclist $ns $loclist
# load eventual missing locales
set loadedLocales [dict get $PackageConfig loadedlocales $ns]
- if {$locale in $loadedLocales} { return $locale }
set loadLocales [ListComplement $loadedLocales $loclist]
dict set PackageConfig loadedlocales $ns\
[concat $loadedLocales $loadLocales]
Load $ns $loadLocales
- return $locale
+ if {$fSet} {
+ return [lindex $loclist 0]
+ }
+ return $loclist
}
clear { # Remove all locales not contained in Loclist
if {![dict exists $PackageConfig loclist $ns]} {
@@ -551,7 +646,7 @@ proc msgcat::mcforgetpackage {} {
# todo: this may be implemented using an ensemble
variable PackageConfig
variable Msgs
- set ns [uplevel 1 {::namespace current}]
+ set ns [PackageNamespaceGet]
# Remove MC items
dict unset Msgs $ns
# Remove config items
@@ -561,6 +656,15 @@ proc msgcat::mcforgetpackage {} {
return
}
+# msgcat::mcgetmynamespace --
+#
+# Return the package namespace of the caller
+# This consideres to be called from a class or object.
+
+proc msgcat::mcpackagenamespaceget {} {
+ return [PackageNamespaceGet]
+}
+
# msgcat::mcpackageconfig --
#
# Get or modify the per caller namespace (e.g. packages) config options.
@@ -616,7 +720,7 @@ proc msgcat::mcforgetpackage {} {
proc msgcat::mcpackageconfig {subcommand option {value ""}} {
variable PackageConfig
# get namespace
- set ns [uplevel 1 {::namespace current}]
+ set ns [PackageNamespaceGet]
if {$option ni {"mcfolder" "loadcmd" "changecmd" "unknowncmd"}} {
return -code error "bad option \"$option\": must be mcfolder, loadcmd,\
@@ -756,8 +860,7 @@ proc msgcat::ListComplement {list1 list2 {inlistname ""}} {
# Returns the number of message catalogs that were loaded.
proc msgcat::mcload {langdir} {
- return [uplevel 1 [list\
- [namespace origin mcpackageconfig] set mcfolder $langdir]]
+ tailcall mcpackageconfig set mcfolder $langdir
}
# msgcat::LoadAll --
@@ -923,7 +1026,7 @@ proc msgcat::mcset {locale src {dest ""}} {
set dest $src
}
- set ns [uplevel 1 [list ::namespace current]]
+ set ns [PackageNamespaceGet]
set locale [string tolower $locale]
@@ -951,7 +1054,7 @@ proc msgcat::mcflset {src {dest ""}} {
return -code error "must only be used inside a message catalog loaded\
with ::msgcat::mcload"
}
- return [uplevel 1 [list [namespace origin mcset] $FileLocale $src $dest]]
+ tailcall mcset $FileLocale $src $dest
}
# msgcat::mcmset --
@@ -975,7 +1078,7 @@ proc msgcat::mcmset {locale pairs} {
}
set locale [string tolower $locale]
- set ns [uplevel 1 [list ::namespace current]]
+ set ns [PackageNamespaceGet]
foreach {src dest} $pairs {
dict set Msgs $ns $locale $src $dest
@@ -1002,7 +1105,7 @@ proc msgcat::mcflmset {pairs} {
return -code error "must only be used inside a message catalog loaded\
with ::msgcat::mcload"
}
- return [uplevel 1 [list [namespace origin mcmset] $FileLocale $pairs]]
+ tailcall mcmset $FileLocale $pairs
}
# msgcat::mcunknown --
@@ -1013,7 +1116,7 @@ proc msgcat::mcflmset {pairs} {
# 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.
+# to work them into the translated string.
#
# Arguments:
# locale The current locale.
@@ -1024,7 +1127,7 @@ proc msgcat::mcflmset {pairs} {
# Returns the translated value.
proc msgcat::mcunknown {args} {
- return [uplevel 1 [list [namespace origin DefaultUnknown] {*}$args]]
+ tailcall DefaultUnknown {*}$args
}
# msgcat::DefaultUnknown --
@@ -1034,9 +1137,9 @@ proc msgcat::mcunknown {args} {
# - Default global handler, if mcunknown is not redefined.
# - Per package handler, if the package sets unknowncmd to the empty
# string.
-# It returna the source string if the argument list is empty.
+# It returns the source string if the argument list is empty.
# If additional args are specified, the format command will be used
-# to work them into the traslated string.
+# to work them into the translated string.
#
# Arguments:
# locale (unused) The current locale.
@@ -1067,8 +1170,9 @@ proc msgcat::DefaultUnknown {locale src args} {
proc msgcat::mcmax {args} {
set max 0
+ set ns [PackageNamespaceGet]
foreach string $args {
- set translated [uplevel 1 [list [namespace origin mc] $string]]
+ set translated [uplevel 1 [list [namespace origin mcn] $ns $string]]
set len [string length $translated]
if {$len>$max} {
set max $len
@@ -1079,7 +1183,7 @@ proc msgcat::mcmax {args} {
# Convert the locale values stored in environment variables to a form
# suitable for passing to [mclocale]
-proc msgcat::ConvertLocale {value} {
+proc msgcat::mcutil::ConvertLocale {value} {
# Assume $value is of form: $language[_$territory][.$codeset][@modifier]
# Convert to form: $language[_$territory][_$modifier]
#
@@ -1106,8 +1210,40 @@ proc msgcat::ConvertLocale {value} {
return $ret
}
+# helper function to find package namespace of stack-frame -2
+# There are 4 possibilities:
+# - called from a proc
+# - called within a class definition script
+# - called from an class defined oo object
+# - called from a classless oo object
+proc ::msgcat::PackageNamespaceGet {} {
+ uplevel 2 {
+ # Check self namespace to determine environment
+ switch -exact -- [namespace which self] {
+ {::oo::define::self} {
+ # We are within a class definition
+ return [namespace qualifiers [self]]
+ }
+ {::oo::Helpers::self} {
+ # We are within an object
+ set Class [info object class [self]]
+ # Check for classless defined object
+ if {$Class eq {::oo::object}} {
+ return [namespace qualifiers [self]]
+ }
+ # Class defined object
+ return [namespace qualifiers $Class]
+ }
+ default {
+ # Not in object environment
+ return [namespace current]
+ }
+ }
+ }
+}
+
# Initialize the default locale
-proc msgcat::Init {} {
+proc msgcat::mcutil::getsystemlocale {} {
global env
#
@@ -1115,10 +1251,8 @@ proc msgcat::Init {} {
#
foreach varName {LC_ALL LC_MESSAGES LANG} {
if {[info exists env($varName)] && ("" ne $env($varName))} {
- if {![catch {
- mclocale [ConvertLocale $env($varName)]
- }]} {
- return
+ if {![catch { ConvertLocale $env($varName) } locale]} {
+ return $locale
}
}
}
@@ -1126,10 +1260,8 @@ proc msgcat::Init {} {
# On Darwin, fallback to current CFLocale identifier if available.
#
if {[info exists ::tcl::mac::locale] && $::tcl::mac::locale ne ""} {
- if {![catch {
- mclocale [ConvertLocale $::tcl::mac::locale]
- }]} {
- return
+ if {![catch { ConvertLocale $::tcl::mac::locale } locale]} {
+ return $locale
}
}
#
@@ -1138,8 +1270,7 @@ proc msgcat::Init {} {
#
if {([info sharedlibextension] ne ".dll")
|| [catch {package require registry}]} {
- mclocale C
- return
+ return C
}
#
# On Windows or Cygwin, try to set locale depending on registry
@@ -1148,7 +1279,7 @@ proc msgcat::Init {} {
# On Vista and later:
# HCU/Control Panel/Desktop : PreferredUILanguages is for language packs,
- # HCU/Control Pannel/International : localName is the default locale.
+ # HCU/Control Panel/International : localName is the default locale.
#
# They contain the local string as RFC5646, composed of:
# [a-z]{2,3} : language
@@ -1170,8 +1301,8 @@ proc msgcat::Init {} {
if {[dict exists $modifierDict $script]} {
append locale @ [dict get $modifierDict $script]
}
- if {![catch {mclocale [ConvertLocale $locale]}]} {
- return
+ if {![catch {ConvertLocale $locale} locale]} {
+ return $locale
}
}
}
@@ -1180,13 +1311,12 @@ proc msgcat::Init {} {
if {[catch {
set locale [registry get $key "locale"]
}]} {
- mclocale C
- return
+ return C
}
#
# 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
+ # of the registry value, since the latter hexdigits appear
+ # to determine general language and earlier hexdigits determine
# more precise information, such as territory. For example,
# 0409 - English - United States
# 0809 - English - United Kingdom
@@ -1196,15 +1326,15 @@ proc msgcat::Init {} {
set locale [string tolower $locale]
while {[string length $locale]} {
if {![catch {
- mclocale [ConvertLocale [dict get $WinRegToISO639 $locale]]
- }]} {
- return
+ ConvertLocale [dict get $WinRegToISO639 $locale]
+ } localeOut]} {
+ return $localeOut
}
set locale [string range $locale 1 end]
}
#
# No translation known. Fall back on "C" locale
#
- mclocale C
+ return C
}
-msgcat::Init
+msgcat::mclocale [msgcat::mcutil getsystemlocale]
diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl
index 72c5dc0..3309a30 100644
--- a/library/msgcat/pkgIndex.tcl
+++ b/library/msgcat/pkgIndex.tcl
@@ -1,2 +1,2 @@
-if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
-package ifneeded msgcat 1.6.1 [list source [file join $dir msgcat.tcl]]
+if {![package vsatisfies [package provide Tcl] 8.7-]} {return}
+package ifneeded msgcat 1.7.0 [list source [file join $dir msgcat.tcl]]
diff --git a/library/msgs/ar.msg b/library/msgs/ar.msg
index 257157f..2d403ec 100644
--- a/library/msgs/ar.msg
+++ b/library/msgs/ar.msg
@@ -1,53 +1,53 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ar DAYS_OF_WEEK_ABBREV [list \
- "\u062d"\
- "\u0646"\
- "\u062b"\
- "\u0631"\
- "\u062e"\
- "\u062c"\
- "\u0633"]
+ "Ø­"\
+ "Ù†"\
+ "Ø«"\
+ "ر"\
+ "Ø®"\
+ "ج"\
+ "س"]
::msgcat::mcset ar DAYS_OF_WEEK_FULL [list \
- "\u0627\u0644\u0623\u062d\u062f"\
- "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
- "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
- "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
- "\u0627\u0644\u062e\u0645\u064a\u0633"\
- "\u0627\u0644\u062c\u0645\u0639\u0629"\
- "\u0627\u0644\u0633\u0628\u062a"]
+ "الأحد"\
+ "الاثنين"\
+ "الثلاثاء"\
+ "الأربعاء"\
+ "الخميس"\
+ "الجمعة"\
+ "السبت"]
::msgcat::mcset ar MONTHS_ABBREV [list \
- "\u064a\u0646\u0627"\
- "\u0641\u0628\u0631"\
- "\u0645\u0627\u0631"\
- "\u0623\u0628\u0631"\
- "\u0645\u0627\u064a"\
- "\u064a\u0648\u0646"\
- "\u064a\u0648\u0644"\
- "\u0623\u063a\u0633"\
- "\u0633\u0628\u062a"\
- "\u0623\u0643\u062a"\
- "\u0646\u0648\u0641"\
- "\u062f\u064a\u0633"\
+ "ينا"\
+ "Ùبر"\
+ "مار"\
+ "أبر"\
+ "ماي"\
+ "يون"\
+ "يول"\
+ "أغس"\
+ "سبت"\
+ "أكت"\
+ "نوÙ"\
+ "ديس"\
""]
::msgcat::mcset ar MONTHS_FULL [list \
- "\u064a\u0646\u0627\u064a\u0631"\
- "\u0641\u0628\u0631\u0627\u064a\u0631"\
- "\u0645\u0627\u0631\u0633"\
- "\u0623\u0628\u0631\u064a\u0644"\
- "\u0645\u0627\u064a\u0648"\
- "\u064a\u0648\u0646\u064a\u0648"\
- "\u064a\u0648\u0644\u064a\u0648"\
- "\u0623\u063a\u0633\u0637\u0633"\
- "\u0633\u0628\u062a\u0645\u0628\u0631"\
- "\u0623\u0643\u062a\u0648\u0628\u0631"\
- "\u0646\u0648\u0641\u0645\u0628\u0631"\
- "\u062f\u064a\u0633\u0645\u0628\u0631"\
+ "يناير"\
+ "Ùبراير"\
+ "مارس"\
+ "أبريل"\
+ "مايو"\
+ "يونيو"\
+ "يوليو"\
+ "أغسطس"\
+ "سبتمبر"\
+ "أكتوبر"\
+ "نوÙمبر"\
+ "ديسمبر"\
""]
- ::msgcat::mcset ar BCE "\u0642.\u0645"
- ::msgcat::mcset ar CE "\u0645"
- ::msgcat::mcset ar AM "\u0635"
- ::msgcat::mcset ar PM "\u0645"
+ ::msgcat::mcset ar BCE "Ù‚.Ù…"
+ ::msgcat::mcset ar CE "Ù…"
+ ::msgcat::mcset ar AM "ص"
+ ::msgcat::mcset ar PM "Ù…"
::msgcat::mcset ar DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset ar TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset ar DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
diff --git a/library/msgs/ar_jo.msg b/library/msgs/ar_jo.msg
index 0f5e269..9a9dda0 100644
--- a/library/msgs/ar_jo.msg
+++ b/library/msgs/ar_jo.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ar_JO DAYS_OF_WEEK_ABBREV [list \
- "\u0627\u0644\u0623\u062d\u062f"\
- "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
- "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
- "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
- "\u0627\u0644\u062e\u0645\u064a\u0633"\
- "\u0627\u0644\u062c\u0645\u0639\u0629"\
- "\u0627\u0644\u0633\u0628\u062a"]
+ "الأحد"\
+ "الاثنين"\
+ "الثلاثاء"\
+ "الأربعاء"\
+ "الخميس"\
+ "الجمعة"\
+ "السبت"]
::msgcat::mcset ar_JO MONTHS_ABBREV [list \
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0634\u0628\u0627\u0637"\
- "\u0622\u0630\u0627\u0631"\
- "\u0646\u064a\u0633\u0627\u0646"\
- "\u0646\u0648\u0627\u0631"\
- "\u062d\u0632\u064a\u0631\u0627\u0646"\
- "\u062a\u0645\u0648\u0632"\
- "\u0622\u0628"\
- "\u0623\u064a\u0644\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
+ "كانون الثاني"\
+ "شباط"\
+ "آذار"\
+ "نيسان"\
+ "نوار"\
+ "حزيران"\
+ "تموز"\
+ "آب"\
+ "أيلول"\
+ "تشرين الأول"\
+ "تشرين الثاني"\
+ "كانون الأول"\
""]
::msgcat::mcset ar_JO MONTHS_FULL [list \
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0634\u0628\u0627\u0637"\
- "\u0622\u0630\u0627\u0631"\
- "\u0646\u064a\u0633\u0627\u0646"\
- "\u0646\u0648\u0627\u0631"\
- "\u062d\u0632\u064a\u0631\u0627\u0646"\
- "\u062a\u0645\u0648\u0632"\
- "\u0622\u0628"\
- "\u0623\u064a\u0644\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
+ "كانون الثاني"\
+ "شباط"\
+ "آذار"\
+ "نيسان"\
+ "نوار"\
+ "حزيران"\
+ "تموز"\
+ "آب"\
+ "أيلول"\
+ "تشرين الأول"\
+ "تشرين الثاني"\
+ "كانون الأول"\
""]
}
diff --git a/library/msgs/ar_lb.msg b/library/msgs/ar_lb.msg
index e62acd3..c23aa2c 100644
--- a/library/msgs/ar_lb.msg
+++ b/library/msgs/ar_lb.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ar_LB DAYS_OF_WEEK_ABBREV [list \
- "\u0627\u0644\u0623\u062d\u062f"\
- "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
- "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
- "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
- "\u0627\u0644\u062e\u0645\u064a\u0633"\
- "\u0627\u0644\u062c\u0645\u0639\u0629"\
- "\u0627\u0644\u0633\u0628\u062a"]
+ "الأحد"\
+ "الاثنين"\
+ "الثلاثاء"\
+ "الأربعاء"\
+ "الخميس"\
+ "الجمعة"\
+ "السبت"]
::msgcat::mcset ar_LB MONTHS_ABBREV [list \
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0634\u0628\u0627\u0637"\
- "\u0622\u0630\u0627\u0631"\
- "\u0646\u064a\u0633\u0627\u0646"\
- "\u0646\u0648\u0627\u0631"\
- "\u062d\u0632\u064a\u0631\u0627\u0646"\
- "\u062a\u0645\u0648\u0632"\
- "\u0622\u0628"\
- "\u0623\u064a\u0644\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
+ "كانون الثاني"\
+ "شباط"\
+ "آذار"\
+ "نيسان"\
+ "نوار"\
+ "حزيران"\
+ "تموز"\
+ "آب"\
+ "أيلول"\
+ "تشرين الأول"\
+ "تشرين الثاني"\
+ "كانون الأول"\
""]
::msgcat::mcset ar_LB MONTHS_FULL [list \
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0634\u0628\u0627\u0637"\
- "\u0622\u0630\u0627\u0631"\
- "\u0646\u064a\u0633\u0627\u0646"\
- "\u0646\u0648\u0627\u0631"\
- "\u062d\u0632\u064a\u0631\u0627\u0646"\
- "\u062a\u0645\u0648\u0632"\
- "\u0622\u0628"\
- "\u0623\u064a\u0644\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
+ "كانون الثاني"\
+ "شباط"\
+ "آذار"\
+ "نيسان"\
+ "نوار"\
+ "حزيران"\
+ "تموز"\
+ "آب"\
+ "أيلول"\
+ "تشرين الأول"\
+ "تشرين الثاني"\
+ "كانون الأول"\
""]
}
diff --git a/library/msgs/ar_sy.msg b/library/msgs/ar_sy.msg
index d5e1c87..f0daec0 100644
--- a/library/msgs/ar_sy.msg
+++ b/library/msgs/ar_sy.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ar_SY DAYS_OF_WEEK_ABBREV [list \
- "\u0627\u0644\u0623\u062d\u062f"\
- "\u0627\u0644\u0627\u062b\u0646\u064a\u0646"\
- "\u0627\u0644\u062b\u0644\u0627\u062b\u0627\u0621"\
- "\u0627\u0644\u0623\u0631\u0628\u0639\u0627\u0621"\
- "\u0627\u0644\u062e\u0645\u064a\u0633"\
- "\u0627\u0644\u062c\u0645\u0639\u0629"\
- "\u0627\u0644\u0633\u0628\u062a"]
+ "الأحد"\
+ "الاثنين"\
+ "الثلاثاء"\
+ "الأربعاء"\
+ "الخميس"\
+ "الجمعة"\
+ "السبت"]
::msgcat::mcset ar_SY MONTHS_ABBREV [list \
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0634\u0628\u0627\u0637"\
- "\u0622\u0630\u0627\u0631"\
- "\u0646\u064a\u0633\u0627\u0646"\
- "\u0646\u0648\u0627\u0631"\
- "\u062d\u0632\u064a\u0631\u0627\u0646"\
- "\u062a\u0645\u0648\u0632"\
- "\u0622\u0628"\
- "\u0623\u064a\u0644\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
+ "كانون الثاني"\
+ "شباط"\
+ "آذار"\
+ "نيسان"\
+ "نوار"\
+ "حزيران"\
+ "تموز"\
+ "آب"\
+ "أيلول"\
+ "تشرين الأول"\
+ "تشرين الثاني"\
+ "كانون الأول"\
""]
::msgcat::mcset ar_SY MONTHS_FULL [list \
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0634\u0628\u0627\u0637"\
- "\u0622\u0630\u0627\u0631"\
- "\u0646\u064a\u0633\u0627\u0646"\
- "\u0646\u0648\u0627\u0631\u0627\u0646"\
- "\u062d\u0632\u064a\u0631"\
- "\u062a\u0645\u0648\u0632"\
- "\u0622\u0628"\
- "\u0623\u064a\u0644\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u0623\u0648\u0644"\
- "\u062a\u0634\u0631\u064a\u0646 \u0627\u0644\u062b\u0627\u0646\u064a"\
- "\u0643\u0627\u0646\u0648\u0646 \u0627\u0644\u0623\u0648\u0644"\
+ "كانون الثاني"\
+ "شباط"\
+ "آذار"\
+ "نيسان"\
+ "نواران"\
+ "حزير"\
+ "تموز"\
+ "آب"\
+ "أيلول"\
+ "تشرين الأول"\
+ "تشرين الثاني"\
+ "كانون الأول"\
""]
}
diff --git a/library/msgs/be.msg b/library/msgs/be.msg
index 379a1d7..a0aceed 100644
--- a/library/msgs/be.msg
+++ b/library/msgs/be.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset be DAYS_OF_WEEK_ABBREV [list \
- "\u043d\u0434"\
- "\u043f\u043d"\
- "\u0430\u0442"\
- "\u0441\u0440"\
- "\u0447\u0446"\
- "\u043f\u0442"\
- "\u0441\u0431"]
+ "нд"\
+ "пн"\
+ "ат"\
+ "ÑÑ€"\
+ "чц"\
+ "пт"\
+ "Ñб"]
::msgcat::mcset be DAYS_OF_WEEK_FULL [list \
- "\u043d\u044f\u0434\u0437\u0435\u043b\u044f"\
- "\u043f\u0430\u043d\u044f\u0434\u0437\u0435\u043b\u0430\u043a"\
- "\u0430\u045e\u0442\u043e\u0440\u0430\u043a"\
- "\u0441\u0435\u0440\u0430\u0434\u0430"\
- "\u0447\u0430\u0446\u0432\u0435\u0440"\
- "\u043f\u044f\u0442\u043d\u0456\u0446\u0430"\
- "\u0441\u0443\u0431\u043e\u0442\u0430"]
+ "нÑдзелÑ"\
+ "панÑдзелак"\
+ "аўторак"\
+ "Ñерада"\
+ "чацвер"\
+ "пÑтніца"\
+ "Ñубота"]
::msgcat::mcset be MONTHS_ABBREV [list \
- "\u0441\u0442\u0434"\
- "\u043b\u044e\u0442"\
- "\u0441\u043a\u0432"\
- "\u043a\u0440\u0441"\
- "\u043c\u0430\u0439"\
- "\u0447\u0440\u0432"\
- "\u043b\u043f\u043d"\
- "\u0436\u043d\u0432"\
- "\u0432\u0440\u0441"\
- "\u043a\u0441\u0442"\
- "\u043b\u0441\u0442"\
- "\u0441\u043d\u0436"\
+ "Ñтд"\
+ "лют"\
+ "Ñкв"\
+ "крÑ"\
+ "май"\
+ "чрв"\
+ "лпн"\
+ "жнв"\
+ "врÑ"\
+ "кÑÑ‚"\
+ "лÑÑ‚"\
+ "Ñнж"\
""]
::msgcat::mcset be MONTHS_FULL [list \
- "\u0441\u0442\u0443\u0434\u0437\u0435\u043d\u044f"\
- "\u043b\u044e\u0442\u0430\u0433\u0430"\
- "\u0441\u0430\u043a\u0430\u0432\u0456\u043a\u0430"\
- "\u043a\u0440\u0430\u0441\u0430\u0432\u0456\u043a\u0430"\
- "\u043c\u0430\u044f"\
- "\u0447\u0440\u0432\u0435\u043d\u044f"\
- "\u043b\u0456\u043f\u0435\u043d\u044f"\
- "\u0436\u043d\u0456\u045e\u043d\u044f"\
- "\u0432\u0435\u0440\u0430\u0441\u043d\u044f"\
- "\u043a\u0430\u0441\u0442\u0440\u044b\u0447\u043d\u0456\u043a\u0430"\
- "\u043b\u0438\u0441\u0442\u0430\u043f\u0430\u0434\u0430"\
- "\u0441\u043d\u0435\u0436\u043d\u044f"\
+ "ÑтудзенÑ"\
+ "лютага"\
+ "Ñакавіка"\
+ "краÑавіка"\
+ "маÑ"\
+ "чрвенÑ"\
+ "ліпенÑ"\
+ "жніўнÑ"\
+ "вераÑнÑ"\
+ "каÑтрычніка"\
+ "лиÑтапада"\
+ "ÑнежнÑ"\
""]
- ::msgcat::mcset be BCE "\u0434\u0430 \u043d.\u0435."
- ::msgcat::mcset be CE "\u043d.\u0435."
+ ::msgcat::mcset be BCE "да н.е."
+ ::msgcat::mcset be CE "н.е."
::msgcat::mcset be DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset be TIME_FORMAT "%k.%M.%S"
::msgcat::mcset be DATE_TIME_FORMAT "%e.%m.%Y %k.%M.%S %z"
diff --git a/library/msgs/bg.msg b/library/msgs/bg.msg
index ff17759..2e7730d 100644
--- a/library/msgs/bg.msg
+++ b/library/msgs/bg.msg
@@ -1,21 +1,21 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset bg DAYS_OF_WEEK_ABBREV [list \
- "\u041d\u0434"\
- "\u041f\u043d"\
- "\u0412\u0442"\
- "\u0421\u0440"\
- "\u0427\u0442"\
- "\u041f\u0442"\
- "\u0421\u0431"]
+ "Ðд"\
+ "Пн"\
+ "Ð’Ñ‚"\
+ "Ср"\
+ "Чт"\
+ "Пт"\
+ "Сб"]
::msgcat::mcset bg DAYS_OF_WEEK_FULL [list \
- "\u041d\u0435\u0434\u0435\u043b\u044f"\
- "\u041f\u043e\u043d\u0435\u0434\u0435\u043b\u043d\u0438\u043a"\
- "\u0412\u0442\u043e\u0440\u043d\u0438\u043a"\
- "\u0421\u0440\u044f\u0434\u0430"\
- "\u0427\u0435\u0442\u0432\u044a\u0440\u0442\u044a\u043a"\
- "\u041f\u0435\u0442\u044a\u043a"\
- "\u0421\u044a\u0431\u043e\u0442\u0430"]
+ "ÐеделÑ"\
+ "Понеделник"\
+ "Вторник"\
+ "СрÑда"\
+ "Четвъртък"\
+ "Петък"\
+ "Събота"]
::msgcat::mcset bg MONTHS_ABBREV [list \
"I"\
"II"\
@@ -31,21 +31,21 @@ namespace eval ::tcl::clock {
"XII"\
""]
::msgcat::mcset bg MONTHS_FULL [list \
- "\u042f\u043d\u0443\u0430\u0440\u0438"\
- "\u0424\u0435\u0432\u0440\u0443\u0430\u0440\u0438"\
- "\u041c\u0430\u0440\u0442"\
- "\u0410\u043f\u0440\u0438\u043b"\
- "\u041c\u0430\u0439"\
- "\u042e\u043d\u0438"\
- "\u042e\u043b\u0438"\
- "\u0410\u0432\u0433\u0443\u0441\u0442"\
- "\u0421\u0435\u043f\u0442\u0435\u043c\u0432\u0440\u0438"\
- "\u041e\u043a\u0442\u043e\u043c\u0432\u0440\u0438"\
- "\u041d\u043e\u0435\u043c\u0432\u0440\u0438"\
- "\u0414\u0435\u043a\u0435\u043c\u0432\u0440\u0438"\
+ "Януари"\
+ "Февруари"\
+ "Март"\
+ "Ðприл"\
+ "Май"\
+ "Юни"\
+ "Юли"\
+ "ÐвгуÑÑ‚"\
+ "Септември"\
+ "Октомври"\
+ "Ðоември"\
+ "Декември"\
""]
- ::msgcat::mcset bg BCE "\u043f\u0440.\u043d.\u0435."
- ::msgcat::mcset bg CE "\u043d.\u0435."
+ ::msgcat::mcset bg BCE "пр.н.е."
+ ::msgcat::mcset bg CE "н.е."
::msgcat::mcset bg DATE_FORMAT "%Y-%m-%e"
::msgcat::mcset bg TIME_FORMAT "%k:%M:%S"
::msgcat::mcset bg DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"
diff --git a/library/msgs/bn.msg b/library/msgs/bn.msg
index 664b9d8..a0aef13 100644
--- a/library/msgs/bn.msg
+++ b/library/msgs/bn.msg
@@ -1,49 +1,49 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset bn DAYS_OF_WEEK_ABBREV [list \
- "\u09b0\u09ac\u09bf"\
- "\u09b8\u09cb\u09ae"\
- "\u09ae\u0999\u0997\u09b2"\
- "\u09ac\u09c1\u09a7"\
- "\u09ac\u09c3\u09b9\u09b8\u09cd\u09aa\u09a4\u09bf"\
- "\u09b6\u09c1\u0995\u09cd\u09b0"\
- "\u09b6\u09a8\u09bf"]
+ "রবি"\
+ "সোম"\
+ "মঙগল"\
+ "বà§à¦§"\
+ "বৃহসà§à¦ªà¦¤à¦¿"\
+ "শà§à¦•à§à¦°"\
+ "শনি"]
::msgcat::mcset bn DAYS_OF_WEEK_FULL [list \
- "\u09b0\u09ac\u09bf\u09ac\u09be\u09b0"\
- "\u09b8\u09cb\u09ae\u09ac\u09be\u09b0"\
- "\u09ae\u0999\u0997\u09b2\u09ac\u09be\u09b0"\
- "\u09ac\u09c1\u09a7\u09ac\u09be\u09b0"\
- "\u09ac\u09c3\u09b9\u09b8\u09cd\u09aa\u09a4\u09bf\u09ac\u09be\u09b0"\
- "\u09b6\u09c1\u0995\u09cd\u09b0\u09ac\u09be\u09b0"\
- "\u09b6\u09a8\u09bf\u09ac\u09be\u09b0"]
+ "রবিবার"\
+ "সোমবার"\
+ "মঙগলবার"\
+ "বà§à¦§à¦¬à¦¾à¦°"\
+ "বৃহসà§à¦ªà¦¤à¦¿à¦¬à¦¾à¦°"\
+ "শà§à¦•à§à¦°à¦¬à¦¾à¦°"\
+ "শনিবার"]
::msgcat::mcset bn MONTHS_ABBREV [list \
- "\u099c\u09be\u09a8\u09c1\u09df\u09be\u09b0\u09c0"\
- "\u09ab\u09c7\u09ac\u09cd\u09b0\u09c1\u09df\u09be\u09b0\u09c0"\
- "\u09ae\u09be\u09b0\u09cd\u099a"\
- "\u098f\u09aa\u09cd\u09b0\u09bf\u09b2"\
- "\u09ae\u09c7"\
- "\u099c\u09c1\u09a8"\
- "\u099c\u09c1\u09b2\u09be\u0987"\
- "\u0986\u0997\u09b8\u09cd\u099f"\
- "\u09b8\u09c7\u09aa\u09cd\u099f\u09c7\u09ae\u09cd\u09ac\u09b0"\
- "\u0985\u0995\u09cd\u099f\u09cb\u09ac\u09b0"\
- "\u09a8\u09ad\u09c7\u09ae\u09cd\u09ac\u09b0"\
- "\u09a1\u09bf\u09b8\u09c7\u09ae\u09cd\u09ac\u09b0"\
+ "জানà§à§Ÿà¦¾à¦°à§€"\
+ "ফেবà§à¦°à§à§Ÿà¦¾à¦°à§€"\
+ "মারà§à¦š"\
+ "à¦à¦ªà§à¦°à¦¿à¦²"\
+ "মে"\
+ "জà§à¦¨"\
+ "জà§à¦²à¦¾à¦‡"\
+ "আগসà§à¦Ÿ"\
+ "সেপà§à¦Ÿà§‡à¦®à§à¦¬à¦°"\
+ "অকà§à¦Ÿà§‹à¦¬à¦°"\
+ "নভেমà§à¦¬à¦°"\
+ "ডিসেমà§à¦¬à¦°"\
""]
::msgcat::mcset bn MONTHS_FULL [list \
- "\u099c\u09be\u09a8\u09c1\u09df\u09be\u09b0\u09c0"\
- "\u09ab\u09c7\u09ac\u09cd\u09b0\u09c1\u09df\u09be\u09b0\u09c0"\
- "\u09ae\u09be\u09b0\u09cd\u099a"\
- "\u098f\u09aa\u09cd\u09b0\u09bf\u09b2"\
- "\u09ae\u09c7"\
- "\u099c\u09c1\u09a8"\
- "\u099c\u09c1\u09b2\u09be\u0987"\
- "\u0986\u0997\u09b8\u09cd\u099f"\
- "\u09b8\u09c7\u09aa\u09cd\u099f\u09c7\u09ae\u09cd\u09ac\u09b0"\
- "\u0985\u0995\u09cd\u099f\u09cb\u09ac\u09b0"\
- "\u09a8\u09ad\u09c7\u09ae\u09cd\u09ac\u09b0"\
- "\u09a1\u09bf\u09b8\u09c7\u09ae\u09cd\u09ac\u09b0"\
+ "জানà§à§Ÿà¦¾à¦°à§€"\
+ "ফেবà§à¦°à§à§Ÿà¦¾à¦°à§€"\
+ "মারà§à¦š"\
+ "à¦à¦ªà§à¦°à¦¿à¦²"\
+ "মে"\
+ "জà§à¦¨"\
+ "জà§à¦²à¦¾à¦‡"\
+ "আগসà§à¦Ÿ"\
+ "সেপà§à¦Ÿà§‡à¦®à§à¦¬à¦°"\
+ "অকà§à¦Ÿà§‹à¦¬à¦°"\
+ "নভেমà§à¦¬à¦°"\
+ "ডিসেমà§à¦¬à¦°"\
""]
- ::msgcat::mcset bn AM "\u09aa\u09c2\u09b0\u09cd\u09ac\u09be\u09b9\u09cd\u09a3"
- ::msgcat::mcset bn PM "\u0985\u09aa\u09b0\u09be\u09b9\u09cd\u09a3"
+ ::msgcat::mcset bn AM "পূরà§à¦¬à¦¾à¦¹à§à¦£"
+ ::msgcat::mcset bn PM "অপরাহà§à¦£"
}
diff --git a/library/msgs/ca.msg b/library/msgs/ca.msg
index 36c9772..272f682 100644
--- a/library/msgs/ca.msg
+++ b/library/msgs/ca.msg
@@ -19,7 +19,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset ca MONTHS_ABBREV [list \
"gen."\
"feb."\
- "mar\u00e7"\
+ "març"\
"abr."\
"maig"\
"juny"\
@@ -33,7 +33,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset ca MONTHS_FULL [list \
"gener"\
"febrer"\
- "mar\u00e7"\
+ "març"\
"abril"\
"maig"\
"juny"\
diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg
index 8db8bdd..4673cd4 100644
--- a/library/msgs/cs.msg
+++ b/library/msgs/cs.msg
@@ -3,18 +3,18 @@ namespace eval ::tcl::clock {
::msgcat::mcset cs DAYS_OF_WEEK_ABBREV [list \
"Ne"\
"Po"\
- "\u00dat"\
+ "Út"\
"St"\
- "\u010ct"\
- "P\u00e1"\
+ "ÄŒt"\
+ "Pá"\
"So"]
::msgcat::mcset cs DAYS_OF_WEEK_FULL [list \
- "Ned\u011ble"\
- "Pond\u011bl\u00ed"\
- "\u00dater\u00fd"\
- "St\u0159eda"\
- "\u010ctvrtek"\
- "P\u00e1tek"\
+ "Neděle"\
+ "Pondělí"\
+ "Úterý"\
+ "Středa"\
+ "ÄŒtvrtek"\
+ "Pátek"\
"Sobota"]
::msgcat::mcset cs MONTHS_ABBREV [list \
"I"\
@@ -32,19 +32,19 @@ namespace eval ::tcl::clock {
""]
::msgcat::mcset cs MONTHS_FULL [list \
"leden"\
- "\u00fanor"\
- "b\u0159ezen"\
+ "únor"\
+ "březen"\
"duben"\
- "kv\u011bten"\
- "\u010derven"\
- "\u010dervenec"\
+ "květen"\
+ "Äerven"\
+ "Äervenec"\
"srpen"\
- "z\u00e1\u0159\u00ed"\
- "\u0159\u00edjen"\
+ "září"\
+ "říjen"\
"listopad"\
"prosinec"\
""]
- ::msgcat::mcset cs BCE "p\u0159.Kr."
+ ::msgcat::mcset cs BCE "pÅ™.Kr."
::msgcat::mcset cs CE "po Kr."
::msgcat::mcset cs AM "dop."
::msgcat::mcset cs PM "odp."
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index e4fec7f..abed3c5 100644
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
@@ -1,21 +1,21 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset da DAYS_OF_WEEK_ABBREV [list \
- "s\u00f8"\
+ "sø"\
"ma"\
"ti"\
"on"\
"to"\
"fr"\
- "l\u00f8"]
+ "lø"]
::msgcat::mcset da DAYS_OF_WEEK_FULL [list \
- "s\u00f8ndag"\
+ "søndag"\
"mandag"\
"tirsdag"\
"onsdag"\
"torsdag"\
"fredag"\
- "l\u00f8rdag"]
+ "lørdag"]
::msgcat::mcset da MONTHS_ABBREV [list \
"jan"\
"feb"\
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 9eb3145..0bb7399 100644
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
@@ -33,7 +33,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset de MONTHS_FULL [list \
"Januar"\
"Februar"\
- "M\u00e4rz"\
+ "März"\
"April"\
"Mai"\
"Juni"\
diff --git a/library/msgs/de_at.msg b/library/msgs/de_at.msg
index 61bc266..1a0a0f5 100644
--- a/library/msgs/de_at.msg
+++ b/library/msgs/de_at.msg
@@ -1,9 +1,9 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset de_AT MONTHS_ABBREV [list \
- "J\u00e4n"\
+ "Jän"\
"Feb"\
- "M\u00e4r"\
+ "Mär"\
"Apr"\
"Mai"\
"Jun"\
@@ -15,9 +15,9 @@ namespace eval ::tcl::clock {
"Dez"\
""]
::msgcat::mcset de_AT MONTHS_FULL [list \
- "J\u00e4nner"\
+ "Jänner"\
"Februar"\
- "M\u00e4rz"\
+ "März"\
"April"\
"Mai"\
"Juni"\
diff --git a/library/msgs/de_be.msg b/library/msgs/de_be.msg
index 3614763..04cf88c 100644
--- a/library/msgs/de_be.msg
+++ b/library/msgs/de_be.msg
@@ -19,7 +19,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset de_BE MONTHS_ABBREV [list \
"Jan"\
"Feb"\
- "M\u00e4r"\
+ "Mär"\
"Apr"\
"Mai"\
"Jun"\
@@ -33,7 +33,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset de_BE MONTHS_FULL [list \
"Januar"\
"Februar"\
- "M\u00e4rz"\
+ "März"\
"April"\
"Mai"\
"Juni"\
diff --git a/library/msgs/el.msg b/library/msgs/el.msg
index ac19f62..26bdfe9 100644
--- a/library/msgs/el.msg
+++ b/library/msgs/el.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset el DAYS_OF_WEEK_ABBREV [list \
- "\u039a\u03c5\u03c1"\
- "\u0394\u03b5\u03c5"\
- "\u03a4\u03c1\u03b9"\
- "\u03a4\u03b5\u03c4"\
- "\u03a0\u03b5\u03bc"\
- "\u03a0\u03b1\u03c1"\
- "\u03a3\u03b1\u03b2"]
+ "ΚυÏ"\
+ "Δευ"\
+ "ΤÏι"\
+ "Τετ"\
+ "Πεμ"\
+ "ΠαÏ"\
+ "Σαβ"]
::msgcat::mcset el DAYS_OF_WEEK_FULL [list \
- "\u039a\u03c5\u03c1\u03b9\u03b1\u03ba\u03ae"\
- "\u0394\u03b5\u03c5\u03c4\u03ad\u03c1\u03b1"\
- "\u03a4\u03c1\u03af\u03c4\u03b7"\
- "\u03a4\u03b5\u03c4\u03ac\u03c1\u03c4\u03b7"\
- "\u03a0\u03ad\u03bc\u03c0\u03c4\u03b7"\
- "\u03a0\u03b1\u03c1\u03b1\u03c3\u03ba\u03b5\u03c5\u03ae"\
- "\u03a3\u03ac\u03b2\u03b2\u03b1\u03c4\u03bf"]
+ "ΚυÏιακή"\
+ "ΔευτέÏα"\
+ "ΤÏίτη"\
+ "ΤετάÏτη"\
+ "Πέμπτη"\
+ "ΠαÏασκευή"\
+ "Σάββατο"]
::msgcat::mcset el MONTHS_ABBREV [list \
- "\u0399\u03b1\u03bd"\
- "\u03a6\u03b5\u03b2"\
- "\u039c\u03b1\u03c1"\
- "\u0391\u03c0\u03c1"\
- "\u039c\u03b1\u03ca"\
- "\u0399\u03bf\u03c5\u03bd"\
- "\u0399\u03bf\u03c5\u03bb"\
- "\u0391\u03c5\u03b3"\
- "\u03a3\u03b5\u03c0"\
- "\u039f\u03ba\u03c4"\
- "\u039d\u03bf\u03b5"\
- "\u0394\u03b5\u03ba"\
+ "Ιαν"\
+ "Φεβ"\
+ "ΜαÏ"\
+ "ΑπÏ"\
+ "Μαϊ"\
+ "Ιουν"\
+ "Ιουλ"\
+ "Αυγ"\
+ "Σεπ"\
+ "Οκτ"\
+ "Îοε"\
+ "Δεκ"\
""]
::msgcat::mcset el MONTHS_FULL [list \
- "\u0399\u03b1\u03bd\u03bf\u03c5\u03ac\u03c1\u03b9\u03bf\u03c2"\
- "\u03a6\u03b5\u03b2\u03c1\u03bf\u03c5\u03ac\u03c1\u03b9\u03bf\u03c2"\
- "\u039c\u03ac\u03c1\u03c4\u03b9\u03bf\u03c2"\
- "\u0391\u03c0\u03c1\u03af\u03bb\u03b9\u03bf\u03c2"\
- "\u039c\u03ac\u03ca\u03bf\u03c2"\
- "\u0399\u03bf\u03cd\u03bd\u03b9\u03bf\u03c2"\
- "\u0399\u03bf\u03cd\u03bb\u03b9\u03bf\u03c2"\
- "\u0391\u03cd\u03b3\u03bf\u03c5\u03c3\u03c4\u03bf\u03c2"\
- "\u03a3\u03b5\u03c0\u03c4\u03ad\u03bc\u03b2\u03c1\u03b9\u03bf\u03c2"\
- "\u039f\u03ba\u03c4\u03ce\u03b2\u03c1\u03b9\u03bf\u03c2"\
- "\u039d\u03bf\u03ad\u03bc\u03b2\u03c1\u03b9\u03bf\u03c2"\
- "\u0394\u03b5\u03ba\u03ad\u03bc\u03b2\u03c1\u03b9\u03bf\u03c2"\
+ "ΙανουάÏιος"\
+ "ΦεβÏουάÏιος"\
+ "ΜάÏτιος"\
+ "ΑπÏίλιος"\
+ "Μάϊος"\
+ "ΙοÏνιος"\
+ "ΙοÏλιος"\
+ "ΑÏγουστος"\
+ "ΣεπτέμβÏιος"\
+ "ΟκτώβÏιος"\
+ "ÎοέμβÏιος"\
+ "ΔεκέμβÏιος"\
""]
- ::msgcat::mcset el AM "\u03c0\u03bc"
- ::msgcat::mcset el PM "\u03bc\u03bc"
+ ::msgcat::mcset el AM "πμ"
+ ::msgcat::mcset el PM "μμ"
::msgcat::mcset el DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset el TIME_FORMAT_12 "%l:%M:%S %P"
::msgcat::mcset el DATE_TIME_FORMAT "%e/%m/%Y %l:%M:%S %P %z"
diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg
index 1d2a24f..b9b1500 100644
--- a/library/msgs/eo.msg
+++ b/library/msgs/eo.msg
@@ -5,15 +5,15 @@ namespace eval ::tcl::clock {
"lu"\
"ma"\
"me"\
- "\u0135a"\
+ "ĵa"\
"ve"\
"sa"]
::msgcat::mcset eo DAYS_OF_WEEK_FULL [list \
- "diman\u0109o"\
+ "dimanĉo"\
"lundo"\
"mardo"\
"merkredo"\
- "\u0135a\u016ddo"\
+ "ĵaŭdo"\
"vendredo"\
"sabato"]
::msgcat::mcset eo MONTHS_ABBREV [list \
@@ -24,7 +24,7 @@ namespace eval ::tcl::clock {
"maj"\
"jun"\
"jul"\
- "a\u016dg"\
+ "aÅ­g"\
"sep"\
"okt"\
"nov"\
@@ -38,7 +38,7 @@ namespace eval ::tcl::clock {
"majo"\
"junio"\
"julio"\
- "a\u016dgusto"\
+ "aÅ­gusto"\
"septembro"\
"oktobro"\
"novembro"\
diff --git a/library/msgs/es.msg b/library/msgs/es.msg
index a24f0a1..6090eab 100644
--- a/library/msgs/es.msg
+++ b/library/msgs/es.msg
@@ -4,18 +4,18 @@ namespace eval ::tcl::clock {
"dom"\
"lun"\
"mar"\
- "mi\u00e9"\
+ "mié"\
"jue"\
"vie"\
- "s\u00e1b"]
+ "sáb"]
::msgcat::mcset es DAYS_OF_WEEK_FULL [list \
"domingo"\
"lunes"\
"martes"\
- "mi\u00e9rcoles"\
+ "miércoles"\
"jueves"\
"viernes"\
- "s\u00e1bado"]
+ "sábado"]
::msgcat::mcset es MONTHS_ABBREV [list \
"ene"\
"feb"\
diff --git a/library/msgs/et.msg b/library/msgs/et.msg
index 8d32e9e..a782f9b 100644
--- a/library/msgs/et.msg
+++ b/library/msgs/et.msg
@@ -9,17 +9,17 @@ namespace eval ::tcl::clock {
"R"\
"L"]
::msgcat::mcset et DAYS_OF_WEEK_FULL [list \
- "p\u00fchap\u00e4ev"\
- "esmasp\u00e4ev"\
- "teisip\u00e4ev"\
- "kolmap\u00e4ev"\
- "neljap\u00e4ev"\
+ "pühapäev"\
+ "esmaspäev"\
+ "teisipäev"\
+ "kolmapäev"\
+ "neljapäev"\
"reede"\
- "laup\u00e4ev"]
+ "laupäev"]
::msgcat::mcset et MONTHS_ABBREV [list \
"Jaan"\
"Veebr"\
- "M\u00e4rts"\
+ "Märts"\
"Apr"\
"Mai"\
"Juuni"\
@@ -33,7 +33,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset et MONTHS_FULL [list \
"Jaanuar"\
"Veebruar"\
- "M\u00e4rts"\
+ "Märts"\
"Aprill"\
"Mai"\
"Juuni"\
diff --git a/library/msgs/fa.msg b/library/msgs/fa.msg
index 89b2f90..6166e28 100644
--- a/library/msgs/fa.msg
+++ b/library/msgs/fa.msg
@@ -1,47 +1,47 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset fa DAYS_OF_WEEK_ABBREV [list \
- "\u06cc\u2214"\
- "\u062f\u2214"\
- "\u0633\u2214"\
- "\u0686\u2214"\
- "\u067e\u2214"\
- "\u062c\u2214"\
- "\u0634\u2214"]
+ "ی∔"\
+ "د∔"\
+ "س∔"\
+ "چ∔"\
+ "پ∔"\
+ "ج∔"\
+ "ش∔"]
::msgcat::mcset fa DAYS_OF_WEEK_FULL [list \
- "\u06cc\u06cc\u200c\u0634\u0646\u0628\u0647"\
- "\u062f\u0648\u0634\u0646\u0628\u0647"\
- "\u0633\u0647\u200c\u0634\u0646\u0628\u0647"\
- "\u0686\u0647\u0627\u0631\u0634\u0646\u0628\u0647"\
- "\u067e\u0646\u062c\u200c\u0634\u0646\u0628\u0647"\
- "\u062c\u0645\u0639\u0647"\
- "\u0634\u0646\u0628\u0647"]
+ "یی‌شنبه"\
+ "دوشنبه"\
+ "سه‌شنبه"\
+ "چهارشنبه"\
+ "پنج‌شنبه"\
+ "جمعه"\
+ "شنبه"]
::msgcat::mcset fa MONTHS_ABBREV [list \
- "\u0698\u0627\u0646"\
- "\u0641\u0648\u0631"\
- "\u0645\u0627\u0631"\
- "\u0622\u0648\u0631"\
- "\u0645\u0640\u0647"\
- "\u0698\u0648\u0646"\
- "\u0698\u0648\u06cc"\
- "\u0627\u0648\u062a"\
- "\u0633\u067e\u062a"\
- "\u0627\u0643\u062a"\
- "\u0646\u0648\u0627"\
- "\u062f\u0633\u0627"\
+ "ژان"\
+ "Ùور"\
+ "مار"\
+ "آور"\
+ "مـه"\
+ "ژون"\
+ "ژوی"\
+ "اوت"\
+ "سپت"\
+ "اكت"\
+ "نوا"\
+ "دسا"\
""]
::msgcat::mcset fa MONTHS_FULL [list \
- "\u0698\u0627\u0646\u0648\u06cc\u0647"\
- "\u0641\u0648\u0631\u0648\u06cc\u0647"\
- "\u0645\u0627\u0631\u0633"\
- "\u0622\u0648\u0631\u06cc\u0644"\
- "\u0645\u0647"\
- "\u0698\u0648\u0626\u0646"\
- "\u0698\u0648\u0626\u06cc\u0647"\
- "\u0627\u0648\u062a"\
- "\u0633\u067e\u062a\u0627\u0645\u0628\u0631"\
- "\u0627\u0643\u062a\u0628\u0631"\
- "\u0646\u0648\u0627\u0645\u0628\u0631"\
- "\u062f\u0633\u0627\u0645\u0628\u0631"\
+ "ژانویه"\
+ "Ùورویه"\
+ "مارس"\
+ "آوریل"\
+ "مه"\
+ "ژوئن"\
+ "ژوئیه"\
+ "اوت"\
+ "سپتامبر"\
+ "اكتبر"\
+ "نوامبر"\
+ "دسامبر"\
""]
}
diff --git a/library/msgs/fa_in.msg b/library/msgs/fa_in.msg
index adc9e91..ce32f99 100644
--- a/library/msgs/fa_in.msg
+++ b/library/msgs/fa_in.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset fa_IN DAYS_OF_WEEK_ABBREV [list \
- "\u06cc\u2214"\
- "\u062f\u2214"\
- "\u0633\u2214"\
- "\u0686\u2214"\
- "\u067e\u2214"\
- "\u062c\u2214"\
- "\u0634\u2214"]
+ "ی∔"\
+ "د∔"\
+ "س∔"\
+ "چ∔"\
+ "پ∔"\
+ "ج∔"\
+ "ش∔"]
::msgcat::mcset fa_IN DAYS_OF_WEEK_FULL [list \
- "\u06cc\u06cc\u200c\u0634\u0646\u0628\u0647"\
- "\u062f\u0648\u0634\u0646\u0628\u0647"\
- "\u0633\u0647\u200c\u0634\u0646\u0628\u0647"\
- "\u0686\u0647\u0627\u0631\u0634\u0646\u0628\u0647"\
- "\u067e\u0646\u062c\u200c\u0634\u0646\u0628\u0647"\
- "\u062c\u0645\u0639\u0647"\
- "\u0634\u0646\u0628\u0647"]
+ "یی‌شنبه"\
+ "دوشنبه"\
+ "سه‌شنبه"\
+ "چهارشنبه"\
+ "پنج‌شنبه"\
+ "جمعه"\
+ "شنبه"]
::msgcat::mcset fa_IN MONTHS_ABBREV [list \
- "\u0698\u0627\u0646"\
- "\u0641\u0648\u0631"\
- "\u0645\u0627\u0631"\
- "\u0622\u0648\u0631"\
- "\u0645\u0640\u0647"\
- "\u0698\u0648\u0646"\
- "\u0698\u0648\u06cc"\
- "\u0627\u0648\u062a"\
- "\u0633\u067e\u062a"\
- "\u0627\u0643\u062a"\
- "\u0646\u0648\u0627"\
- "\u062f\u0633\u0627"\
+ "ژان"\
+ "Ùور"\
+ "مار"\
+ "آور"\
+ "مـه"\
+ "ژون"\
+ "ژوی"\
+ "اوت"\
+ "سپت"\
+ "اكت"\
+ "نوا"\
+ "دسا"\
""]
::msgcat::mcset fa_IN MONTHS_FULL [list \
- "\u0698\u0627\u0646\u0648\u06cc\u0647"\
- "\u0641\u0648\u0631\u0648\u06cc\u0647"\
- "\u0645\u0627\u0631\u0633"\
- "\u0622\u0648\u0631\u06cc\u0644"\
- "\u0645\u0647"\
- "\u0698\u0648\u0626\u0646"\
- "\u0698\u0648\u0626\u06cc\u0647"\
- "\u0627\u0648\u062a"\
- "\u0633\u067e\u062a\u0627\u0645\u0628\u0631"\
- "\u0627\u0643\u062a\u0628\u0631"\
- "\u0646\u0648\u0627\u0645\u0628\u0631"\
- "\u062f\u0633\u0627\u0645\u0628\u0631"\
+ "ژانویه"\
+ "Ùورویه"\
+ "مارس"\
+ "آوریل"\
+ "مه"\
+ "ژوئن"\
+ "ژوئیه"\
+ "اوت"\
+ "سپتامبر"\
+ "اكتبر"\
+ "نوامبر"\
+ "دسامبر"\
""]
- ::msgcat::mcset fa_IN AM "\u0635\u0628\u062d"
- ::msgcat::mcset fa_IN PM "\u0639\u0635\u0631"
+ ::msgcat::mcset fa_IN AM "صبح"
+ ::msgcat::mcset fa_IN PM "عصر"
::msgcat::mcset fa_IN DATE_FORMAT "%A %d %B %Y"
::msgcat::mcset fa_IN TIME_FORMAT_12 "%I:%M:%S %z"
::msgcat::mcset fa_IN DATE_TIME_FORMAT "%A %d %B %Y %I:%M:%S %z %z"
diff --git a/library/msgs/fa_ir.msg b/library/msgs/fa_ir.msg
index 597ce9d..9ce9284 100644
--- a/library/msgs/fa_ir.msg
+++ b/library/msgs/fa_ir.msg
@@ -1,9 +1,9 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
- ::msgcat::mcset fa_IR AM "\u0635\u0628\u062d"
- ::msgcat::mcset fa_IR PM "\u0639\u0635\u0631"
- ::msgcat::mcset fa_IR DATE_FORMAT "%d\u2044%m\u2044%Y"
+ ::msgcat::mcset fa_IR AM "صبح"
+ ::msgcat::mcset fa_IR PM "عصر"
+ ::msgcat::mcset fa_IR DATE_FORMAT "%dâ„%mâ„%Y"
::msgcat::mcset fa_IR TIME_FORMAT "%S:%M:%H"
::msgcat::mcset fa_IR TIME_FORMAT_12 "%S:%M:%l %P"
- ::msgcat::mcset fa_IR DATE_TIME_FORMAT "%d\u2044%m\u2044%Y %S:%M:%H %z"
+ ::msgcat::mcset fa_IR DATE_TIME_FORMAT "%dâ„%mâ„%Y %S:%M:%H %z"
}
diff --git a/library/msgs/fi.msg b/library/msgs/fi.msg
index acabba0..69be367 100644
--- a/library/msgs/fi.msg
+++ b/library/msgs/fi.msg
@@ -22,8 +22,8 @@ namespace eval ::tcl::clock {
"maalis"\
"huhti"\
"touko"\
- "kes\u00e4"\
- "hein\u00e4"\
+ "kesä"\
+ "heinä"\
"elo"\
"syys"\
"loka"\
@@ -36,8 +36,8 @@ namespace eval ::tcl::clock {
"maaliskuu"\
"huhtikuu"\
"toukokuu"\
- "kes\u00e4kuu"\
- "hein\u00e4kuu"\
+ "kesäkuu"\
+ "heinäkuu"\
"elokuu"\
"syyskuu"\
"lokakuu"\
diff --git a/library/msgs/fo.msg b/library/msgs/fo.msg
index 4696e62..1f1794d 100644
--- a/library/msgs/fo.msg
+++ b/library/msgs/fo.msg
@@ -2,19 +2,19 @@
namespace eval ::tcl::clock {
::msgcat::mcset fo DAYS_OF_WEEK_ABBREV [list \
"sun"\
- "m\u00e1n"\
- "t\u00fds"\
+ "mán"\
+ "týs"\
"mik"\
- "h\u00f3s"\
- "fr\u00ed"\
+ "hós"\
+ "frí"\
"ley"]
::msgcat::mcset fo DAYS_OF_WEEK_FULL [list \
"sunnudagur"\
- "m\u00e1nadagur"\
- "t\u00fdsdagur"\
+ "mánadagur"\
+ "týsdagur"\
"mikudagur"\
- "h\u00f3sdagur"\
- "fr\u00edggjadagur"\
+ "hósdagur"\
+ "fríggjadagur"\
"leygardagur"]
::msgcat::mcset fo MONTHS_ABBREV [list \
"jan"\
@@ -34,7 +34,7 @@ namespace eval ::tcl::clock {
"januar"\
"februar"\
"mars"\
- "apr\u00edl"\
+ "apríl"\
"mai"\
"juni"\
"juli"\
diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg
index 55b19bf..a274468 100644
--- a/library/msgs/fr.msg
+++ b/library/msgs/fr.msg
@@ -18,31 +18,31 @@ namespace eval ::tcl::clock {
"samedi"]
::msgcat::mcset fr MONTHS_ABBREV [list \
"janv."\
- "f\u00e9vr."\
+ "févr."\
"mars"\
"avr."\
"mai"\
"juin"\
"juil."\
- "ao\u00fbt"\
+ "août"\
"sept."\
"oct."\
"nov."\
- "d\u00e9c."\
+ "déc."\
""]
::msgcat::mcset fr MONTHS_FULL [list \
"janvier"\
- "f\u00e9vrier"\
+ "février"\
"mars"\
"avril"\
"mai"\
"juin"\
"juillet"\
- "ao\u00fbt"\
+ "août"\
"septembre"\
"octobre"\
"novembre"\
- "d\u00e9cembre"\
+ "décembre"\
""]
::msgcat::mcset fr BCE "av. J.-C."
::msgcat::mcset fr CE "ap. J.-C."
diff --git a/library/msgs/ga.msg b/library/msgs/ga.msg
index 6edf13a..056c9a0 100644
--- a/library/msgs/ga.msg
+++ b/library/msgs/ga.msg
@@ -3,45 +3,45 @@ namespace eval ::tcl::clock {
::msgcat::mcset ga DAYS_OF_WEEK_ABBREV [list \
"Domh"\
"Luan"\
- "M\u00e1irt"\
- "C\u00e9ad"\
- "D\u00e9ar"\
+ "Máirt"\
+ "Céad"\
+ "Déar"\
"Aoine"\
"Sath"]
::msgcat::mcset ga DAYS_OF_WEEK_FULL [list \
- "D\u00e9 Domhnaigh"\
- "D\u00e9 Luain"\
- "D\u00e9 M\u00e1irt"\
- "D\u00e9 C\u00e9adaoin"\
- "D\u00e9ardaoin"\
- "D\u00e9 hAoine"\
- "D\u00e9 Sathairn"]
+ "Dé Domhnaigh"\
+ "Dé Luain"\
+ "Dé Máirt"\
+ "Dé Céadaoin"\
+ "Déardaoin"\
+ "Dé hAoine"\
+ "Dé Sathairn"]
::msgcat::mcset ga MONTHS_ABBREV [list \
"Ean"\
"Feabh"\
- "M\u00e1rta"\
+ "Márta"\
"Aib"\
"Beal"\
"Meith"\
- "I\u00fail"\
- "L\u00fan"\
- "MF\u00f3mh"\
- "DF\u00f3mh"\
+ "Iúil"\
+ "Lún"\
+ "MFómh"\
+ "DFómh"\
"Samh"\
"Noll"\
""]
::msgcat::mcset ga MONTHS_FULL [list \
- "Ean\u00e1ir"\
+ "Eanáir"\
"Feabhra"\
- "M\u00e1rta"\
- "Aibre\u00e1n"\
- "M\u00ed na Bealtaine"\
+ "Márta"\
+ "Aibreán"\
+ "Mí na Bealtaine"\
"Meith"\
- "I\u00fail"\
- "L\u00fanasa"\
- "Me\u00e1n F\u00f3mhair"\
- "Deireadh F\u00f3mhair"\
- "M\u00ed na Samhna"\
- "M\u00ed na Nollag"\
+ "Iúil"\
+ "Lúnasa"\
+ "Meán Fómhair"\
+ "Deireadh Fómhair"\
+ "Mí na Samhna"\
+ "Mí na Nollag"\
""]
}
diff --git a/library/msgs/gl.msg b/library/msgs/gl.msg
index 4b869e8..c2fefc9 100644
--- a/library/msgs/gl.msg
+++ b/library/msgs/gl.msg
@@ -4,25 +4,25 @@ namespace eval ::tcl::clock {
"Dom"\
"Lun"\
"Mar"\
- "M\u00e9r"\
+ "Mér"\
"Xov"\
"Ven"\
- "S\u00e1b"]
+ "Sáb"]
::msgcat::mcset gl DAYS_OF_WEEK_FULL [list \
"Domingo"\
"Luns"\
"Martes"\
- "M\u00e9rcores"\
+ "Mércores"\
"Xoves"\
"Venres"\
- "S\u00e1bado"]
+ "Sábado"]
::msgcat::mcset gl MONTHS_ABBREV [list \
"Xan"\
"Feb"\
"Mar"\
"Abr"\
"Mai"\
- "Xu\u00f1"\
+ "Xuñ"\
"Xul"\
"Ago"\
"Set"\
@@ -36,7 +36,7 @@ namespace eval ::tcl::clock {
"Marzo"\
"Abril"\
"Maio"\
- "Xu\u00f1o"\
+ "Xuño"\
"Xullo"\
"Agosto"\
"Setembro"\
diff --git a/library/msgs/he.msg b/library/msgs/he.msg
index 4fd921d..13a81b7 100644
--- a/library/msgs/he.msg
+++ b/library/msgs/he.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset he DAYS_OF_WEEK_ABBREV [list \
- "\u05d0"\
- "\u05d1"\
- "\u05d2"\
- "\u05d3"\
- "\u05d4"\
- "\u05d5"\
- "\u05e9"]
+ "×"\
+ "ב"\
+ "×’"\
+ "ד"\
+ "×”"\
+ "ו"\
+ "ש"]
::msgcat::mcset he DAYS_OF_WEEK_FULL [list \
- "\u05d9\u05d5\u05dd \u05e8\u05d0\u05e9\u05d5\u05df"\
- "\u05d9\u05d5\u05dd \u05e9\u05e0\u05d9"\
- "\u05d9\u05d5\u05dd \u05e9\u05dc\u05d9\u05e9\u05d9"\
- "\u05d9\u05d5\u05dd \u05e8\u05d1\u05d9\u05e2\u05d9"\
- "\u05d9\u05d5\u05dd \u05d7\u05de\u05d9\u05e9\u05d9"\
- "\u05d9\u05d5\u05dd \u05e9\u05d9\u05e9\u05d9"\
- "\u05e9\u05d1\u05ea"]
+ "×™×•× ×¨×שון"\
+ "×™×•× ×©× ×™"\
+ "×™×•× ×©×œ×™×©×™"\
+ "×™×•× ×¨×‘×™×¢×™"\
+ "×™×•× ×—×ž×™×©×™"\
+ "×™×•× ×©×™×©×™"\
+ "שבת"]
::msgcat::mcset he MONTHS_ABBREV [list \
- "\u05d9\u05e0\u05d5"\
- "\u05e4\u05d1\u05e8"\
- "\u05de\u05e8\u05e5"\
- "\u05d0\u05e4\u05e8"\
- "\u05de\u05d0\u05d9"\
- "\u05d9\u05d5\u05e0"\
- "\u05d9\u05d5\u05dc"\
- "\u05d0\u05d5\u05d2"\
- "\u05e1\u05e4\u05d8"\
- "\u05d0\u05d5\u05e7"\
- "\u05e0\u05d5\u05d1"\
- "\u05d3\u05e6\u05de"\
+ "ינו"\
+ "פבר"\
+ "מרץ"\
+ "×פר"\
+ "מ××™"\
+ "יונ"\
+ "יול"\
+ "×וג"\
+ "ספט"\
+ "×וק"\
+ "נוב"\
+ "דצמ"\
""]
::msgcat::mcset he MONTHS_FULL [list \
- "\u05d9\u05e0\u05d5\u05d0\u05e8"\
- "\u05e4\u05d1\u05e8\u05d5\u05d0\u05e8"\
- "\u05de\u05e8\u05e5"\
- "\u05d0\u05e4\u05e8\u05d9\u05dc"\
- "\u05de\u05d0\u05d9"\
- "\u05d9\u05d5\u05e0\u05d9"\
- "\u05d9\u05d5\u05dc\u05d9"\
- "\u05d0\u05d5\u05d2\u05d5\u05e1\u05d8"\
- "\u05e1\u05e4\u05d8\u05de\u05d1\u05e8"\
- "\u05d0\u05d5\u05e7\u05d8\u05d5\u05d1\u05e8"\
- "\u05e0\u05d5\u05d1\u05de\u05d1\u05e8"\
- "\u05d3\u05e6\u05de\u05d1\u05e8"\
+ "ינו×ר"\
+ "פברו×ר"\
+ "מרץ"\
+ "×פריל"\
+ "מ××™"\
+ "יוני"\
+ "יולי"\
+ "×וגוסט"\
+ "ספטמבר"\
+ "×וקטובר"\
+ "נובמבר"\
+ "דצמבר"\
""]
- ::msgcat::mcset he BCE "\u05dc\u05e1\u05d4\u0022\u05e0"
- ::msgcat::mcset he CE "\u05dc\u05e4\u05e1\u05d4\u0022\u05e0"
+ ::msgcat::mcset he BCE "לסה"נ"
+ ::msgcat::mcset he CE "לפסה"נ"
::msgcat::mcset he DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset he TIME_FORMAT "%H:%M:%S"
::msgcat::mcset he DATE_TIME_FORMAT "%d/%m/%Y %H:%M:%S %z"
diff --git a/library/msgs/hi.msg b/library/msgs/hi.msg
index 50c9fb8..18c8bf0 100644
--- a/library/msgs/hi.msg
+++ b/library/msgs/hi.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset hi DAYS_OF_WEEK_FULL [list \
- "\u0930\u0935\u093f\u0935\u093e\u0930"\
- "\u0938\u094b\u092e\u0935\u093e\u0930"\
- "\u092e\u0902\u0917\u0932\u0935\u093e\u0930"\
- "\u092c\u0941\u0927\u0935\u093e\u0930"\
- "\u0917\u0941\u0930\u0941\u0935\u093e\u0930"\
- "\u0936\u0941\u0915\u094d\u0930\u0935\u093e\u0930"\
- "\u0936\u0928\u093f\u0935\u093e\u0930"]
+ "रविवार"\
+ "सोमवार"\
+ "मंगलवार"\
+ "बà¥à¤§à¤µà¤¾à¤°"\
+ "गà¥à¤°à¥à¤µà¤¾à¤°"\
+ "शà¥à¤•à¥à¤°à¤µà¤¾à¤°"\
+ "शनिवार"]
::msgcat::mcset hi MONTHS_ABBREV [list \
- "\u091c\u0928\u0935\u0930\u0940"\
- "\u092b\u093c\u0930\u0935\u0930\u0940"\
- "\u092e\u093e\u0930\u094d\u091a"\
- "\u0905\u092a\u094d\u0930\u0947\u0932"\
- "\u092e\u0908"\
- "\u091c\u0942\u0928"\
- "\u091c\u0941\u0932\u093e\u0908"\
- "\u0905\u0917\u0938\u094d\u0924"\
- "\u0938\u093f\u0924\u092e\u094d\u092c\u0930"\
- "\u0905\u0915\u094d\u091f\u0942\u092c\u0930"\
- "\u0928\u0935\u092e\u094d\u092c\u0930"\
- "\u0926\u093f\u0938\u092e\u094d\u092c\u0930"]
+ "जनवरी"\
+ "फ़रवरी"\
+ "मारà¥à¤š"\
+ "अपà¥à¤°à¥‡à¤²"\
+ "मई"\
+ "जून"\
+ "जà¥à¤²à¤¾à¤ˆ"\
+ "अगसà¥à¤¤"\
+ "सितमà¥à¤¬à¤°"\
+ "अकà¥à¤Ÿà¥‚बर"\
+ "नवमà¥à¤¬à¤°"\
+ "दिसमà¥à¤¬à¤°"]
::msgcat::mcset hi MONTHS_FULL [list \
- "\u091c\u0928\u0935\u0930\u0940"\
- "\u092b\u093c\u0930\u0935\u0930\u0940"\
- "\u092e\u093e\u0930\u094d\u091a"\
- "\u0905\u092a\u094d\u0930\u0947\u0932"\
- "\u092e\u0908"\
- "\u091c\u0942\u0928"\
- "\u091c\u0941\u0932\u093e\u0908"\
- "\u0905\u0917\u0938\u094d\u0924"\
- "\u0938\u093f\u0924\u092e\u094d\u092c\u0930"\
- "\u0905\u0915\u094d\u091f\u0942\u092c\u0930"\
- "\u0928\u0935\u092e\u094d\u092c\u0930"\
- "\u0926\u093f\u0938\u092e\u094d\u092c\u0930"]
- ::msgcat::mcset hi AM "\u0908\u0938\u093e\u092a\u0942\u0930\u094d\u0935"
+ "जनवरी"\
+ "फ़रवरी"\
+ "मारà¥à¤š"\
+ "अपà¥à¤°à¥‡à¤²"\
+ "मई"\
+ "जून"\
+ "जà¥à¤²à¤¾à¤ˆ"\
+ "अगसà¥à¤¤"\
+ "सितमà¥à¤¬à¤°"\
+ "अकà¥à¤Ÿà¥‚बर"\
+ "नवमà¥à¤¬à¤°"\
+ "दिसमà¥à¤¬à¤°"]
+ ::msgcat::mcset hi AM "ईसापूरà¥à¤µ"
::msgcat::mcset hi PM "."
}
diff --git a/library/msgs/hr.msg b/library/msgs/hr.msg
index cec145b..30491e1 100644
--- a/library/msgs/hr.msg
+++ b/library/msgs/hr.msg
@@ -5,7 +5,7 @@ namespace eval ::tcl::clock {
"pon"\
"uto"\
"sri"\
- "\u010det"\
+ "Äet"\
"pet"\
"sub"]
::msgcat::mcset hr DAYS_OF_WEEK_FULL [list \
@@ -13,13 +13,13 @@ namespace eval ::tcl::clock {
"ponedjeljak"\
"utorak"\
"srijeda"\
- "\u010detvrtak"\
+ "Äetvrtak"\
"petak"\
"subota"]
::msgcat::mcset hr MONTHS_ABBREV [list \
"sij"\
"vel"\
- "o\u017eu"\
+ "ožu"\
"tra"\
"svi"\
"lip"\
@@ -31,9 +31,9 @@ namespace eval ::tcl::clock {
"pro"\
""]
::msgcat::mcset hr MONTHS_FULL [list \
- "sije\u010danj"\
- "velja\u010da"\
- "o\u017eujak"\
+ "sijeÄanj"\
+ "veljaÄa"\
+ "ožujak"\
"travanj"\
"svibanj"\
"lipanj"\
diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg
index e5e68d9..46776dd 100644
--- a/library/msgs/hu.msg
+++ b/library/msgs/hu.msg
@@ -9,21 +9,21 @@ namespace eval ::tcl::clock {
"P"\
"Szo"]
::msgcat::mcset hu DAYS_OF_WEEK_FULL [list \
- "vas\u00e1rnap"\
- "h\u00e9tf\u0151"\
+ "vasárnap"\
+ "hétfő"\
"kedd"\
"szerda"\
- "cs\u00fct\u00f6rt\u00f6k"\
- "p\u00e9ntek"\
+ "csütörtök"\
+ "péntek"\
"szombat"]
::msgcat::mcset hu MONTHS_ABBREV [list \
"jan."\
"febr."\
- "m\u00e1rc."\
- "\u00e1pr."\
- "m\u00e1j."\
- "j\u00fan."\
- "j\u00fal."\
+ "márc."\
+ "ápr."\
+ "máj."\
+ "jún."\
+ "júl."\
"aug."\
"szept."\
"okt."\
@@ -31,16 +31,16 @@ namespace eval ::tcl::clock {
"dec."\
""]
::msgcat::mcset hu MONTHS_FULL [list \
- "janu\u00e1r"\
- "febru\u00e1r"\
- "m\u00e1rcius"\
- "\u00e1prilis"\
- "m\u00e1jus"\
- "j\u00fanius"\
- "j\u00falius"\
+ "január"\
+ "február"\
+ "március"\
+ "április"\
+ "május"\
+ "június"\
+ "július"\
"augusztus"\
"szeptember"\
- "okt\u00f3ber"\
+ "október"\
"november"\
"december"\
""]
diff --git a/library/msgs/is.msg b/library/msgs/is.msg
index adc2d2a..a369b89 100644
--- a/library/msgs/is.msg
+++ b/library/msgs/is.msg
@@ -2,46 +2,46 @@
namespace eval ::tcl::clock {
::msgcat::mcset is DAYS_OF_WEEK_ABBREV [list \
"sun."\
- "m\u00e1n."\
- "\u00feri."\
- "mi\u00f0."\
+ "mán."\
+ "þri."\
+ "mið."\
"fim."\
- "f\u00f6s."\
+ "fös."\
"lau."]
::msgcat::mcset is DAYS_OF_WEEK_FULL [list \
"sunnudagur"\
- "m\u00e1nudagur"\
- "\u00feri\u00f0judagur"\
- "mi\u00f0vikudagur"\
+ "mánudagur"\
+ "þriðjudagur"\
+ "miðvikudagur"\
"fimmtudagur"\
- "f\u00f6studagur"\
+ "föstudagur"\
"laugardagur"]
::msgcat::mcset is MONTHS_ABBREV [list \
"jan."\
"feb."\
"mar."\
"apr."\
- "ma\u00ed"\
- "j\u00fan."\
- "j\u00fal."\
- "\u00e1g\u00fa."\
+ "maí"\
+ "jún."\
+ "júl."\
+ "ágú."\
"sep."\
"okt."\
- "n\u00f3v."\
+ "nóv."\
"des."\
""]
::msgcat::mcset is MONTHS_FULL [list \
- "jan\u00faar"\
- "febr\u00faar"\
+ "janúar"\
+ "febrúar"\
"mars"\
- "apr\u00edl"\
- "ma\u00ed"\
- "j\u00fan\u00ed"\
- "j\u00fal\u00ed"\
- "\u00e1g\u00fast"\
+ "apríl"\
+ "maí"\
+ "júní"\
+ "júlí"\
+ "ágúst"\
"september"\
- "okt\u00f3ber"\
- "n\u00f3vember"\
+ "október"\
+ "nóvember"\
"desember"\
""]
::msgcat::mcset is DATE_FORMAT "%e.%m.%Y"
diff --git a/library/msgs/it.msg b/library/msgs/it.msg
index b641cde..e51aee2 100644
--- a/library/msgs/it.msg
+++ b/library/msgs/it.msg
@@ -10,11 +10,11 @@ namespace eval ::tcl::clock {
"sab"]
::msgcat::mcset it DAYS_OF_WEEK_FULL [list \
"domenica"\
- "luned\u00ec"\
- "marted\u00ec"\
- "mercoled\u00ec"\
- "gioved\u00ec"\
- "venerd\u00ec"\
+ "lunedì"\
+ "martedì"\
+ "mercoledì"\
+ "giovedì"\
+ "venerdì"\
"sabato"]
::msgcat::mcset it MONTHS_ABBREV [list \
"gen"\
diff --git a/library/msgs/ja.msg b/library/msgs/ja.msg
index 2767665..76b5fa4 100644
--- a/library/msgs/ja.msg
+++ b/library/msgs/ja.msg
@@ -1,44 +1,44 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ja DAYS_OF_WEEK_ABBREV [list \
- "\u65e5"\
- "\u6708"\
- "\u706b"\
- "\u6c34"\
- "\u6728"\
- "\u91d1"\
- "\u571f"]
+ "æ—¥"\
+ "月"\
+ "ç«"\
+ "æ°´"\
+ "木"\
+ "金"\
+ "土"]
::msgcat::mcset ja DAYS_OF_WEEK_FULL [list \
- "\u65e5\u66dc\u65e5"\
- "\u6708\u66dc\u65e5"\
- "\u706b\u66dc\u65e5"\
- "\u6c34\u66dc\u65e5"\
- "\u6728\u66dc\u65e5"\
- "\u91d1\u66dc\u65e5"\
- "\u571f\u66dc\u65e5"]
+ "日曜日"\
+ "月曜日"\
+ "ç«æ›œæ—¥"\
+ "水曜日"\
+ "木曜日"\
+ "金曜日"\
+ "土曜日"]
::msgcat::mcset ja MONTHS_FULL [list \
- "1\u6708"\
- "2\u6708"\
- "3\u6708"\
- "4\u6708"\
- "5\u6708"\
- "6\u6708"\
- "7\u6708"\
- "8\u6708"\
- "9\u6708"\
- "10\u6708"\
- "11\u6708"\
- "12\u6708"]
- ::msgcat::mcset ja BCE "\u7d00\u5143\u524d"
- ::msgcat::mcset ja CE "\u897f\u66a6"
- ::msgcat::mcset ja AM "\u5348\u524d"
- ::msgcat::mcset ja PM "\u5348\u5f8c"
+ "1月"\
+ "2月"\
+ "3月"\
+ "4月"\
+ "5月"\
+ "6月"\
+ "7月"\
+ "8月"\
+ "9月"\
+ "10月"\
+ "11月"\
+ "12月"]
+ ::msgcat::mcset ja BCE "紀元å‰"
+ ::msgcat::mcset ja CE "西暦"
+ ::msgcat::mcset ja AM "åˆå‰"
+ ::msgcat::mcset ja PM "åˆå¾Œ"
::msgcat::mcset ja DATE_FORMAT "%Y/%m/%d"
::msgcat::mcset ja TIME_FORMAT "%k:%M:%S"
::msgcat::mcset ja TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset ja DATE_TIME_FORMAT "%Y/%m/%d %k:%M:%S %z"
- ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY\u5e74%m\u6708%d\u65e5"
- ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H\u6642%M\u5206%S\u79d2"
- ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY\u5e74%m\u6708%d\u65e5 (%a) %H\u6642%M\u5206%S\u79d2 %z"
- ::msgcat::mcset ja LOCALE_ERAS "\u007b-9223372036854775808 \u897f\u66a6 0\u007d \u007b-3061011600 \u660e\u6cbb 1867\u007d \u007b-1812186000 \u5927\u6b63 1911\u007d \u007b-1357635600 \u662d\u548c 1925\u007d \u007b600220800 \u5e73\u6210 1988\u007d"
+ ::msgcat::mcset ja LOCALE_DATE_FORMAT "%EY年%m月%d日"
+ ::msgcat::mcset ja LOCALE_TIME_FORMAT "%H時%M分%S秒"
+ ::msgcat::mcset ja LOCALE_DATE_TIME_FORMAT "%EY年%m月%d日 (%a) %H時%M分%S秒 %z"
+ ::msgcat::mcset ja LOCALE_ERAS "{-9223372036854775808 西暦 0} {-3061011600 明治 1867} {-1812186000 大正 1911} {-1357635600 昭和 1925} {600220800 å¹³æˆ 1988}"
}
diff --git a/library/msgs/ko.msg b/library/msgs/ko.msg
index 0cd17a1..817c2e7 100644
--- a/library/msgs/ko.msg
+++ b/library/msgs/ko.msg
@@ -1,55 +1,55 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ko DAYS_OF_WEEK_ABBREV [list \
- "\uc77c"\
- "\uc6d4"\
- "\ud654"\
- "\uc218"\
- "\ubaa9"\
- "\uae08"\
- "\ud1a0"]
+ "ì¼"\
+ "ì›”"\
+ "í™”"\
+ "수"\
+ "목"\
+ "금"\
+ "토"]
::msgcat::mcset ko DAYS_OF_WEEK_FULL [list \
- "\uc77c\uc694\uc77c"\
- "\uc6d4\uc694\uc77c"\
- "\ud654\uc694\uc77c"\
- "\uc218\uc694\uc77c"\
- "\ubaa9\uc694\uc77c"\
- "\uae08\uc694\uc77c"\
- "\ud1a0\uc694\uc77c"]
+ "ì¼ìš”ì¼"\
+ "월요ì¼"\
+ "화요ì¼"\
+ "수요ì¼"\
+ "목요ì¼"\
+ "금요ì¼"\
+ "토요ì¼"]
::msgcat::mcset ko MONTHS_ABBREV [list \
- "1\uc6d4"\
- "2\uc6d4"\
- "3\uc6d4"\
- "4\uc6d4"\
- "5\uc6d4"\
- "6\uc6d4"\
- "7\uc6d4"\
- "8\uc6d4"\
- "9\uc6d4"\
- "10\uc6d4"\
- "11\uc6d4"\
- "12\uc6d4"\
+ "1ì›”"\
+ "2ì›”"\
+ "3ì›”"\
+ "4ì›”"\
+ "5ì›”"\
+ "6ì›”"\
+ "7ì›”"\
+ "8ì›”"\
+ "9ì›”"\
+ "10ì›”"\
+ "11ì›”"\
+ "12ì›”"\
""]
::msgcat::mcset ko MONTHS_FULL [list \
- "1\uc6d4"\
- "2\uc6d4"\
- "3\uc6d4"\
- "4\uc6d4"\
- "5\uc6d4"\
- "6\uc6d4"\
- "7\uc6d4"\
- "8\uc6d4"\
- "9\uc6d4"\
- "10\uc6d4"\
- "11\uc6d4"\
- "12\uc6d4"\
+ "1ì›”"\
+ "2ì›”"\
+ "3ì›”"\
+ "4ì›”"\
+ "5ì›”"\
+ "6ì›”"\
+ "7ì›”"\
+ "8ì›”"\
+ "9ì›”"\
+ "10ì›”"\
+ "11ì›”"\
+ "12ì›”"\
""]
- ::msgcat::mcset ko AM "\uc624\uc804"
- ::msgcat::mcset ko PM "\uc624\ud6c4"
+ ::msgcat::mcset ko AM "오전"
+ ::msgcat::mcset ko PM "오후"
::msgcat::mcset ko DATE_FORMAT "%Y-%m-%d"
::msgcat::mcset ko TIME_FORMAT_12 "%P %l:%M:%S"
::msgcat::mcset ko DATE_TIME_FORMAT "%Y-%m-%d %P %l:%M:%S %z"
- ::msgcat::mcset ko LOCALE_DATE_FORMAT "%Y\ub144%B%Od\uc77c"
- ::msgcat::mcset ko LOCALE_TIME_FORMAT "%H\uc2dc%M\ubd84%S\ucd08"
- ::msgcat::mcset ko LOCALE_DATE_TIME_FORMAT "%A %Y\ub144%B%Od\uc77c%H\uc2dc%M\ubd84%S\ucd08 %z"
+ ::msgcat::mcset ko LOCALE_DATE_FORMAT "%Yë…„%B%Odì¼"
+ ::msgcat::mcset ko LOCALE_TIME_FORMAT "%H시%M분%S초"
+ ::msgcat::mcset ko LOCALE_DATE_TIME_FORMAT "%A %Yë…„%B%Odì¼%Hì‹œ%M분%Sì´ˆ %z"
}
diff --git a/library/msgs/ko_kr.msg b/library/msgs/ko_kr.msg
index ea5bbd7..f23bd6b 100644
--- a/library/msgs/ko_kr.msg
+++ b/library/msgs/ko_kr.msg
@@ -1,7 +1,7 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
- ::msgcat::mcset ko_KR BCE "\uae30\uc6d0\uc804"
- ::msgcat::mcset ko_KR CE "\uc11c\uae30"
+ ::msgcat::mcset ko_KR BCE "기ì›ì „"
+ ::msgcat::mcset ko_KR CE "서기"
::msgcat::mcset ko_KR DATE_FORMAT "%Y.%m.%d"
::msgcat::mcset ko_KR TIME_FORMAT_12 "%P %l:%M:%S"
::msgcat::mcset ko_KR DATE_TIME_FORMAT "%Y.%m.%d %P %l:%M:%S %z"
diff --git a/library/msgs/kok.msg b/library/msgs/kok.msg
index 0869f20..231853b 100644
--- a/library/msgs/kok.msg
+++ b/library/msgs/kok.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset kok DAYS_OF_WEEK_FULL [list \
- "\u0906\u0926\u093f\u0924\u094d\u092f\u0935\u093e\u0930"\
- "\u0938\u094b\u092e\u0935\u093e\u0930"\
- "\u092e\u0902\u0917\u0933\u093e\u0930"\
- "\u092c\u0941\u0927\u0935\u093e\u0930"\
- "\u0917\u0941\u0930\u0941\u0935\u093e\u0930"\
- "\u0936\u0941\u0915\u094d\u0930\u0935\u093e\u0930"\
- "\u0936\u0928\u093f\u0935\u093e\u0930"]
+ "आदितà¥à¤¯à¤µà¤¾à¤°"\
+ "सोमवार"\
+ "मंगळार"\
+ "बà¥à¤§à¤µà¤¾à¤°"\
+ "गà¥à¤°à¥à¤µà¤¾à¤°"\
+ "शà¥à¤•à¥à¤°à¤µà¤¾à¤°"\
+ "शनिवार"]
::msgcat::mcset kok MONTHS_ABBREV [list \
- "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
- "\u092b\u0947\u092c\u0943\u0935\u093e\u0930\u0940"\
- "\u092e\u093e\u0930\u094d\u091a"\
- "\u090f\u092a\u094d\u0930\u093f\u0932"\
- "\u092e\u0947"\
- "\u091c\u0942\u0928"\
- "\u091c\u0941\u0932\u0948"\
- "\u0913\u0917\u0938\u094d\u091f"\
- "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
- "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
- "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
- "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
+ "जानेवारी"\
+ "फेबृवारी"\
+ "मारà¥à¤š"\
+ "à¤à¤ªà¥à¤°à¤¿à¤²"\
+ "मे"\
+ "जून"\
+ "जà¥à¤²à¥ˆ"\
+ "ओगसà¥à¤Ÿ"\
+ "सेपà¥à¤Ÿà¥‡à¤‚बर"\
+ "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
+ "नोवà¥à¤¹à¥‡à¤‚बर"\
+ "डिसेंबर"]
::msgcat::mcset kok MONTHS_FULL [list \
- "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
- "\u092b\u0947\u092c\u094d\u0930\u0941\u0935\u093e\u0930\u0940"\
- "\u092e\u093e\u0930\u094d\u091a"\
- "\u090f\u092a\u094d\u0930\u093f\u0932"\
- "\u092e\u0947"\
- "\u091c\u0942\u0928"\
- "\u091c\u0941\u0932\u0948"\
- "\u0913\u0917\u0938\u094d\u091f"\
- "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
- "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
- "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
- "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
- ::msgcat::mcset kok AM "\u0915\u094d\u0930\u093f\u0938\u094d\u0924\u092a\u0942\u0930\u094d\u0935"
- ::msgcat::mcset kok PM "\u0915\u094d\u0930\u093f\u0938\u094d\u0924\u0936\u0916\u093e"
+ "जानेवारी"\
+ "फेबà¥à¤°à¥à¤µà¤¾à¤°à¥€"\
+ "मारà¥à¤š"\
+ "à¤à¤ªà¥à¤°à¤¿à¤²"\
+ "मे"\
+ "जून"\
+ "जà¥à¤²à¥ˆ"\
+ "ओगसà¥à¤Ÿ"\
+ "सेपà¥à¤Ÿà¥‡à¤‚बर"\
+ "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
+ "नोवà¥à¤¹à¥‡à¤‚बर"\
+ "डिसेंबर"]
+ ::msgcat::mcset kok AM "कà¥à¤°à¤¿à¤¸à¥à¤¤à¤ªà¥‚रà¥à¤µ"
+ ::msgcat::mcset kok PM "कà¥à¤°à¤¿à¤¸à¥à¤¤à¤¶à¤–ा"
}
diff --git a/library/msgs/lt.msg b/library/msgs/lt.msg
index 27b0985..15829a9 100644
--- a/library/msgs/lt.msg
+++ b/library/msgs/lt.msg
@@ -7,15 +7,15 @@ namespace eval ::tcl::clock {
"Tr"\
"Kt"\
"Pn"\
- "\u0160t"]
+ "Å t"]
::msgcat::mcset lt DAYS_OF_WEEK_FULL [list \
"Sekmadienis"\
"Pirmadienis"\
"Antradienis"\
- "Tre\u010diadienis"\
+ "TreÄiadienis"\
"Ketvirtadienis"\
"Penktadienis"\
- "\u0160e\u0161tadienis"]
+ "Šeštadienis"]
::msgcat::mcset lt MONTHS_ABBREV [list \
"Sau"\
"Vas"\
@@ -34,15 +34,15 @@ namespace eval ::tcl::clock {
"Sausio"\
"Vasario"\
"Kovo"\
- "Baland\u017eio"\
- "Gegu\u017e\u0117s"\
- "Bir\u017eelio"\
+ "Balandžio"\
+ "Gegužės"\
+ "Birželio"\
"Liepos"\
- "Rugpj\u016b\u010dio"\
- "Rugs\u0117jo"\
+ "RugpjÅ«Äio"\
+ "RugsÄ—jo"\
"Spalio"\
- "Lapkri\u010dio"\
- "Gruod\u017eio"\
+ "LapkriÄio"\
+ "Gruodžio"\
""]
::msgcat::mcset lt BCE "pr.Kr."
::msgcat::mcset lt CE "po.Kr."
diff --git a/library/msgs/lv.msg b/library/msgs/lv.msg
index a037b15..730fd33 100644
--- a/library/msgs/lv.msg
+++ b/library/msgs/lv.msg
@@ -9,10 +9,10 @@ namespace eval ::tcl::clock {
"Pk"\
"S"]
::msgcat::mcset lv DAYS_OF_WEEK_FULL [list \
- "sv\u0113tdiena"\
+ "svētdiena"\
"pirmdiena"\
"otrdiena"\
- "tre\u0161diena"\
+ "trešdiena"\
"ceturdien"\
"piektdiena"\
"sestdiena"]
@@ -22,8 +22,8 @@ namespace eval ::tcl::clock {
"Mar"\
"Apr"\
"Maijs"\
- "J\u016bn"\
- "J\u016bl"\
+ "JÅ«n"\
+ "JÅ«l"\
"Aug"\
"Sep"\
"Okt"\
@@ -31,21 +31,21 @@ namespace eval ::tcl::clock {
"Dec"\
""]
::msgcat::mcset lv MONTHS_FULL [list \
- "janv\u0101ris"\
- "febru\u0101ris"\
+ "janvÄris"\
+ "februÄris"\
"marts"\
- "apr\u012blis"\
+ "aprīlis"\
"maijs"\
- "j\u016bnijs"\
- "j\u016blijs"\
+ "jūnijs"\
+ "jūlijs"\
"augusts"\
"septembris"\
"oktobris"\
"novembris"\
"decembris"\
""]
- ::msgcat::mcset lv BCE "pm\u0113"
- ::msgcat::mcset lv CE "m\u0113"
+ ::msgcat::mcset lv BCE "pmē"
+ ::msgcat::mcset lv CE "mē"
::msgcat::mcset lv DATE_FORMAT "%Y.%e.%m"
::msgcat::mcset lv TIME_FORMAT "%H:%M:%S"
::msgcat::mcset lv DATE_TIME_FORMAT "%Y.%e.%m %H:%M:%S %z"
diff --git a/library/msgs/mk.msg b/library/msgs/mk.msg
index 41cf60d..9b7bd9d 100644
--- a/library/msgs/mk.msg
+++ b/library/msgs/mk.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset mk DAYS_OF_WEEK_ABBREV [list \
- "\u043d\u0435\u0434."\
- "\u043f\u043e\u043d."\
- "\u0432\u0442."\
- "\u0441\u0440\u0435."\
- "\u0447\u0435\u0442."\
- "\u043f\u0435\u0442."\
- "\u0441\u0430\u0431."]
+ "нед."\
+ "пон."\
+ "вт."\
+ "Ñре."\
+ "чет."\
+ "пет."\
+ "Ñаб."]
::msgcat::mcset mk DAYS_OF_WEEK_FULL [list \
- "\u043d\u0435\u0434\u0435\u043b\u0430"\
- "\u043f\u043e\u043d\u0435\u0434\u0435\u043b\u043d\u0438\u043a"\
- "\u0432\u0442\u043e\u0440\u043d\u0438\u043a"\
- "\u0441\u0440\u0435\u0434\u0430"\
- "\u0447\u0435\u0442\u0432\u0440\u0442\u043e\u043a"\
- "\u043f\u0435\u0442\u043e\u043a"\
- "\u0441\u0430\u0431\u043e\u0442\u0430"]
+ "недела"\
+ "понеделник"\
+ "вторник"\
+ "Ñреда"\
+ "четврток"\
+ "петок"\
+ "Ñабота"]
::msgcat::mcset mk MONTHS_ABBREV [list \
- "\u0458\u0430\u043d."\
- "\u0444\u0435\u0432."\
- "\u043c\u0430\u0440."\
- "\u0430\u043f\u0440."\
- "\u043c\u0430\u0458."\
- "\u0458\u0443\u043d."\
- "\u0458\u0443\u043b."\
- "\u0430\u0432\u0433."\
- "\u0441\u0435\u043f\u0442."\
- "\u043e\u043a\u0442."\
- "\u043d\u043e\u0435\u043c."\
- "\u0434\u0435\u043a\u0435\u043c."\
+ "јан."\
+ "фев."\
+ "мар."\
+ "апр."\
+ "мај."\
+ "јун."\
+ "јул."\
+ "авг."\
+ "Ñепт."\
+ "окт."\
+ "ноем."\
+ "декем."\
""]
::msgcat::mcset mk MONTHS_FULL [list \
- "\u0458\u0430\u043d\u0443\u0430\u0440\u0438"\
- "\u0444\u0435\u0432\u0440\u0443\u0430\u0440\u0438"\
- "\u043c\u0430\u0440\u0442"\
- "\u0430\u043f\u0440\u0438\u043b"\
- "\u043c\u0430\u0458"\
- "\u0458\u0443\u043d\u0438"\
- "\u0458\u0443\u043b\u0438"\
- "\u0430\u0432\u0433\u0443\u0441\u0442"\
- "\u0441\u0435\u043f\u0442\u0435\u043c\u0432\u0440\u0438"\
- "\u043e\u043a\u0442\u043e\u043c\u0432\u0440\u0438"\
- "\u043d\u043e\u0435\u043c\u0432\u0440\u0438"\
- "\u0434\u0435\u043a\u0435\u043c\u0432\u0440\u0438"\
+ "јануари"\
+ "февруари"\
+ "март"\
+ "април"\
+ "мај"\
+ "јуни"\
+ "јули"\
+ "авгуÑÑ‚"\
+ "Ñептември"\
+ "октомври"\
+ "ноември"\
+ "декември"\
""]
- ::msgcat::mcset mk BCE "\u043f\u0440.\u043d.\u0435."
- ::msgcat::mcset mk CE "\u0430\u0435."
+ ::msgcat::mcset mk BCE "пр.н.е."
+ ::msgcat::mcset mk CE "ае."
::msgcat::mcset mk DATE_FORMAT "%e.%m.%Y"
::msgcat::mcset mk TIME_FORMAT "%H:%M:%S %z"
::msgcat::mcset mk DATE_TIME_FORMAT "%e.%m.%Y %H:%M:%S %z %z"
diff --git a/library/msgs/mr.msg b/library/msgs/mr.msg
index cea427a..e475615 100644
--- a/library/msgs/mr.msg
+++ b/library/msgs/mr.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset mr DAYS_OF_WEEK_FULL [list \
- "\u0930\u0935\u093f\u0935\u093e\u0930"\
- "\u0938\u094b\u092e\u0935\u093e\u0930"\
- "\u092e\u0902\u0917\u0933\u0935\u093e\u0930"\
- "\u092e\u0902\u0917\u0933\u0935\u093e\u0930"\
- "\u0917\u0941\u0930\u0941\u0935\u093e\u0930"\
- "\u0936\u0941\u0915\u094d\u0930\u0935\u093e\u0930"\
- "\u0936\u0928\u093f\u0935\u093e\u0930"]
+ "रविवार"\
+ "सोमवार"\
+ "मंगळवार"\
+ "मंगळवार"\
+ "गà¥à¤°à¥à¤µà¤¾à¤°"\
+ "शà¥à¤•à¥à¤°à¤µà¤¾à¤°"\
+ "शनिवार"]
::msgcat::mcset mr MONTHS_ABBREV [list \
- "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
- "\u092b\u0947\u092c\u0943\u0935\u093e\u0930\u0940"\
- "\u092e\u093e\u0930\u094d\u091a"\
- "\u090f\u092a\u094d\u0930\u093f\u0932"\
- "\u092e\u0947"\
- "\u091c\u0942\u0928"\
- "\u091c\u0941\u0932\u0948"\
- "\u0913\u0917\u0938\u094d\u091f"\
- "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
- "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
- "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
- "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
+ "जानेवारी"\
+ "फेबृवारी"\
+ "मारà¥à¤š"\
+ "à¤à¤ªà¥à¤°à¤¿à¤²"\
+ "मे"\
+ "जून"\
+ "जà¥à¤²à¥ˆ"\
+ "ओगसà¥à¤Ÿ"\
+ "सेपà¥à¤Ÿà¥‡à¤‚बर"\
+ "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
+ "नोवà¥à¤¹à¥‡à¤‚बर"\
+ "डिसेंबर"]
::msgcat::mcset mr MONTHS_FULL [list \
- "\u091c\u093e\u0928\u0947\u0935\u093e\u0930\u0940"\
- "\u092b\u0947\u092c\u0943\u0935\u093e\u0930\u0940"\
- "\u092e\u093e\u0930\u094d\u091a"\
- "\u090f\u092a\u094d\u0930\u093f\u0932"\
- "\u092e\u0947"\
- "\u091c\u0942\u0928"\
- "\u091c\u0941\u0932\u0948"\
- "\u0913\u0917\u0938\u094d\u091f"\
- "\u0938\u0947\u092a\u094d\u091f\u0947\u0902\u092c\u0930"\
- "\u0913\u0915\u094d\u091f\u094b\u092c\u0930"\
- "\u0928\u094b\u0935\u094d\u0939\u0947\u0902\u092c\u0930"\
- "\u0921\u093f\u0938\u0947\u0902\u092c\u0930"]
+ "जानेवारी"\
+ "फेबृवारी"\
+ "मारà¥à¤š"\
+ "à¤à¤ªà¥à¤°à¤¿à¤²"\
+ "मे"\
+ "जून"\
+ "जà¥à¤²à¥ˆ"\
+ "ओगसà¥à¤Ÿ"\
+ "सेपà¥à¤Ÿà¥‡à¤‚बर"\
+ "ओकà¥à¤Ÿà¥‹à¤¬à¤°"\
+ "नोवà¥à¤¹à¥‡à¤‚बर"\
+ "डिसेंबर"]
::msgcat::mcset mr AM "BC"
::msgcat::mcset mr PM "AD"
}
diff --git a/library/msgs/mt.msg b/library/msgs/mt.msg
index ddd5446..c479e47 100644
--- a/library/msgs/mt.msg
+++ b/library/msgs/mt.msg
@@ -1,19 +1,19 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset mt DAYS_OF_WEEK_ABBREV [list \
- "\u0126ad"\
+ "Ħad"\
"Tne"\
"Tli"\
"Erb"\
- "\u0126am"\
- "\u0120im"]
+ "Ħam"\
+ "Ä im"]
::msgcat::mcset mt MONTHS_ABBREV [list \
"Jan"\
"Fra"\
"Mar"\
"Apr"\
"Mej"\
- "\u0120un"\
+ "Ä un"\
"Lul"\
"Awi"\
"Set"\
diff --git a/library/msgs/nb.msg b/library/msgs/nb.msg
index 90d49a3..4dd76c7 100644
--- a/library/msgs/nb.msg
+++ b/library/msgs/nb.msg
@@ -1,21 +1,21 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset nb DAYS_OF_WEEK_ABBREV [list \
- "s\u00f8"\
+ "sø"\
"ma"\
"ti"\
"on"\
"to"\
"fr"\
- "l\u00f8"]
+ "lø"]
::msgcat::mcset nb DAYS_OF_WEEK_FULL [list \
- "s\u00f8ndag"\
+ "søndag"\
"mandag"\
"tirsdag"\
"onsdag"\
"torsdag"\
"fredag"\
- "l\u00f8rdag"]
+ "lørdag"]
::msgcat::mcset nb MONTHS_ABBREV [list \
"jan"\
"feb"\
diff --git a/library/msgs/nn.msg b/library/msgs/nn.msg
index bd61ac9..b61a2dd 100644
--- a/library/msgs/nn.msg
+++ b/library/msgs/nn.msg
@@ -2,7 +2,7 @@
namespace eval ::tcl::clock {
::msgcat::mcset nn DAYS_OF_WEEK_ABBREV [list \
"su"\
- "m\u00e5"\
+ "må"\
"ty"\
"on"\
"to"\
@@ -10,7 +10,7 @@ namespace eval ::tcl::clock {
"lau"]
::msgcat::mcset nn DAYS_OF_WEEK_FULL [list \
"sundag"\
- "m\u00e5ndag"\
+ "måndag"\
"tysdag"\
"onsdag"\
"torsdag"\
diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg
index d206f4b..821eea7 100644
--- a/library/msgs/pl.msg
+++ b/library/msgs/pl.msg
@@ -4,17 +4,17 @@ namespace eval ::tcl::clock {
"N"\
"Pn"\
"Wt"\
- "\u015ar"\
+ "Åšr"\
"Cz"\
"Pt"\
"So"]
::msgcat::mcset pl DAYS_OF_WEEK_FULL [list \
"niedziela"\
- "poniedzia\u0142ek"\
+ "poniedziałek"\
"wtorek"\
- "\u015broda"\
+ "środa"\
"czwartek"\
- "pi\u0105tek"\
+ "piÄ…tek"\
"sobota"]
::msgcat::mcset pl MONTHS_ABBREV [list \
"sty"\
@@ -26,23 +26,23 @@ namespace eval ::tcl::clock {
"lip"\
"sie"\
"wrz"\
- "pa\u017a"\
+ "paź"\
"lis"\
"gru"\
""]
::msgcat::mcset pl MONTHS_FULL [list \
- "stycze\u0144"\
+ "styczeń"\
"luty"\
"marzec"\
- "kwiecie\u0144"\
+ "kwiecień"\
"maj"\
"czerwiec"\
"lipiec"\
- "sierpie\u0144"\
- "wrzesie\u0144"\
- "pa\u017adziernik"\
+ "sierpień"\
+ "wrzesień"\
+ "październik"\
"listopad"\
- "grudzie\u0144"\
+ "grudzień"\
""]
::msgcat::mcset pl BCE "p.n.e."
::msgcat::mcset pl CE "n.e."
diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg
index 96fdb35..425c1f6 100644
--- a/library/msgs/pt.msg
+++ b/library/msgs/pt.msg
@@ -7,15 +7,15 @@ namespace eval ::tcl::clock {
"Qua"\
"Qui"\
"Sex"\
- "S\u00e1b"]
+ "Sáb"]
::msgcat::mcset pt DAYS_OF_WEEK_FULL [list \
"Domingo"\
"Segunda-feira"\
- "Ter\u00e7a-feira"\
+ "Terça-feira"\
"Quarta-feira"\
"Quinta-feira"\
"Sexta-feira"\
- "S\u00e1bado"]
+ "Sábado"]
::msgcat::mcset pt MONTHS_ABBREV [list \
"Jan"\
"Fev"\
@@ -33,7 +33,7 @@ namespace eval ::tcl::clock {
::msgcat::mcset pt MONTHS_FULL [list \
"Janeiro"\
"Fevereiro"\
- "Mar\u00e7o"\
+ "Março"\
"Abril"\
"Maio"\
"Junho"\
diff --git a/library/msgs/ro.msg b/library/msgs/ro.msg
index bdd7c61..f4452ba 100644
--- a/library/msgs/ro.msg
+++ b/library/msgs/ro.msg
@@ -9,13 +9,13 @@ namespace eval ::tcl::clock {
"V"\
"S"]
::msgcat::mcset ro DAYS_OF_WEEK_FULL [list \
- "duminic\u0103"\
+ "duminică"\
"luni"\
- "mar\u0163i"\
+ "marţi"\
"miercuri"\
"joi"\
"vineri"\
- "s\u00eemb\u0103t\u0103"]
+ "sîmbătă"]
::msgcat::mcset ro MONTHS_ABBREV [list \
"Ian"\
"Feb"\
@@ -45,7 +45,7 @@ namespace eval ::tcl::clock {
"decembrie"\
""]
::msgcat::mcset ro BCE "d.C."
- ::msgcat::mcset ro CE "\u00ee.d.C."
+ ::msgcat::mcset ro CE "î.d.C."
::msgcat::mcset ro DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset ro TIME_FORMAT "%H:%M:%S"
::msgcat::mcset ro DATE_TIME_FORMAT "%d.%m.%Y %H:%M:%S %z"
diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg
index 65b075d..983a253 100644
--- a/library/msgs/ru.msg
+++ b/library/msgs/ru.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ru DAYS_OF_WEEK_ABBREV [list \
- "\u0412\u0441"\
- "\u041f\u043d"\
- "\u0412\u0442"\
- "\u0421\u0440"\
- "\u0427\u0442"\
- "\u041f\u0442"\
- "\u0421\u0431"]
+ "Ð’Ñ"\
+ "Пн"\
+ "Ð’Ñ‚"\
+ "Ср"\
+ "Чт"\
+ "Пт"\
+ "Сб"]
::msgcat::mcset ru DAYS_OF_WEEK_FULL [list \
- "\u0432\u043e\u0441\u043a\u0440\u0435\u0441\u0435\u043d\u044c\u0435"\
- "\u043f\u043e\u043d\u0435\u0434\u0435\u043b\u044c\u043d\u0438\u043a"\
- "\u0432\u0442\u043e\u0440\u043d\u0438\u043a"\
- "\u0441\u0440\u0435\u0434\u0430"\
- "\u0447\u0435\u0442\u0432\u0435\u0440\u0433"\
- "\u043f\u044f\u0442\u043d\u0438\u0446\u0430"\
- "\u0441\u0443\u0431\u0431\u043e\u0442\u0430"]
+ "воÑкреÑенье"\
+ "понедельник"\
+ "вторник"\
+ "Ñреда"\
+ "четверг"\
+ "пÑтница"\
+ "Ñуббота"]
::msgcat::mcset ru MONTHS_ABBREV [list \
- "\u044f\u043d\u0432"\
- "\u0444\u0435\u0432"\
- "\u043c\u0430\u0440"\
- "\u0430\u043f\u0440"\
- "\u043c\u0430\u0439"\
- "\u0438\u044e\u043d"\
- "\u0438\u044e\u043b"\
- "\u0430\u0432\u0433"\
- "\u0441\u0435\u043d"\
- "\u043e\u043a\u0442"\
- "\u043d\u043e\u044f"\
- "\u0434\u0435\u043a"\
+ "Ñнв"\
+ "фев"\
+ "мар"\
+ "апр"\
+ "май"\
+ "июн"\
+ "июл"\
+ "авг"\
+ "Ñен"\
+ "окт"\
+ "ноÑ"\
+ "дек"\
""]
::msgcat::mcset ru MONTHS_FULL [list \
- "\u042f\u043d\u0432\u0430\u0440\u044c"\
- "\u0424\u0435\u0432\u0440\u0430\u043b\u044c"\
- "\u041c\u0430\u0440\u0442"\
- "\u0410\u043f\u0440\u0435\u043b\u044c"\
- "\u041c\u0430\u0439"\
- "\u0418\u044e\u043d\u044c"\
- "\u0418\u044e\u043b\u044c"\
- "\u0410\u0432\u0433\u0443\u0441\u0442"\
- "\u0421\u0435\u043d\u0442\u044f\u0431\u0440\u044c"\
- "\u041e\u043a\u0442\u044f\u0431\u0440\u044c"\
- "\u041d\u043e\u044f\u0431\u0440\u044c"\
- "\u0414\u0435\u043a\u0430\u0431\u0440\u044c"\
+ "Январь"\
+ "Февраль"\
+ "Март"\
+ "Ðпрель"\
+ "Май"\
+ "Июнь"\
+ "Июль"\
+ "ÐвгуÑÑ‚"\
+ "СентÑбрь"\
+ "ОктÑбрь"\
+ "ÐоÑбрь"\
+ "Декабрь"\
""]
- ::msgcat::mcset ru BCE "\u0434\u043e \u043d.\u044d."
- ::msgcat::mcset ru CE "\u043d.\u044d."
+ ::msgcat::mcset ru BCE "до н.Ñ."
+ ::msgcat::mcset ru CE "н.Ñ."
::msgcat::mcset ru DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset ru TIME_FORMAT "%k:%M:%S"
::msgcat::mcset ru DATE_TIME_FORMAT "%d.%m.%Y %k:%M:%S %z"
diff --git a/library/msgs/sh.msg b/library/msgs/sh.msg
index 6ee0fc7..2e4143d 100644
--- a/library/msgs/sh.msg
+++ b/library/msgs/sh.msg
@@ -5,7 +5,7 @@ namespace eval ::tcl::clock {
"Pon"\
"Uto"\
"Sre"\
- "\u010cet"\
+ "ÄŒet"\
"Pet"\
"Sub"]
::msgcat::mcset sh DAYS_OF_WEEK_FULL [list \
@@ -13,7 +13,7 @@ namespace eval ::tcl::clock {
"Ponedeljak"\
"Utorak"\
"Sreda"\
- "\u010cetvrtak"\
+ "ÄŒetvrtak"\
"Petak"\
"Subota"]
::msgcat::mcset sh MONTHS_ABBREV [list \
diff --git a/library/msgs/sk.msg b/library/msgs/sk.msg
index 9b2f0aa..dc6f6b6 100644
--- a/library/msgs/sk.msg
+++ b/library/msgs/sk.msg
@@ -5,15 +5,15 @@ namespace eval ::tcl::clock {
"Po"\
"Ut"\
"St"\
- "\u0160t"\
+ "Å t"\
"Pa"\
"So"]
::msgcat::mcset sk DAYS_OF_WEEK_FULL [list \
- "Nede\u013ee"\
+ "Nedeľe"\
"Pondelok"\
"Utorok"\
"Streda"\
- "\u0160tvrtok"\
+ "Å tvrtok"\
"Piatok"\
"Sobota"]
::msgcat::mcset sk MONTHS_ABBREV [list \
@@ -21,9 +21,9 @@ namespace eval ::tcl::clock {
"feb"\
"mar"\
"apr"\
- "m\u00e1j"\
- "j\u00fan"\
- "j\u00fal"\
+ "máj"\
+ "jún"\
+ "júl"\
"aug"\
"sep"\
"okt"\
@@ -31,16 +31,16 @@ namespace eval ::tcl::clock {
"dec"\
""]
::msgcat::mcset sk MONTHS_FULL [list \
- "janu\u00e1r"\
- "febru\u00e1r"\
+ "január"\
+ "február"\
"marec"\
- "apr\u00edl"\
- "m\u00e1j"\
- "j\u00fan"\
- "j\u00fal"\
+ "apríl"\
+ "máj"\
+ "jún"\
+ "júl"\
"august"\
"september"\
- "okt\u00f3ber"\
+ "október"\
"november"\
"december"\
""]
diff --git a/library/msgs/sl.msg b/library/msgs/sl.msg
index 42bc509..2ee0a03 100644
--- a/library/msgs/sl.msg
+++ b/library/msgs/sl.msg
@@ -5,7 +5,7 @@ namespace eval ::tcl::clock {
"Pon"\
"Tor"\
"Sre"\
- "\u010cet"\
+ "ÄŒet"\
"Pet"\
"Sob"]
::msgcat::mcset sl DAYS_OF_WEEK_FULL [list \
@@ -13,7 +13,7 @@ namespace eval ::tcl::clock {
"Ponedeljek"\
"Torek"\
"Sreda"\
- "\u010cetrtek"\
+ "ÄŒetrtek"\
"Petek"\
"Sobota"]
::msgcat::mcset sl MONTHS_ABBREV [list \
@@ -44,7 +44,7 @@ namespace eval ::tcl::clock {
"november"\
"december"\
""]
- ::msgcat::mcset sl BCE "pr.n.\u0161."
+ ::msgcat::mcset sl BCE "pr.n.Å¡."
::msgcat::mcset sl CE "po Kr."
::msgcat::mcset sl DATE_FORMAT "%Y.%m.%e"
::msgcat::mcset sl TIME_FORMAT "%k:%M:%S"
diff --git a/library/msgs/sq.msg b/library/msgs/sq.msg
index 8fb1fce..65da407 100644
--- a/library/msgs/sq.msg
+++ b/library/msgs/sq.msg
@@ -2,20 +2,20 @@
namespace eval ::tcl::clock {
::msgcat::mcset sq DAYS_OF_WEEK_ABBREV [list \
"Die"\
- "H\u00ebn"\
+ "Hën"\
"Mar"\
- "M\u00ebr"\
+ "Mër"\
"Enj"\
"Pre"\
"Sht"]
::msgcat::mcset sq DAYS_OF_WEEK_FULL [list \
"e diel"\
- "e h\u00ebn\u00eb"\
- "e mart\u00eb"\
- "e m\u00ebrkur\u00eb"\
+ "e hënë"\
+ "e martë"\
+ "e mërkurë"\
"e enjte"\
"e premte"\
- "e shtun\u00eb"]
+ "e shtunë"]
::msgcat::mcset sq MONTHS_ABBREV [list \
"Jan"\
"Shk"\
@@ -27,7 +27,7 @@ namespace eval ::tcl::clock {
"Gsh"\
"Sht"\
"Tet"\
- "N\u00ebn"\
+ "Nën"\
"Dhj"\
""]
::msgcat::mcset sq MONTHS_FULL [list \
@@ -41,7 +41,7 @@ namespace eval ::tcl::clock {
"gusht"\
"shtator"\
"tetor"\
- "n\u00ebntor"\
+ "nëntor"\
"dhjetor"\
""]
::msgcat::mcset sq BCE "p.e.r."
diff --git a/library/msgs/sr.msg b/library/msgs/sr.msg
index 7576668..3d84d6c 100644
--- a/library/msgs/sr.msg
+++ b/library/msgs/sr.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset sr DAYS_OF_WEEK_ABBREV [list \
- "\u041d\u0435\u0434"\
- "\u041f\u043e\u043d"\
- "\u0423\u0442\u043e"\
- "\u0421\u0440\u0435"\
- "\u0427\u0435\u0442"\
- "\u041f\u0435\u0442"\
- "\u0421\u0443\u0431"]
+ "Ðед"\
+ "Пон"\
+ "Уто"\
+ "Сре"\
+ "Чет"\
+ "Пет"\
+ "Суб"]
::msgcat::mcset sr DAYS_OF_WEEK_FULL [list \
- "\u041d\u0435\u0434\u0435\u0459\u0430"\
- "\u041f\u043e\u043d\u0435\u0434\u0435\u0459\u0430\u043a"\
- "\u0423\u0442\u043e\u0440\u0430\u043a"\
- "\u0421\u0440\u0435\u0434\u0430"\
- "\u0427\u0435\u0442\u0432\u0440\u0442\u0430\u043a"\
- "\u041f\u0435\u0442\u0430\u043a"\
- "\u0421\u0443\u0431\u043e\u0442\u0430"]
+ "Ðедеља"\
+ "Понедељак"\
+ "Уторак"\
+ "Среда"\
+ "Четвртак"\
+ "Петак"\
+ "Субота"]
::msgcat::mcset sr MONTHS_ABBREV [list \
- "\u0408\u0430\u043d"\
- "\u0424\u0435\u0431"\
- "\u041c\u0430\u0440"\
- "\u0410\u043f\u0440"\
- "\u041c\u0430\u0458"\
- "\u0408\u0443\u043d"\
- "\u0408\u0443\u043b"\
- "\u0410\u0432\u0433"\
- "\u0421\u0435\u043f"\
- "\u041e\u043a\u0442"\
- "\u041d\u043e\u0432"\
- "\u0414\u0435\u0446"\
+ "Јан"\
+ "Феб"\
+ "Мар"\
+ "Ðпр"\
+ "Мај"\
+ "Јун"\
+ "Јул"\
+ "Ðвг"\
+ "Сеп"\
+ "Окт"\
+ "Ðов"\
+ "Дец"\
""]
::msgcat::mcset sr MONTHS_FULL [list \
- "\u0408\u0430\u043d\u0443\u0430\u0440"\
- "\u0424\u0435\u0431\u0440\u0443\u0430\u0440"\
- "\u041c\u0430\u0440\u0442"\
- "\u0410\u043f\u0440\u0438\u043b"\
- "\u041c\u0430\u0458"\
- "\u0408\u0443\u043d\u0438"\
- "\u0408\u0443\u043b\u0438"\
- "\u0410\u0432\u0433\u0443\u0441\u0442"\
- "\u0421\u0435\u043f\u0442\u0435\u043c\u0431\u0430\u0440"\
- "\u041e\u043a\u0442\u043e\u0431\u0430\u0440"\
- "\u041d\u043e\u0432\u0435\u043c\u0431\u0430\u0440"\
- "\u0414\u0435\u0446\u0435\u043c\u0431\u0430\u0440"\
+ "Јануар"\
+ "Фебруар"\
+ "Март"\
+ "Ðприл"\
+ "Мај"\
+ "Јуни"\
+ "Јули"\
+ "ÐвгуÑÑ‚"\
+ "Септембар"\
+ "Октобар"\
+ "Ðовембар"\
+ "Децембар"\
""]
- ::msgcat::mcset sr BCE "\u043f. \u043d. \u0435."
- ::msgcat::mcset sr CE "\u043d. \u0435"
+ ::msgcat::mcset sr BCE "п. н. е."
+ ::msgcat::mcset sr CE "н. е"
::msgcat::mcset sr DATE_FORMAT "%Y.%m.%e"
::msgcat::mcset sr TIME_FORMAT "%k.%M.%S"
::msgcat::mcset sr DATE_TIME_FORMAT "%Y.%m.%e %k.%M.%S %z"
diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg
index f7a67c6..5716092 100644
--- a/library/msgs/sv.msg
+++ b/library/msgs/sv.msg
@@ -1,21 +1,21 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset sv DAYS_OF_WEEK_ABBREV [list \
- "s\u00f6"\
- "m\u00e5"\
+ "sö"\
+ "må"\
"ti"\
"on"\
"to"\
"fr"\
- "l\u00f6"]
+ "lö"]
::msgcat::mcset sv DAYS_OF_WEEK_FULL [list \
- "s\u00f6ndag"\
- "m\u00e5ndag"\
+ "söndag"\
+ "måndag"\
"tisdag"\
"onsdag"\
"torsdag"\
"fredag"\
- "l\u00f6rdag"]
+ "lördag"]
::msgcat::mcset sv MONTHS_ABBREV [list \
"jan"\
"feb"\
diff --git a/library/msgs/ta.msg b/library/msgs/ta.msg
index 4abb90c..ea62552 100644
--- a/library/msgs/ta.msg
+++ b/library/msgs/ta.msg
@@ -1,39 +1,39 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset ta DAYS_OF_WEEK_FULL [list \
- "\u0b9e\u0bbe\u0baf\u0bbf\u0bb1\u0bc1"\
- "\u0ba4\u0bbf\u0b99\u0bcd\u0b95\u0bb3\u0bcd"\
- "\u0b9a\u0bc6\u0bb5\u0bcd\u0bb5\u0bbe\u0baf\u0bcd"\
- "\u0baa\u0bc1\u0ba4\u0ba9\u0bcd"\
- "\u0bb5\u0bbf\u0baf\u0bbe\u0bb4\u0ba9\u0bcd"\
- "\u0bb5\u0bc6\u0bb3\u0bcd\u0bb3\u0bbf"\
- "\u0b9a\u0ba9\u0bbf"]
+ "ஞாயிறà¯"\
+ "திஙà¯à®•à®³à¯"\
+ "செவà¯à®µà®¾à®¯à¯"\
+ "பà¯à®¤à®©à¯"\
+ "வியாழனà¯"\
+ "வெளà¯à®³à®¿"\
+ "சனி"]
::msgcat::mcset ta MONTHS_ABBREV [list \
- "\u0b9c\u0ba9\u0bb5\u0bb0\u0bbf"\
- "\u0baa\u0bc6\u0baa\u0bcd\u0bb0\u0bb5\u0bb0\u0bbf"\
- "\u0bae\u0bbe\u0bb0\u0bcd\u0b9a\u0bcd"\
- "\u0b8f\u0baa\u0bcd\u0bb0\u0bb2\u0bcd"\
- "\u0bae\u0bc7"\
- "\u0b9c\u0bc2\u0ba9\u0bcd"\
- "\u0b9c\u0bc2\u0bb2\u0bc8"\
- "\u0b86\u0b95\u0bb8\u0bcd\u0b9f\u0bcd"\
- "\u0b9a\u0bc6\u0baa\u0bcd\u0b9f\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
- "\u0b85\u0b95\u0bcd\u0b9f\u0bcb\u0baa\u0bb0\u0bcd"\
- "\u0ba8\u0bb5\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
- "\u0b9f\u0bbf\u0b9a\u0bae\u0bcd\u0baa\u0bb0\u0bcdr"]
+ "ஜனவரி"\
+ "பெபà¯à®°à®µà®°à®¿"\
+ "மாரà¯à®šà¯"\
+ "à®à®ªà¯à®°à®²à¯"\
+ "மே"\
+ "ஜூனà¯"\
+ "ஜூலை"\
+ "ஆகஸà¯à®Ÿà¯"\
+ "செபà¯à®Ÿà®®à¯à®ªà®°à¯"\
+ "அகà¯à®Ÿà¯‹à®ªà®°à¯"\
+ "நவமà¯à®ªà®°à¯"\
+ "டிசமà¯à®ªà®°à¯r"]
::msgcat::mcset ta MONTHS_FULL [list \
- "\u0b9c\u0ba9\u0bb5\u0bb0\u0bbf"\
- "\u0baa\u0bc6\u0baa\u0bcd\u0bb0\u0bb5\u0bb0\u0bbf"\
- "\u0bae\u0bbe\u0bb0\u0bcd\u0b9a\u0bcd"\
- "\u0b8f\u0baa\u0bcd\u0bb0\u0bb2\u0bcd"\
- "\u0bae\u0bc7"\
- "\u0b9c\u0bc2\u0ba9\u0bcd"\
- "\u0b9c\u0bc2\u0bb2\u0bc8"\
- "\u0b86\u0b95\u0bb8\u0bcd\u0b9f\u0bcd"\
- "\u0b9a\u0bc6\u0baa\u0bcd\u0b9f\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
- "\u0b85\u0b95\u0bcd\u0b9f\u0bcb\u0baa\u0bb0\u0bcd"\
- "\u0ba8\u0bb5\u0bae\u0bcd\u0baa\u0bb0\u0bcd"\
- "\u0b9f\u0bbf\u0b9a\u0bae\u0bcd\u0baa\u0bb0\u0bcdr"]
- ::msgcat::mcset ta AM "\u0b95\u0bbf\u0bae\u0bc1"
- ::msgcat::mcset ta PM "\u0b95\u0bbf\u0baa\u0bbf"
+ "ஜனவரி"\
+ "பெபà¯à®°à®µà®°à®¿"\
+ "மாரà¯à®šà¯"\
+ "à®à®ªà¯à®°à®²à¯"\
+ "மே"\
+ "ஜூனà¯"\
+ "ஜூலை"\
+ "ஆகஸà¯à®Ÿà¯"\
+ "செபà¯à®Ÿà®®à¯à®ªà®°à¯"\
+ "அகà¯à®Ÿà¯‹à®ªà®°à¯"\
+ "நவமà¯à®ªà®°à¯"\
+ "டிசமà¯à®ªà®°à¯r"]
+ ::msgcat::mcset ta AM "கிமà¯"
+ ::msgcat::mcset ta PM "கிபி"
}
diff --git a/library/msgs/te.msg b/library/msgs/te.msg
index 6111473..f35ece4 100644
--- a/library/msgs/te.msg
+++ b/library/msgs/te.msg
@@ -1,47 +1,47 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset te DAYS_OF_WEEK_ABBREV [list \
- "\u0c06\u0c26\u0c3f"\
- "\u0c38\u0c4b\u0c2e"\
- "\u0c2e\u0c02\u0c17\u0c33"\
- "\u0c2c\u0c41\u0c27"\
- "\u0c17\u0c41\u0c30\u0c41"\
- "\u0c36\u0c41\u0c15\u0c4d\u0c30"\
- "\u0c36\u0c28\u0c3f"]
+ "ఆది"\
+ "సోమ"\
+ "మంగళ"\
+ "à°¬à±à°§"\
+ "à°—à±à°°à±"\
+ "à°¶à±à°•à±à°°"\
+ "శని"]
::msgcat::mcset te DAYS_OF_WEEK_FULL [list \
- "\u0c06\u0c26\u0c3f\u0c35\u0c3e\u0c30\u0c02"\
- "\u0c38\u0c4b\u0c2e\u0c35\u0c3e\u0c30\u0c02"\
- "\u0c2e\u0c02\u0c17\u0c33\u0c35\u0c3e\u0c30\u0c02"\
- "\u0c2c\u0c41\u0c27\u0c35\u0c3e\u0c30\u0c02"\
- "\u0c17\u0c41\u0c30\u0c41\u0c35\u0c3e\u0c30\u0c02"\
- "\u0c36\u0c41\u0c15\u0c4d\u0c30\u0c35\u0c3e\u0c30\u0c02"\
- "\u0c36\u0c28\u0c3f\u0c35\u0c3e\u0c30\u0c02"]
+ "ఆదివారం"\
+ "సోమవారం"\
+ "మంగళవారం"\
+ "à°¬à±à°§à°µà°¾à°°à°‚"\
+ "à°—à±à°°à±à°µà°¾à°°à°‚"\
+ "à°¶à±à°•à±à°°à°µà°¾à°°à°‚"\
+ "శనివారం"]
::msgcat::mcset te MONTHS_ABBREV [list \
- "\u0c1c\u0c28\u0c35\u0c30\u0c3f"\
- "\u0c2b\u0c3f\u0c2c\u0c4d\u0c30\u0c35\u0c30\u0c3f"\
- "\u0c2e\u0c3e\u0c30\u0c4d\u0c1a\u0c3f"\
- "\u0c0f\u0c2a\u0c4d\u0c30\u0c3f\u0c32\u0c4d"\
- "\u0c2e\u0c47"\
- "\u0c1c\u0c42\u0c28\u0c4d"\
- "\u0c1c\u0c42\u0c32\u0c48"\
- "\u0c06\u0c17\u0c38\u0c4d\u0c1f\u0c41"\
- "\u0c38\u0c46\u0c2a\u0c4d\u0c1f\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
- "\u0c05\u0c15\u0c4d\u0c1f\u0c4b\u0c2c\u0c30\u0c4d"\
- "\u0c28\u0c35\u0c02\u0c2c\u0c30\u0c4d"\
- "\u0c21\u0c3f\u0c38\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
+ "జనవరి"\
+ "à°«à°¿à°¬à±à°°à°µà°°à°¿"\
+ "మారà±à°šà°¿"\
+ "à°à°ªà±à°°à°¿à°²à±"\
+ "మే"\
+ "జూనà±"\
+ "జూలై"\
+ "ఆగసà±à°Ÿà±"\
+ "సెపà±à°Ÿà±†à°‚బరà±"\
+ "à°…à°•à±à°Ÿà±‹à°¬à°°à±"\
+ "నవంబరà±"\
+ "డిసెంబరà±"\
""]
::msgcat::mcset te MONTHS_FULL [list \
- "\u0c1c\u0c28\u0c35\u0c30\u0c3f"\
- "\u0c2b\u0c3f\u0c2c\u0c4d\u0c30\u0c35\u0c30\u0c3f"\
- "\u0c2e\u0c3e\u0c30\u0c4d\u0c1a\u0c3f"\
- "\u0c0f\u0c2a\u0c4d\u0c30\u0c3f\u0c32\u0c4d"\
- "\u0c2e\u0c47"\
- "\u0c1c\u0c42\u0c28\u0c4d"\
- "\u0c1c\u0c42\u0c32\u0c48"\
- "\u0c06\u0c17\u0c38\u0c4d\u0c1f\u0c41"\
- "\u0c38\u0c46\u0c2a\u0c4d\u0c1f\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
- "\u0c05\u0c15\u0c4d\u0c1f\u0c4b\u0c2c\u0c30\u0c4d"\
- "\u0c28\u0c35\u0c02\u0c2c\u0c30\u0c4d"\
- "\u0c21\u0c3f\u0c38\u0c46\u0c02\u0c2c\u0c30\u0c4d"\
+ "జనవరి"\
+ "à°«à°¿à°¬à±à°°à°µà°°à°¿"\
+ "మారà±à°šà°¿"\
+ "à°à°ªà±à°°à°¿à°²à±"\
+ "మే"\
+ "జూనà±"\
+ "జూలై"\
+ "ఆగసà±à°Ÿà±"\
+ "సెపà±à°Ÿà±†à°‚బరà±"\
+ "à°…à°•à±à°Ÿà±‹à°¬à°°à±"\
+ "నవంబరà±"\
+ "డిసెంబరà±"\
""]
}
diff --git a/library/msgs/te_in.msg b/library/msgs/te_in.msg
index 61638b5..84dd2b3 100644
--- a/library/msgs/te_in.msg
+++ b/library/msgs/te_in.msg
@@ -1,7 +1,7 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
- ::msgcat::mcset te_IN AM "\u0c2a\u0c42\u0c30\u0c4d\u0c35\u0c3e\u0c39\u0c4d\u0c28"
- ::msgcat::mcset te_IN PM "\u0c05\u0c2a\u0c30\u0c3e\u0c39\u0c4d\u0c28"
+ ::msgcat::mcset te_IN AM "పూరà±à°µà°¾à°¹à±à°¨"
+ ::msgcat::mcset te_IN PM "అపరాహà±à°¨"
::msgcat::mcset te_IN DATE_FORMAT "%d/%m/%Y"
::msgcat::mcset te_IN TIME_FORMAT_12 "%I:%M:%S %P"
::msgcat::mcset te_IN DATE_TIME_FORMAT "%d/%m/%Y %I:%M:%S %P %z"
diff --git a/library/msgs/th.msg b/library/msgs/th.msg
index 7486c35..edaa149 100644
--- a/library/msgs/th.msg
+++ b/library/msgs/th.msg
@@ -1,53 +1,53 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset th DAYS_OF_WEEK_ABBREV [list \
- "\u0e2d\u0e32."\
- "\u0e08."\
- "\u0e2d."\
- "\u0e1e."\
- "\u0e1e\u0e24."\
- "\u0e28."\
- "\u0e2a."]
+ "อา."\
+ "จ."\
+ "อ."\
+ "พ."\
+ "พฤ."\
+ "ศ."\
+ "ส."]
::msgcat::mcset th DAYS_OF_WEEK_FULL [list \
- "\u0e27\u0e31\u0e19\u0e2d\u0e32\u0e17\u0e34\u0e15\u0e22\u0e4c"\
- "\u0e27\u0e31\u0e19\u0e08\u0e31\u0e19\u0e17\u0e23\u0e4c"\
- "\u0e27\u0e31\u0e19\u0e2d\u0e31\u0e07\u0e04\u0e32\u0e23"\
- "\u0e27\u0e31\u0e19\u0e1e\u0e38\u0e18"\
- "\u0e27\u0e31\u0e19\u0e1e\u0e24\u0e2b\u0e31\u0e2a\u0e1a\u0e14\u0e35"\
- "\u0e27\u0e31\u0e19\u0e28\u0e38\u0e01\u0e23\u0e4c"\
- "\u0e27\u0e31\u0e19\u0e40\u0e2a\u0e32\u0e23\u0e4c"]
+ "วันอาทิตย์"\
+ "วันจันทร์"\
+ "วันอังคาร"\
+ "วันพุธ"\
+ "วันพฤหัสบดี"\
+ "วันศุà¸à¸£à¹Œ"\
+ "วันเสาร์"]
::msgcat::mcset th MONTHS_ABBREV [list \
- "\u0e21.\u0e04."\
- "\u0e01.\u0e1e."\
- "\u0e21\u0e35.\u0e04."\
- "\u0e40\u0e21.\u0e22."\
- "\u0e1e.\u0e04."\
- "\u0e21\u0e34.\u0e22."\
- "\u0e01.\u0e04."\
- "\u0e2a.\u0e04."\
- "\u0e01.\u0e22."\
- "\u0e15.\u0e04."\
- "\u0e1e.\u0e22."\
- "\u0e18.\u0e04."\
+ "ม.ค."\
+ "à¸.พ."\
+ "มี.ค."\
+ "เม.ย."\
+ "พ.ค."\
+ "มิ.ย."\
+ "à¸.ค."\
+ "ส.ค."\
+ "à¸.ย."\
+ "ต.ค."\
+ "พ.ย."\
+ "ธ.ค."\
""]
::msgcat::mcset th MONTHS_FULL [list \
- "\u0e21\u0e01\u0e23\u0e32\u0e04\u0e21"\
- "\u0e01\u0e38\u0e21\u0e20\u0e32\u0e1e\u0e31\u0e19\u0e18\u0e4c"\
- "\u0e21\u0e35\u0e19\u0e32\u0e04\u0e21"\
- "\u0e40\u0e21\u0e29\u0e32\u0e22\u0e19"\
- "\u0e1e\u0e24\u0e29\u0e20\u0e32\u0e04\u0e21"\
- "\u0e21\u0e34\u0e16\u0e38\u0e19\u0e32\u0e22\u0e19"\
- "\u0e01\u0e23\u0e01\u0e0e\u0e32\u0e04\u0e21"\
- "\u0e2a\u0e34\u0e07\u0e2b\u0e32\u0e04\u0e21"\
- "\u0e01\u0e31\u0e19\u0e22\u0e32\u0e22\u0e19"\
- "\u0e15\u0e38\u0e25\u0e32\u0e04\u0e21"\
- "\u0e1e\u0e24\u0e28\u0e08\u0e34\u0e01\u0e32\u0e22\u0e19"\
- "\u0e18\u0e31\u0e19\u0e27\u0e32\u0e04\u0e21"\
+ "มà¸à¸£à¸²à¸„ม"\
+ "à¸à¸¸à¸¡à¸ à¸²à¸žà¸±à¸™à¸˜à¹Œ"\
+ "มีนาคม"\
+ "เมษายน"\
+ "พฤษภาคม"\
+ "มิถุนายน"\
+ "à¸à¸£à¸à¸Žà¸²à¸„ม"\
+ "สิงหาคม"\
+ "à¸à¸±à¸™à¸¢à¸²à¸¢à¸™"\
+ "ตุลาคม"\
+ "พฤศจิà¸à¸²à¸¢à¸™"\
+ "ธันวาคม"\
""]
- ::msgcat::mcset th BCE "\u0e25\u0e17\u0e35\u0e48"
- ::msgcat::mcset th CE "\u0e04.\u0e28."
- ::msgcat::mcset th AM "\u0e01\u0e48\u0e2d\u0e19\u0e40\u0e17\u0e35\u0e48\u0e22\u0e07"
- ::msgcat::mcset th PM "\u0e2b\u0e25\u0e31\u0e07\u0e40\u0e17\u0e35\u0e48\u0e22\u0e07"
+ ::msgcat::mcset th BCE "ลที่"
+ ::msgcat::mcset th CE "ค.ศ."
+ ::msgcat::mcset th AM "à¸à¹ˆà¸­à¸™à¹€à¸—ี่ยง"
+ ::msgcat::mcset th PM "หลังเที่ยง"
::msgcat::mcset th DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset th TIME_FORMAT "%k:%M:%S"
::msgcat::mcset th DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"
diff --git a/library/msgs/tr.msg b/library/msgs/tr.msg
index 7b2ecf9..12869ee 100644
--- a/library/msgs/tr.msg
+++ b/library/msgs/tr.msg
@@ -4,27 +4,27 @@ namespace eval ::tcl::clock {
"Paz"\
"Pzt"\
"Sal"\
- "\u00c7ar"\
+ "Çar"\
"Per"\
"Cum"\
"Cmt"]
::msgcat::mcset tr DAYS_OF_WEEK_FULL [list \
"Pazar"\
"Pazartesi"\
- "Sal\u0131"\
- "\u00c7ar\u015famba"\
- "Per\u015fembe"\
+ "Salı"\
+ "Çarşamba"\
+ "PerÅŸembe"\
"Cuma"\
"Cumartesi"]
::msgcat::mcset tr MONTHS_ABBREV [list \
"Oca"\
- "\u015eub"\
+ "Åžub"\
"Mar"\
"Nis"\
"May"\
"Haz"\
"Tem"\
- "A\u011fu"\
+ "AÄŸu"\
"Eyl"\
"Eki"\
"Kas"\
@@ -32,17 +32,17 @@ namespace eval ::tcl::clock {
""]
::msgcat::mcset tr MONTHS_FULL [list \
"Ocak"\
- "\u015eubat"\
+ "Åžubat"\
"Mart"\
"Nisan"\
- "May\u0131s"\
+ "Mayıs"\
"Haziran"\
"Temmuz"\
- "A\u011fustos"\
- "Eyl\u00fcl"\
+ "AÄŸustos"\
+ "Eylül"\
"Ekim"\
- "Kas\u0131m"\
- "Aral\u0131k"\
+ "Kasım"\
+ "Aralık"\
""]
::msgcat::mcset tr DATE_FORMAT "%d.%m.%Y"
::msgcat::mcset tr TIME_FORMAT "%H:%M:%S"
diff --git a/library/msgs/uk.msg b/library/msgs/uk.msg
index 7d4c64a..42eb095 100644
--- a/library/msgs/uk.msg
+++ b/library/msgs/uk.msg
@@ -1,51 +1,51 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset uk DAYS_OF_WEEK_ABBREV [list \
- "\u043d\u0434"\
- "\u043f\u043d"\
- "\u0432\u0442"\
- "\u0441\u0440"\
- "\u0447\u0442"\
- "\u043f\u0442"\
- "\u0441\u0431"]
+ "нд"\
+ "пн"\
+ "вт"\
+ "ÑÑ€"\
+ "чт"\
+ "пт"\
+ "Ñб"]
::msgcat::mcset uk DAYS_OF_WEEK_FULL [list \
- "\u043d\u0435\u0434\u0456\u043b\u044f"\
- "\u043f\u043e\u043d\u0435\u0434\u0456\u043b\u043e\u043a"\
- "\u0432\u0456\u0432\u0442\u043e\u0440\u043e\u043a"\
- "\u0441\u0435\u0440\u0435\u0434\u0430"\
- "\u0447\u0435\u0442\u0432\u0435\u0440"\
- "\u043f'\u044f\u0442\u043d\u0438\u0446\u044f"\
- "\u0441\u0443\u0431\u043e\u0442\u0430"]
+ "неділÑ"\
+ "понеділок"\
+ "вівторок"\
+ "Ñереда"\
+ "четвер"\
+ "п'ÑтницÑ"\
+ "Ñубота"]
::msgcat::mcset uk MONTHS_ABBREV [list \
- "\u0441\u0456\u0447"\
- "\u043b\u044e\u0442"\
- "\u0431\u0435\u0440"\
- "\u043a\u0432\u0456\u0442"\
- "\u0442\u0440\u0430\u0432"\
- "\u0447\u0435\u0440\u0432"\
- "\u043b\u0438\u043f"\
- "\u0441\u0435\u0440\u043f"\
- "\u0432\u0435\u0440"\
- "\u0436\u043e\u0432\u0442"\
- "\u043b\u0438\u0441\u0442"\
- "\u0433\u0440\u0443\u0434"\
+ "Ñіч"\
+ "лют"\
+ "бер"\
+ "квіт"\
+ "трав"\
+ "черв"\
+ "лип"\
+ "Ñерп"\
+ "вер"\
+ "жовт"\
+ "лиÑÑ‚"\
+ "груд"\
""]
::msgcat::mcset uk MONTHS_FULL [list \
- "\u0441\u0456\u0447\u043d\u044f"\
- "\u043b\u044e\u0442\u043e\u0433\u043e"\
- "\u0431\u0435\u0440\u0435\u0437\u043d\u044f"\
- "\u043a\u0432\u0456\u0442\u043d\u044f"\
- "\u0442\u0440\u0430\u0432\u043d\u044f"\
- "\u0447\u0435\u0440\u0432\u043d\u044f"\
- "\u043b\u0438\u043f\u043d\u044f"\
- "\u0441\u0435\u0440\u043f\u043d\u044f"\
- "\u0432\u0435\u0440\u0435\u0441\u043d\u044f"\
- "\u0436\u043e\u0432\u0442\u043d\u044f"\
- "\u043b\u0438\u0441\u0442\u043e\u043f\u0430\u0434\u0430"\
- "\u0433\u0440\u0443\u0434\u043d\u044f"\
+ "ÑічнÑ"\
+ "лютого"\
+ "березнÑ"\
+ "квітнÑ"\
+ "травнÑ"\
+ "червнÑ"\
+ "липнÑ"\
+ "ÑерпнÑ"\
+ "вереÑнÑ"\
+ "жовтнÑ"\
+ "лиÑтопада"\
+ "груднÑ"\
""]
- ::msgcat::mcset uk BCE "\u0434\u043e \u043d.\u0435."
- ::msgcat::mcset uk CE "\u043f\u0456\u0441\u043b\u044f \u043d.\u0435."
+ ::msgcat::mcset uk BCE "до н.е."
+ ::msgcat::mcset uk CE "піÑÐ»Ñ Ð½.е."
::msgcat::mcset uk DATE_FORMAT "%e/%m/%Y"
::msgcat::mcset uk TIME_FORMAT "%k:%M:%S"
::msgcat::mcset uk DATE_TIME_FORMAT "%e/%m/%Y %k:%M:%S %z"
diff --git a/library/msgs/vi.msg b/library/msgs/vi.msg
index c98b2a6..3437ebf 100644
--- a/library/msgs/vi.msg
+++ b/library/msgs/vi.msg
@@ -9,13 +9,13 @@ namespace eval ::tcl::clock {
"Th 7"\
"CN"]
::msgcat::mcset vi DAYS_OF_WEEK_FULL [list \
- "Th\u01b0\u0301 hai"\
- "Th\u01b0\u0301 ba"\
- "Th\u01b0\u0301 t\u01b0"\
- "Th\u01b0\u0301 n\u0103m"\
- "Th\u01b0\u0301 s\u00e1u"\
- "Th\u01b0\u0301 ba\u0309y"\
- "Chu\u0309 nh\u00e2\u0323t"]
+ "ThÆ°Ì hai"\
+ "ThÆ°Ì ba"\
+ "ThÆ°Ì tÆ°"\
+ "ThÆ°Ì năm"\
+ "ThÆ°Ì sáu"\
+ "ThÆ°Ì bảy"\
+ "Chủ nhật"]
::msgcat::mcset vi MONTHS_ABBREV [list \
"Thg 1"\
"Thg 2"\
@@ -31,18 +31,18 @@ namespace eval ::tcl::clock {
"Thg 12"\
""]
::msgcat::mcset vi MONTHS_FULL [list \
- "Th\u00e1ng m\u00f4\u0323t"\
- "Th\u00e1ng hai"\
- "Th\u00e1ng ba"\
- "Th\u00e1ng t\u01b0"\
- "Th\u00e1ng n\u0103m"\
- "Th\u00e1ng s\u00e1u"\
- "Th\u00e1ng ba\u0309y"\
- "Th\u00e1ng t\u00e1m"\
- "Th\u00e1ng ch\u00edn"\
- "Th\u00e1ng m\u01b0\u01a1\u0300i"\
- "Th\u00e1ng m\u01b0\u01a1\u0300i m\u00f4\u0323t"\
- "Th\u00e1ng m\u01b0\u01a1\u0300i hai"\
+ "Tháng một"\
+ "Tháng hai"\
+ "Tháng ba"\
+ "Tháng tư"\
+ "Tháng năm"\
+ "Tháng sáu"\
+ "Tháng bảy"\
+ "Tháng tám"\
+ "Tháng chín"\
+ "Tháng mười"\
+ "Tháng mười một"\
+ "Tháng mười hai"\
""]
::msgcat::mcset vi DATE_FORMAT "%d %b %Y"
::msgcat::mcset vi TIME_FORMAT "%H:%M:%S"
diff --git a/library/msgs/zh.msg b/library/msgs/zh.msg
index b799a32..9c1d08b 100644
--- a/library/msgs/zh.msg
+++ b/library/msgs/zh.msg
@@ -1,55 +1,55 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset zh DAYS_OF_WEEK_ABBREV [list \
- "\u661f\u671f\u65e5"\
- "\u661f\u671f\u4e00"\
- "\u661f\u671f\u4e8c"\
- "\u661f\u671f\u4e09"\
- "\u661f\u671f\u56db"\
- "\u661f\u671f\u4e94"\
- "\u661f\u671f\u516d"]
+ "星期日"\
+ "星期一"\
+ "星期二"\
+ "星期三"\
+ "星期四"\
+ "星期五"\
+ "星期六"]
::msgcat::mcset zh DAYS_OF_WEEK_FULL [list \
- "\u661f\u671f\u65e5"\
- "\u661f\u671f\u4e00"\
- "\u661f\u671f\u4e8c"\
- "\u661f\u671f\u4e09"\
- "\u661f\u671f\u56db"\
- "\u661f\u671f\u4e94"\
- "\u661f\u671f\u516d"]
+ "星期日"\
+ "星期一"\
+ "星期二"\
+ "星期三"\
+ "星期四"\
+ "星期五"\
+ "星期六"]
::msgcat::mcset zh MONTHS_ABBREV [list \
- "\u4e00\u6708"\
- "\u4e8c\u6708"\
- "\u4e09\u6708"\
- "\u56db\u6708"\
- "\u4e94\u6708"\
- "\u516d\u6708"\
- "\u4e03\u6708"\
- "\u516b\u6708"\
- "\u4e5d\u6708"\
- "\u5341\u6708"\
- "\u5341\u4e00\u6708"\
- "\u5341\u4e8c\u6708"\
+ "一月"\
+ "二月"\
+ "三月"\
+ "四月"\
+ "五月"\
+ "六月"\
+ "七月"\
+ "八月"\
+ "ä¹æœˆ"\
+ "å月"\
+ "å一月"\
+ "å二月"\
""]
::msgcat::mcset zh MONTHS_FULL [list \
- "\u4e00\u6708"\
- "\u4e8c\u6708"\
- "\u4e09\u6708"\
- "\u56db\u6708"\
- "\u4e94\u6708"\
- "\u516d\u6708"\
- "\u4e03\u6708"\
- "\u516b\u6708"\
- "\u4e5d\u6708"\
- "\u5341\u6708"\
- "\u5341\u4e00\u6708"\
- "\u5341\u4e8c\u6708"\
+ "一月"\
+ "二月"\
+ "三月"\
+ "四月"\
+ "五月"\
+ "六月"\
+ "七月"\
+ "八月"\
+ "ä¹æœˆ"\
+ "å月"\
+ "å一月"\
+ "å二月"\
""]
- ::msgcat::mcset zh BCE "\u516c\u5143\u524d"
- ::msgcat::mcset zh CE "\u516c\u5143"
- ::msgcat::mcset zh AM "\u4e0a\u5348"
- ::msgcat::mcset zh PM "\u4e0b\u5348"
- ::msgcat::mcset zh LOCALE_NUMERALS "\u3007 \u4e00 \u4e8c \u4e09 \u56db \u4e94 \u516d \u4e03 \u516b \u4e5d \u5341 \u5341\u4e00 \u5341\u4e8c \u5341\u4e09 \u5341\u56db \u5341\u4e94 \u5341\u516d \u5341\u4e03 \u5341\u516b \u5341\u4e5d \u4e8c\u5341 \u5eff\u4e00 \u5eff\u4e8c \u5eff\u4e09 \u5eff\u56db \u5eff\u4e94 \u5eff\u516d \u5eff\u4e03 \u5eff\u516b \u5eff\u4e5d \u4e09\u5341 \u5345\u4e00 \u5345\u4e8c \u5345\u4e09 \u5345\u56db \u5345\u4e94 \u5345\u516d \u5345\u4e03 \u5345\u516b \u5345\u4e5d \u56db\u5341 \u56db\u5341\u4e00 \u56db\u5341\u4e8c \u56db\u5341\u4e09 \u56db\u5341\u56db \u56db\u5341\u4e94 \u56db\u5341\u516d \u56db\u5341\u4e03 \u56db\u5341\u516b \u56db\u5341\u4e5d \u4e94\u5341 \u4e94\u5341\u4e00 \u4e94\u5341\u4e8c \u4e94\u5341\u4e09 \u4e94\u5341\u56db \u4e94\u5341\u4e94 \u4e94\u5341\u516d \u4e94\u5341\u4e03 \u4e94\u5341\u516b \u4e94\u5341\u4e5d \u516d\u5341 \u516d\u5341\u4e00 \u516d\u5341\u4e8c \u516d\u5341\u4e09 \u516d\u5341\u56db \u516d\u5341\u4e94 \u516d\u5341\u516d \u516d\u5341\u4e03 \u516d\u5341\u516b \u516d\u5341\u4e5d \u4e03\u5341 \u4e03\u5341\u4e00 \u4e03\u5341\u4e8c \u4e03\u5341\u4e09 \u4e03\u5341\u56db \u4e03\u5341\u4e94 \u4e03\u5341\u516d \u4e03\u5341\u4e03 \u4e03\u5341\u516b \u4e03\u5341\u4e5d \u516b\u5341 \u516b\u5341\u4e00 \u516b\u5341\u4e8c \u516b\u5341\u4e09 \u516b\u5341\u56db \u516b\u5341\u4e94 \u516b\u5341\u516d \u516b\u5341\u4e03 \u516b\u5341\u516b \u516b\u5341\u4e5d \u4e5d\u5341 \u4e5d\u5341\u4e00 \u4e5d\u5341\u4e8c \u4e5d\u5341\u4e09 \u4e5d\u5341\u56db \u4e5d\u5341\u4e94 \u4e5d\u5341\u516d \u4e5d\u5341\u4e03 \u4e5d\u5341\u516b \u4e5d\u5341\u4e5d"
- ::msgcat::mcset zh LOCALE_DATE_FORMAT "\u516c\u5143%Y\u5e74%B%Od\u65e5"
- ::msgcat::mcset zh LOCALE_TIME_FORMAT "%OH\u65f6%OM\u5206%OS\u79d2"
- ::msgcat::mcset zh LOCALE_DATE_TIME_FORMAT "%A %Y\u5e74%B%Od\u65e5%OH\u65f6%OM\u5206%OS\u79d2 %z"
+ ::msgcat::mcset zh BCE "公元å‰"
+ ::msgcat::mcset zh CE "公元"
+ ::msgcat::mcset zh AM "上åˆ"
+ ::msgcat::mcset zh PM "下åˆ"
+ ::msgcat::mcset zh LOCALE_NUMERALS "〇 一 二 三 å›› 五 å…­ 七 å…« ä¹ å å一 å二 å三 åå›› å五 åå…­ å七 åå…« åä¹ äºŒå 廿一 廿二 廿三 廿四 廿五 廿六 廿七 廿八 å»¿ä¹ ä¸‰å å…一 å…二 å…三 å…å›› å…五 å…å…­ å…七 å…å…« å…ä¹ å››å å››å一 å››å二 å››å三 å››åå›› å››å五 å››åå…­ å››å七 å››åå…« å››åä¹ äº”å 五å一 五å二 五å三 五åå›› 五å五 五åå…­ 五å七 五åå…« 五åä¹ å…­å å…­å一 å…­å二 å…­å三 å…­åå›› å…­å五 å…­åå…­ å…­å七 å…­åå…« å…­åä¹ ä¸ƒå 七å一 七å二 七å三 七åå›› 七å五 七åå…­ 七å七 七åå…« 七åä¹ å…«å å…«å一 å…«å二 å…«å三 å…«åå›› å…«å五 å…«åå…­ å…«å七 å…«åå…« å…«åä¹ ä¹å ä¹å一 ä¹å二 ä¹å三 ä¹åå›› ä¹å五 ä¹åå…­ ä¹å七 ä¹åå…« ä¹åä¹"
+ ::msgcat::mcset zh LOCALE_DATE_FORMAT "公元%Y年%B%Od日"
+ ::msgcat::mcset zh LOCALE_TIME_FORMAT "%OH时%OM分%OS秒"
+ ::msgcat::mcset zh LOCALE_DATE_TIME_FORMAT "%A %Y年%B%Od日%OH时%OM分%OS秒 %z"
}
diff --git a/library/msgs/zh_cn.msg b/library/msgs/zh_cn.msg
index d62ce77..da2869a 100644
--- a/library/msgs/zh_cn.msg
+++ b/library/msgs/zh_cn.msg
@@ -2,6 +2,6 @@
namespace eval ::tcl::clock {
::msgcat::mcset zh_CN DATE_FORMAT "%Y-%m-%e"
::msgcat::mcset zh_CN TIME_FORMAT "%k:%M:%S"
- ::msgcat::mcset zh_CN TIME_FORMAT_12 "%P%I\u65f6%M\u5206%S\u79d2"
+ ::msgcat::mcset zh_CN TIME_FORMAT_12 "%P%I时%M分%S秒"
::msgcat::mcset zh_CN DATE_TIME_FORMAT "%Y-%m-%e %k:%M:%S %z"
}
diff --git a/library/msgs/zh_hk.msg b/library/msgs/zh_hk.msg
index badb1dd..7f1b181 100644
--- a/library/msgs/zh_hk.msg
+++ b/library/msgs/zh_hk.msg
@@ -1,28 +1,28 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
::msgcat::mcset zh_HK DAYS_OF_WEEK_ABBREV [list \
- "\u65e5"\
- "\u4e00"\
- "\u4e8c"\
- "\u4e09"\
- "\u56db"\
- "\u4e94"\
- "\u516d"]
+ "æ—¥"\
+ "一"\
+ "二"\
+ "三"\
+ "å››"\
+ "五"\
+ "å…­"]
::msgcat::mcset zh_HK MONTHS_ABBREV [list \
- "1\u6708"\
- "2\u6708"\
- "3\u6708"\
- "4\u6708"\
- "5\u6708"\
- "6\u6708"\
- "7\u6708"\
- "8\u6708"\
- "9\u6708"\
- "10\u6708"\
- "11\u6708"\
- "12\u6708"\
+ "1月"\
+ "2月"\
+ "3月"\
+ "4月"\
+ "5月"\
+ "6月"\
+ "7月"\
+ "8月"\
+ "9月"\
+ "10月"\
+ "11月"\
+ "12月"\
""]
- ::msgcat::mcset zh_HK DATE_FORMAT "%Y\u5e74%m\u6708%e\u65e5"
+ ::msgcat::mcset zh_HK DATE_FORMAT "%Y年%m月%e日"
::msgcat::mcset zh_HK TIME_FORMAT_12 "%P%I:%M:%S"
- ::msgcat::mcset zh_HK DATE_TIME_FORMAT "%Y\u5e74%m\u6708%e\u65e5 %P%I:%M:%S %z"
+ ::msgcat::mcset zh_HK DATE_TIME_FORMAT "%Y年%m月%e日 %P%I:%M:%S %z"
}
diff --git a/library/msgs/zh_sg.msg b/library/msgs/zh_sg.msg
index a2f3e39..690edf7 100644
--- a/library/msgs/zh_sg.msg
+++ b/library/msgs/zh_sg.msg
@@ -1,7 +1,7 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
- ::msgcat::mcset zh_SG AM "\u4e0a\u5348"
- ::msgcat::mcset zh_SG PM "\u4e2d\u5348"
+ ::msgcat::mcset zh_SG AM "上åˆ"
+ ::msgcat::mcset zh_SG PM "中åˆ"
::msgcat::mcset zh_SG DATE_FORMAT "%d %B %Y"
::msgcat::mcset zh_SG TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset zh_SG DATE_TIME_FORMAT "%d %B %Y %P %I:%M:%S %z"
diff --git a/library/msgs/zh_tw.msg b/library/msgs/zh_tw.msg
index e0796b1..17a6dd7 100644
--- a/library/msgs/zh_tw.msg
+++ b/library/msgs/zh_tw.msg
@@ -1,7 +1,7 @@
# created by tools/loadICU.tcl -- do not edit
namespace eval ::tcl::clock {
- ::msgcat::mcset zh_TW BCE "\u6c11\u570b\u524d"
- ::msgcat::mcset zh_TW CE "\u6c11\u570b"
+ ::msgcat::mcset zh_TW BCE "民國å‰"
+ ::msgcat::mcset zh_TW CE "民國"
::msgcat::mcset zh_TW DATE_FORMAT "%Y/%m/%e"
::msgcat::mcset zh_TW TIME_FORMAT_12 "%P %I:%M:%S"
::msgcat::mcset zh_TW DATE_TIME_FORMAT "%Y/%m/%e %P %I:%M:%S %z"
diff --git a/library/opt/optparse.tcl b/library/opt/optparse.tcl
index 869a2b6..c8946fd 100644
--- a/library/opt/optparse.tcl
+++ b/library/opt/optparse.tcl
@@ -8,10 +8,10 @@
# on it. If your code does rely on this package you
# may directly incorporate this code into your application.
-package require Tcl 8.2
+package require Tcl 8.5-
# When this version number changes, update the pkgIndex.tcl file
# and the install directory in the Makefiles.
-package provide opt 0.4.6
+package provide opt 0.4.7
namespace eval ::tcl {
diff --git a/library/opt/pkgIndex.tcl b/library/opt/pkgIndex.tcl
index 107d4c6..daf9aa9 100644
--- a/library/opt/pkgIndex.tcl
+++ b/library/opt/pkgIndex.tcl
@@ -8,5 +8,5 @@
# script is sourced, the variable $dir must contain the
# full path name of this file's directory.
-if {![package vsatisfies [package provide Tcl] 8.2]} {return}
-package ifneeded opt 0.4.6 [list source [file join $dir optparse.tcl]]
+if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
+package ifneeded opt 0.4.7 [list source [file join $dir optparse.tcl]]
diff --git a/library/package.tcl b/library/package.tcl
index 44e3b28..6c87ec1 100644
--- a/library/package.tcl
+++ b/library/package.tcl
@@ -488,12 +488,16 @@ proc tclPkgUnknown {name args} {
set dir [file dirname $file]
if {![info exists procdDirs($dir)]} {
try {
- source $file
+ ::tcl::Pkg::source $file
} trap {POSIX EACCES} {} {
# $file was not readable; silently ignore
continue
} on error msg {
- tclLog "error reading package index file $file: $msg"
+ if {[regexp {version conflict for package} $msg]} {
+ # In case of version conflict, silently ignore
+ continue
+ }
+ tclLog "error reading package index file $file: $msg"
} on ok {} {
set procdDirs($dir) 1
}
@@ -506,11 +510,15 @@ proc tclPkgUnknown {name args} {
# safe interps usually don't have "file exists",
if {([interp issafe] || [file exists $file])} {
try {
- source $file
+ ::tcl::Pkg::source $file
} trap {POSIX EACCES} {} {
# $file was not readable; silently ignore
continue
} on error msg {
+ if {[regexp {version conflict for package} $msg]} {
+ # In case of version conflict, silently ignore
+ continue
+ }
tclLog "error reading package index file $file: $msg"
} on ok {} {
set procdDirs($dir) 1
@@ -590,11 +598,15 @@ proc tcl::MacOSXPkgUnknown {original name args} {
set dir [file dirname $file]
if {![info exists procdDirs($dir)]} {
try {
- source $file
+ ::tcl::Pkg::source $file
} trap {POSIX EACCES} {} {
# $file was not readable; silently ignore
continue
} on error msg {
+ if {[regexp {version conflict for package} $msg]} {
+ # In case of version conflict, silently ignore
+ continue
+ }
tclLog "error reading package index file $file: $msg"
} on ok {} {
set procdDirs($dir) 1
diff --git a/library/safe.tcl b/library/safe.tcl
index ea6391d..7b165d2 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -455,37 +455,35 @@ proc ::safe::InterpInit {
foreach {command alias} {
source AliasSource
load AliasLoad
- encoding AliasEncoding
exit interpDelete
glob AliasGlob
} {
::interp alias $slave $command {} [namespace current]::$alias $slave
}
+ # UGLY POINT! These commands are safe (they're ensembles with unsafe
+ # subcommands), but is assumed to not be by existing policies so it is
+ # hidden by default. Hack it...
+ foreach command {encoding file} {
+ ::interp alias $slave $command {} interp invokehidden $slave $command
+ }
+
# This alias lets the slave have access to a subset of the 'file'
# command functionality.
- ::interp expose $slave file
foreach subcommand {dirname extension rootname tail} {
::interp alias $slave ::tcl::file::$subcommand {} \
::safe::AliasFileSubcommand $slave $subcommand
}
- foreach subcommand {
- atime attributes copy delete executable exists isdirectory isfile
- link lstat mtime mkdir nativename normalize owned readable readlink
- rename size stat tempfile type volumes writable
- } {
- ::interp alias $slave ::tcl::file::$subcommand {} \
- ::safe::BadSubcommand $slave file $subcommand
- }
+
+ # Subcommand of 'encoding' that has special handling; [encoding system] is
+ # OK provided it has no other arguments passed to it.
+ ::interp alias $slave ::tcl::encoding::system {} \
+ ::safe::AliasEncodingSystem $slave
# Subcommands of info
- foreach {subcommand alias} {
- nameofexecutable AliasExeName
- } {
- ::interp alias $slave ::tcl::info::$subcommand \
- {} [namespace current]::$alias $slave
- }
+ ::interp alias $slave ::tcl::info::nameofexecutable {} \
+ ::safe::AliasExeName $slave
# The allowed slave variables already have been set by Tcl_MakeSafe(3)
@@ -1027,16 +1025,13 @@ proc ::safe::BadSubcommand {slave command subcommand args} {
return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
}
-# AliasEncoding is the target of the "encoding" alias in safe interpreters.
-
-proc ::safe::AliasEncoding {slave option args} {
- # Note that [encoding dirs] is not supported in safe slaves at all
- set subcommands {convertfrom convertto names system}
+# AliasEncodingSystem is the target of the "encoding system" alias in safe
+# interpreters.
+proc ::safe::AliasEncodingSystem {slave args} {
try {
- set option [tcl::prefix match -error [list -level 1 -errorcode \
- [list TCL LOOKUP INDEX option $option]] $subcommands $option]
- # Special case: [encoding system] ok, but [encoding system foo] not
- if {$option eq "system" && [llength $args]} {
+ # Must not pass extra arguments; safe slaves may not set the system
+ # encoding but they may read it.
+ if {[llength $args]} {
return -code error -errorcode {TCL WRONGARGS} \
"wrong # args: should be \"encoding system\""
}
@@ -1044,7 +1039,7 @@ proc ::safe::AliasEncoding {slave option args} {
Log $slave $msg
return -options $options $msg
}
- tailcall ::interp invokehidden $slave encoding $option {*}$args
+ tailcall ::interp invokehidden $slave tcl:encoding:system
}
# Various minor hiding of platform features. [Bug 2913625]
diff --git a/library/tclIndex b/library/tclIndex
index 26603c1..87a2814 100644
--- a/library/tclIndex
+++ b/library/tclIndex
@@ -7,69 +7,69 @@
# element name is the name of a command and the value is
# a script that loads the command.
-set auto_index(auto_reset) [list source [file join $dir auto.tcl]]
-set auto_index(tcl_findLibrary) [list source [file join $dir auto.tcl]]
-set auto_index(auto_mkindex) [list source [file join $dir auto.tcl]]
-set auto_index(auto_mkindex_old) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::init) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::cleanup) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::mkindex) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::hook) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::slavehook) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::command) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::commandInit) [list source [file join $dir auto.tcl]]
-set auto_index(::auto_mkindex_parser::fullname) [list source [file join $dir auto.tcl]]
-set auto_index(history) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistAdd) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistKeep) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistClear) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistInfo) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistRedo) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistIndex) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistEvent) [list source [file join $dir history.tcl]]
-set auto_index(::tcl::HistChange) [list source [file join $dir history.tcl]]
-set auto_index(pkg_mkIndex) [list source [file join $dir package.tcl]]
-set auto_index(tclPkgSetup) [list source [file join $dir package.tcl]]
-set auto_index(tclPkgUnknown) [list source [file join $dir package.tcl]]
-set auto_index(::tcl::MacOSXPkgUnknown) [list source [file join $dir package.tcl]]
-set auto_index(::pkg::create) [list source [file join $dir package.tcl]]
-set auto_index(parray) [list source [file join $dir parray.tcl]]
-set auto_index(::safe::InterpStatics) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpNested) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpCreate) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpInit) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::CheckInterp) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpConfigure) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpCreate) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpSetConfig) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpFindInAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpAddToAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::InterpInit) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AddSubDirs) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::interpDelete) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::setLogCmd) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::SyncAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::PathToken) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::TranslatePath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Log) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::CheckFileName) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasGlob) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasSource) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasLoad) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::FileInAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::DirInAccessPath) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::Subset) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasSubset) [list source [file join $dir safe.tcl]]
-set auto_index(::safe::AliasEncoding) [list source [file join $dir safe.tcl]]
-set auto_index(tcl_wordBreakAfter) [list source [file join $dir word.tcl]]
-set auto_index(tcl_wordBreakBefore) [list source [file join $dir word.tcl]]
-set auto_index(tcl_endOfWord) [list source [file join $dir word.tcl]]
-set auto_index(tcl_startOfNextWord) [list source [file join $dir word.tcl]]
-set auto_index(tcl_startOfPreviousWord) [list source [file join $dir word.tcl]]
-set auto_index(::tcl::tm::add) [list source [file join $dir tm.tcl]]
-set auto_index(::tcl::tm::remove) [list source [file join $dir tm.tcl]]
-set auto_index(::tcl::tm::list) [list source [file join $dir tm.tcl]]
-set auto_index(::tcl::tm::Defaults) [list source [file join $dir tm.tcl]]
-set auto_index(::tcl::tm::UnknownHandler) [list source [file join $dir tm.tcl]]
-set auto_index(::tcl::tm::roots) [list source [file join $dir tm.tcl]]
-set auto_index(::tcl::tm::path) [list source [file join $dir tm.tcl]]
+set auto_index(auto_reset) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(tcl_findLibrary) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(auto_mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(auto_mkindex_old) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::init) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::cleanup) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::mkindex) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::hook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::slavehook) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistClear) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistInfo) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistRedo) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistIndex) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistEvent) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(::tcl::HistChange) [list ::tcl::Pkg::source [file join $dir history.tcl]]
+set auto_index(pkg_mkIndex) [list ::tcl::Pkg::source [file join $dir package.tcl]]
+set auto_index(tclPkgSetup) [list ::tcl::Pkg::source [file join $dir package.tcl]]
+set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
+set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
+set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]]
+set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]]
+set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::interpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::CheckInterp) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::interpConfigure) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpSetConfig) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::interpFindInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::interpAddToAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::InterpInit) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::AddSubDirs) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::interpDelete) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::setLogCmd) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::SyncAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::PathToken) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::TranslatePath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::Log) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::CheckFileName) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasGlob) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasSource) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasLoad) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::FileInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::DirInAccessPath) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::Subset) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasSubset) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(::safe::AliasEncoding) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
+set auto_index(tcl_wordBreakAfter) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::Defaults) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::UnknownHandler) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::roots) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
+set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
diff --git a/library/word.tcl b/library/word.tcl
index 3e4bc3a..0246530 100644
--- a/library/word.tcl
+++ b/library/word.tcl
@@ -11,24 +11,14 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# The following variables are used to determine which characters are
-# interpreted as white space.
+# interpreted as word characters. See bug [f1253530cdd8]. Will
+# probably be removed in Tcl 9.
-if {$::tcl_platform(platform) eq "windows"} {
- # Windows style - any but a unicode space char
- if {![info exists ::tcl_wordchars]} {
- set ::tcl_wordchars {\S}
- }
- if {![info exists ::tcl_nonwordchars]} {
- set ::tcl_nonwordchars {\s}
- }
-} else {
- # Motif style - any unicode word char (number, letter, or underscore)
- if {![info exists ::tcl_wordchars]} {
- set ::tcl_wordchars {\w}
- }
- if {![info exists ::tcl_nonwordchars]} {
- set ::tcl_nonwordchars {\W}
- }
+if {![info exists ::tcl_wordchars]} {
+ set ::tcl_wordchars {\w}
+}
+if {![info exists ::tcl_nonwordchars]} {
+ set ::tcl_nonwordchars {\W}
}
# Arrange for caches of the real matcher REs to be kept, which enables the REs
diff --git a/libtommath/astylerc b/libtommath/astylerc
new file mode 100644
index 0000000..5d63f7a
--- /dev/null
+++ b/libtommath/astylerc
@@ -0,0 +1,27 @@
+# Artistic Style, see http://astyle.sourceforge.net/
+# full documentation, see: http://astyle.sourceforge.net/astyle.html
+#
+# usage:
+# astyle --options=astylerc *.[ch]
+
+## Bracket Style Options
+style=kr
+
+## Tab Options
+indent=spaces=3
+
+## Bracket Modify Options
+
+## Indentation Options
+min-conditional-indent=0
+
+## Padding Options
+pad-header
+unpad-paren
+align-pointer=name
+
+## Formatting Options
+break-after-logical
+max-code-length=120
+convert-tabs
+mode=c
diff --git a/libtommath/bn_mp_get_long_long.c b/libtommath/bn_mp_get_long_long.c
index 4201b4d..61d16ea 100644
--- a/libtommath/bn_mp_get_long_long.c
+++ b/libtommath/bn_mp_get_long_long.c
@@ -13,17 +13,17 @@
*/
/* get the lower unsigned long long of an mp_int, platform dependent */
-unsigned long long mp_get_long_long(const mp_int *a)
+Tcl_WideUInt mp_get_long_long(const mp_int *a)
{
int i;
- unsigned long long res;
+ Tcl_WideUInt res;
if (a->used == 0) {
return 0;
}
/* get number of digits of the lsb we have to read */
- i = MIN(a->used, ((((int)sizeof(unsigned long long) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
+ i = MIN(a->used, ((((int)sizeof(Tcl_WideUInt) * CHAR_BIT) + DIGIT_BIT - 1) / DIGIT_BIT)) - 1;
/* get most significant digit of result */
res = DIGIT(a, i);
diff --git a/libtommath/tommath.h b/libtommath/tommath.h
index c240d80..ce38975 100644
--- a/libtommath/tommath.h
+++ b/libtommath/tommath.h
@@ -45,6 +45,8 @@ extern "C" {
# endif
#endif
+typedef unsigned long long Tcl_WideUInt;
+
/* some default configurations.
*
* A "mp_digit" must be able to hold DIGIT_BIT + 1 bits
diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile
index 56e5500..9d82e42 100644
--- a/macosx/GNUmakefile
+++ b/macosx/GNUmakefile
@@ -92,7 +92,7 @@ PROJECT := tcl
PRODUCT_NAME := Tcl
UNIX_DIR := ${CURDIR}/../unix
-VERSION := $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.in)
+VERSION := $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.ac)
TCLSH := tclsh${VERSION}
BUILD_TARGET := all tcltest
@@ -132,7 +132,7 @@ ${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \
if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
- --mandir="${MANDIR}" --enable-threads --enable-framework --enable-dtrace \
+ --mandir="${MANDIR}" --enable-framework --enable-dtrace \
${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi
build-${PROJECT}: ${objdir}/Makefile
diff --git a/macosx/README b/macosx/README
index c25066e..43c9c47 100644
--- a/macosx/README
+++ b/macosx/README
@@ -113,7 +113,7 @@ The following build configurations are available:
The Xcode projects refer to the toplevel tcl source directory via the
TCL_SRCROOT user build setting, by default this is set to the project-relative
path '../../tcl', if your tcl source directory is named differently, e.g.
-'../../tcl8.6', you need to manually change the TCL_SRCROOT setting by editing
+'../../tcl8.7', you need to manually change the TCL_SRCROOT setting by editing
your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
with a text editor.
@@ -134,9 +134,9 @@ Detailed Instructions for building with macosx/GNUmakefile
- Unpack the Tcl source release archive.
- The following instructions assume the Tcl source tree is named "tcl${ver}",
-(where ${ver} is a shell variable containing the Tcl version number e.g. '8.6').
+(where ${ver} is a shell variable containing the Tcl version number e.g. '8.7').
Setup this shell variable as follows:
- ver="8.6"
+ ver="8.7"
If you are building from CVS, omit this step (CVS source tree names usually do
not contain a version number).
diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig
index 9c47547..0670479 100644
--- a/macosx/Tcl-Common.xcconfig
+++ b/macosx/Tcl-Common.xcconfig
@@ -19,7 +19,7 @@ GCC_NO_COMMON_BLOCKS = YES
GCC_DYNAMIC_NO_PIC = YES
GCC_VERSION = 4.2
GCC = gcc-$(GCC_VERSION)
-WARNING_CFLAGS = -Wall -Wextra -Wno-unused-parameter -Wno-missing-field-initializers -Wno-unused-value -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS)
+WARNING_CFLAGS = -Wall -Wwrite-strings -Wextra -Wdeclaration-after-statement -Wno-unused-parameter -Wno-missing-field-initializers -Wno-unused-value -Winit-self -Wpointer-arith -Wcast-align -Wdisabled-optimization -Winline $(WARNING_CFLAGS)
BINDIR = $(PREFIX)/bin
CFLAGS = $(CFLAGS)
CPPFLAGS = -mmacosx-version-min=$(MACOSX_DEPLOYMENT_TARGET) $(CPPFLAGS)
@@ -30,8 +30,8 @@ MANDIR = $(PREFIX)/man
PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
PREFIX = /usr/local
-TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
+TCL_CONFIGURE_ARGS = --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
-VERSION = 8.6
+VERSION = 8.7
diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj
index c5b3868..51e9c68 100644
--- a/macosx/Tcl.xcode/project.pbxproj
+++ b/macosx/Tcl.xcode/project.pbxproj
@@ -166,6 +166,7 @@
F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; };
F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; };
F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */; };
F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; };
F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; };
F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; };
@@ -769,7 +770,7 @@
F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = "<group>"; };
F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; };
F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
- F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; };
F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
@@ -792,7 +793,7 @@
F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
- F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
@@ -836,7 +837,7 @@
F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };
F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
- F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D447508F272BA004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
@@ -1440,6 +1441,7 @@
F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */,
F96D427E08F272B3004A47F5 /* bn_mp_exch.c */,
F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */,
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */,
F96D428708F272B3004A47F5 /* bn_mp_grow.c */,
F96D428808F272B3004A47F5 /* bn_mp_init.c */,
F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */,
@@ -1664,7 +1666,7 @@
children = (
F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
F96D43D208F272B8004A47F5 /* configure */,
- F96D43D308F272B8004A47F5 /* configure.in */,
+ F96D43D308F272B8004A47F5 /* configure.ac */,
F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
F96D442508F272B8004A47F5 /* genStubs.tcl */,
F96D442708F272B8004A47F5 /* index.tcl */,
@@ -1695,7 +1697,7 @@
children = (
F96D444008F272B9004A47F5 /* aclocal.m4 */,
F96D444108F272B9004A47F5 /* configure */,
- F96D444208F272B9004A47F5 /* configure.in */,
+ F96D444208F272B9004A47F5 /* configure.ac */,
F96D444308F272B9004A47F5 /* dltest */,
F96D444D08F272B9004A47F5 /* install-sh */,
F96D444E08F272B9004A47F5 /* installManPage */,
@@ -1756,7 +1758,7 @@
F96D447208F272BA004A47F5 /* cat.c */,
F96D447308F272BA004A47F5 /* coffbase.txt */,
F96D447408F272BA004A47F5 /* configure */,
- F96D447508F272BA004A47F5 /* configure.in */,
+ F96D447508F272BA004A47F5 /* configure.ac */,
F96D447708F272BA004A47F5 /* Makefile.in */,
F96D447808F272BA004A47F5 /* makefile.vc */,
F96D447908F272BA004A47F5 /* nmakehlp.c */,
@@ -1942,7 +1944,7 @@
);
inputPaths = (
"$(TCL_SRCROOT)/macosx/configure.ac",
- "$(TCL_SRCROOT)/unix/configure.in",
+ "$(TCL_SRCROOT)/unix/configure.ac",
"$(TCL_SRCROOT)/unix/tcl.m4",
"$(TCL_SRCROOT)/unix/aclocal.m4",
"$(TCL_SRCROOT)/unix/tclConfig.sh.in",
@@ -1955,7 +1957,7 @@
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/bash;
- shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
+ shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.ac -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
showEnvVarsInLog = 0;
};
/* End PBXShellScriptBuildPhase section */
@@ -2071,6 +2073,7 @@
F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */,
F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */,
F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */,
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */,
F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */,
F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */,
F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */,
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
index 6068112..cef23e3 100644
--- a/macosx/Tcl.xcodeproj/project.pbxproj
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -165,7 +165,8 @@
F9E61D29090A486C002B3151 /* bn_mp_neg.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A208F272B3004A47F5 /* bn_mp_neg.c */; };
F9E61D2A090A4891002B3151 /* bn_mp_sqrt.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42C008F272B3004A47F5 /* bn_mp_sqrt.c */; };
F9E61D2B090A48A4002B3151 /* bn_mp_and.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D426C08F272B3004A47F5 /* bn_mp_and.c */; };
- F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */; };
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */; };
F9E61D2D090A48BB002B3151 /* bn_mp_xor.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42CD08F272B3004A47F5 /* bn_mp_xor.c */; };
F9E61D2E090A48BF002B3151 /* bn_mp_or.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42A308F272B3004A47F5 /* bn_mp_or.c */; };
F9E61D2F090A48C7002B3151 /* bn_mp_shrink.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D42BC08F272B3004A47F5 /* bn_mp_shrink.c */; };
@@ -579,6 +580,7 @@
F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_div_d.c; sourceTree = "<group>"; };
F96D427E08F272B3004A47F5 /* bn_mp_exch.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_exch.c; sourceTree = "<group>"; };
F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d.c; sourceTree = "<group>"; };
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_expt_d_ex.c; sourceTree = "<group>"; };
F96D428708F272B3004A47F5 /* bn_mp_grow.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_grow.c; sourceTree = "<group>"; };
F96D428808F272B3004A47F5 /* bn_mp_init.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init.c; sourceTree = "<group>"; };
F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = bn_mp_init_copy.c; sourceTree = "<group>"; };
@@ -769,7 +771,7 @@
F96D43CF08F272B7004A47F5 /* winTime.test */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = winTime.test; sourceTree = "<group>"; };
F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = checkLibraryDoc.tcl; sourceTree = "<group>"; };
F96D43D208F272B8004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
- F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D43D308F272B8004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = fix_tommath_h.tcl; sourceTree = "<group>"; };
F96D442508F272B8004A47F5 /* genStubs.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = genStubs.tcl; sourceTree = "<group>"; };
F96D442708F272B8004A47F5 /* index.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = index.tcl; sourceTree = "<group>"; };
@@ -792,7 +794,7 @@
F96D443C08F272B9004A47F5 /* uniParse.tcl */ = {isa = PBXFileReference; explicitFileType = text.script; fileEncoding = 4; path = uniParse.tcl; sourceTree = "<group>"; };
F96D444008F272B9004A47F5 /* aclocal.m4 */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = aclocal.m4; sourceTree = "<group>"; };
F96D444108F272B9004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
- F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D444208F272B9004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
@@ -836,7 +838,7 @@
F96D447208F272BA004A47F5 /* cat.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = cat.c; sourceTree = "<group>"; };
F96D447308F272BA004A47F5 /* coffbase.txt */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text; path = coffbase.txt; sourceTree = "<group>"; };
F96D447408F272BA004A47F5 /* configure */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = text.script.sh; path = configure; sourceTree = "<group>"; };
- F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
+ F96D447508F272BA004A47F5 /* configure.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
F96D447908F272BA004A47F5 /* nmakehlp.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = nmakehlp.c; sourceTree = "<group>"; };
@@ -1440,6 +1442,7 @@
F96D427A08F272B3004A47F5 /* bn_mp_div_d.c */,
F96D427E08F272B3004A47F5 /* bn_mp_exch.c */,
F96D427F08F272B3004A47F5 /* bn_mp_expt_d.c */,
+ F96D427F08F272B3004A47F5 /* bn_mp_expt_d_ex.c */,
F96D428708F272B3004A47F5 /* bn_mp_grow.c */,
F96D428808F272B3004A47F5 /* bn_mp_init.c */,
F96D428908F272B3004A47F5 /* bn_mp_init_copy.c */,
@@ -1664,7 +1667,7 @@
children = (
F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
F96D43D208F272B8004A47F5 /* configure */,
- F96D43D308F272B8004A47F5 /* configure.in */,
+ F96D43D308F272B8004A47F5 /* configure.ac */,
F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
F96D442508F272B8004A47F5 /* genStubs.tcl */,
F96D442708F272B8004A47F5 /* index.tcl */,
@@ -1695,7 +1698,7 @@
children = (
F96D444008F272B9004A47F5 /* aclocal.m4 */,
F96D444108F272B9004A47F5 /* configure */,
- F96D444208F272B9004A47F5 /* configure.in */,
+ F96D444208F272B9004A47F5 /* configure.ac */,
F96D444308F272B9004A47F5 /* dltest */,
F96D444D08F272B9004A47F5 /* install-sh */,
F96D444E08F272B9004A47F5 /* installManPage */,
@@ -1756,7 +1759,7 @@
F96D447208F272BA004A47F5 /* cat.c */,
F96D447308F272BA004A47F5 /* coffbase.txt */,
F96D447408F272BA004A47F5 /* configure */,
- F96D447508F272BA004A47F5 /* configure.in */,
+ F96D447508F272BA004A47F5 /* configure.ac */,
F96D447708F272BA004A47F5 /* Makefile.in */,
F96D447808F272BA004A47F5 /* makefile.vc */,
F96D447908F272BA004A47F5 /* nmakehlp.c */,
@@ -1942,7 +1945,7 @@
);
inputPaths = (
"$(TCL_SRCROOT)/macosx/configure.ac",
- "$(TCL_SRCROOT)/unix/configure.in",
+ "$(TCL_SRCROOT)/unix/configure.ac",
"$(TCL_SRCROOT)/unix/tcl.m4",
"$(TCL_SRCROOT)/unix/aclocal.m4",
"$(TCL_SRCROOT)/unix/tclConfig.sh.in",
@@ -1955,7 +1958,7 @@
);
runOnlyForDeploymentPostprocessing = 0;
shellPath = /bin/bash;
- shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
+ shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.ac -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
showEnvVarsInLog = 0;
};
/* End PBXShellScriptBuildPhase section */
@@ -2071,6 +2074,7 @@
F96D48F808F272C3004A47F5 /* bn_mp_div_d.c in Sources */,
F96D48FC08F272C3004A47F5 /* bn_mp_exch.c in Sources */,
F9E61D2C090A48AC002B3151 /* bn_mp_expt_d.c in Sources */,
+ F9E61D2C090A48AC002B3151 /* bn_mp_expt_d_ex.c in Sources */,
F96D490508F272C3004A47F5 /* bn_mp_grow.c in Sources */,
F96D490608F272C3004A47F5 /* bn_mp_init.c in Sources */,
F96D490708F272C3004A47F5 /* bn_mp_init_copy.c in Sources */,
diff --git a/macosx/configure.ac b/macosx/configure.ac
index f7a8bb3..6b1e3ac 100644
--- a/macosx/configure.ac
+++ b/macosx/configure.ac
@@ -8,4 +8,4 @@ dnl include the configure sources from ../unix:
m4_include(../unix/aclocal.m4)
m4_define(SC_USE_CONFIG_HEADERS)
-m4_include(../unix/configure.in)
+m4_include(../unix/configure.ac)
diff --git a/macosx/tclMacOSXFCmd.c b/macosx/tclMacOSXFCmd.c
index f34b280..f09a441 100644
--- a/macosx/tclMacOSXFCmd.c
+++ b/macosx/tclMacOSXFCmd.c
@@ -106,7 +106,7 @@ typedef struct finderinfo {
u_int32_t extendedFileInfo[4];
} __attribute__ ((__packed__)) finderinfo;
-typedef struct fileinfobuf {
+typedef struct {
u_int32_t info_length;
u_int32_t data[8];
} fileinfobuf;
@@ -636,12 +636,12 @@ SetOSTypeFromAny(
Tcl_Obj *objPtr) /* Pointer to the object to convert */
{
const char *string;
- int length, result = TCL_OK;
+ int result = TCL_OK;
Tcl_DString ds;
Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
- string = Tcl_GetStringFromObj(objPtr, &length);
- Tcl_UtfToExternalDString(encoding, string, length, &ds);
+ string = TclGetString(objPtr);
+ Tcl_UtfToExternalDString(encoding, string, objPtr->length, &ds);
if (Tcl_DStringLength(&ds) > 4) {
if (interp) {
@@ -692,24 +692,28 @@ UpdateStringOfOSType(
register Tcl_Obj *objPtr) /* OSType object whose string rep to
* update. */
{
- char string[5];
+ const int size = TCL_UTF_MAX * 4;
+ char *dst = Tcl_InitStringRep(objPtr, NULL, size);
OSType osType = (OSType) objPtr->internalRep.longValue;
- Tcl_DString ds;
- Tcl_Encoding encoding = Tcl_GetEncoding(NULL, "macRoman");
- unsigned len;
-
- string[0] = (char) (osType >> 24);
- string[1] = (char) (osType >> 16);
- string[2] = (char) (osType >> 8);
- string[3] = (char) (osType);
- string[4] = '\0';
- Tcl_ExternalToUtfDString(encoding, string, -1, &ds);
- len = (unsigned) Tcl_DStringLength(&ds) + 1;
- objPtr->bytes = ckalloc(len);
- memcpy(objPtr->bytes, Tcl_DStringValue(&ds), len);
- objPtr->length = Tcl_DStringLength(&ds);
- Tcl_DStringFree(&ds);
+ int written = 0;
+ Tcl_Encoding encoding;
+ char src[5];
+
+ TclOOM(dst, size);
+
+ src[0] = (char) (osType >> 24);
+ src[1] = (char) (osType >> 16);
+ src[2] = (char) (osType >> 8);
+ src[3] = (char) (osType);
+ src[4] = '\0';
+
+ encoding = Tcl_GetEncoding(NULL, "macRoman");
+ Tcl_ExternalToUtf(NULL, encoding, src, -1, /* flags */ 0,
+ /* statePtr */ NULL, dst, size, /* srcReadPtr */ NULL,
+ /* dstWrotePtr */ &written, /* dstCharsPtr */ NULL);
Tcl_FreeEncoding(encoding);
+
+ (void)Tcl_InitStringRep(objPtr, NULL, written);
}
/*
diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c
index 9b7bd1a..b21130b 100644
--- a/macosx/tclMacOSXNotify.c
+++ b/macosx/tclMacOSXNotify.c
@@ -31,6 +31,9 @@
*/
#if defined(HAVE_LIBKERN_OSATOMIC_H) && defined(HAVE_OSSPINLOCKLOCK)
+#pragma GCC diagnostic push
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+#pragma GCC diagnostic ignored "-Wunused-function"
/*
* Use OSSpinLock API where available (Tiger or later).
*/
@@ -42,14 +45,17 @@
* Support for weakly importing spinlock API.
*/
#define WEAK_IMPORT_SPINLOCKLOCK
+
#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1050
#define VOLATILE volatile
#else
#define VOLATILE
#endif /* MAC_OS_X_VERSION_MAX_ALLOWED >= 1050 */
+
#ifndef bool
#define bool int
#endif
+
extern void OSSpinLockLock(VOLATILE OSSpinLock *lock)
WEAK_IMPORT_ATTRIBUTE;
extern void OSSpinLockUnlock(VOLATILE OSSpinLock *lock)
@@ -77,13 +83,54 @@ SpinLockLockInit(void)
Tcl_Panic("SpinLockLockInit: no spinlock API available");
}
}
-#define SpinLockLock(p) lockLock(p)
-#define SpinLockUnlock(p) lockUnlock(p)
-#define SpinLockTry(p) lockTry(p)
-#else
-#define SpinLockLock(p) OSSpinLockLock(p)
-#define SpinLockUnlock(p) OSSpinLockUnlock(p)
-#define SpinLockTry(p) OSSpinLockTry(p)
+
+/*
+ * Wrappers so that we get warnings in just one small part of this file.
+ */
+
+static inline void
+SpinLockLock(
+ VOLATILE OSSpinLock *lock)
+{
+ lockLock(lock);
+}
+static inline void
+SpinLockUnlock(
+ VOLATILE OSSpinLock *lock)
+{
+ lockUnlock(lock);
+}
+static inline bool
+SpinLockTry(
+ VOLATILE OSSpinLock *lock)
+{
+ return lockTry(lock);
+}
+
+#else /* !HAVE_WEAK_IMPORT */
+
+/*
+ * Wrappers so that we get warnings in just one small part of this file.
+ */
+
+static inline void
+SpinLockLock(
+ OSSpinLock *lock)
+{
+ OSSpinLockLock(lock);
+}
+static inline void
+SpinLockUnlock(
+ OSSpinLock *lock)
+{
+ OSSpinLockUnlock(lock);
+}
+static inline bool
+SpinLockTry(
+ OSSpinLock *lock)
+{
+ return OSSpinLockTry(lock);
+}
#endif /* HAVE_WEAK_IMPORT */
#define SPINLOCK_INIT OS_SPINLOCK_INIT
@@ -93,14 +140,37 @@ SpinLockLockInit(void)
*/
typedef uint32_t OSSpinLock;
-extern void _spin_lock(OSSpinLock *lock);
-extern void _spin_unlock(OSSpinLock *lock);
-extern int _spin_lock_try(OSSpinLock *lock);
-#define SpinLockLock(p) _spin_lock(p)
-#define SpinLockUnlock(p) _spin_unlock(p)
-#define SpinLockTry(p) _spin_lock_try(p)
+
+static inline void
+SpinLockLock(
+ OSSpinLock *lock)
+{
+ extern void _spin_lock(OSSpinLock *lock);
+
+ _spin_lock(lock);
+}
+
+static inline void
+SpinLockUnlock(
+ OSSpinLock *lock)
+{
+ extern void _spin_unlock(OSSpinLock *lock);
+
+ _spin_unlock(lock);
+}
+
+static inline int
+SpinLockTry(
+ OSSpinLock *lock)
+{
+ extern int _spin_lock_try(OSSpinLock *lock);
+
+ return _spin_lock_try(lock);
+}
+
#define SPINLOCK_INIT 0
+#pragma GCC diagnostic pop
#endif /* HAVE_LIBKERN_OSATOMIC_H && HAVE_OSSPINLOCKLOCK */
/*
@@ -217,7 +287,7 @@ typedef struct FileHandler {
* handlers are ready to fire.
*/
-typedef struct FileHandlerEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
int fd; /* File descriptor that is ready. Used to find
@@ -232,7 +302,7 @@ typedef struct FileHandlerEvent {
* writable, and exceptional conditions.
*/
-typedef struct SelectMasks {
+typedef struct {
fd_set readable;
fd_set writable;
fd_set exceptional;
@@ -385,8 +455,7 @@ static CFStringRef tclEventsOnlyRunLoopMode = NULL;
*/
static void StartNotifierThread(void);
-static void NotifierThreadProc(ClientData clientData)
- __attribute__ ((__noreturn__));
+static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
static void TimerWakeUp(CFRunLoopTimerRef timer, void *info);
static void QueueFileEvents(void *info);
@@ -1412,7 +1481,10 @@ UpdateWaitingListAndServiceEvents(
(tsdPtr->runLoopNestingLevel > 1
|| !tsdPtr->runLoopRunning)) {
tsdPtr->runLoopServicingEvents = 1;
- /* This call seems to simply force event processing through and prevents hangups that have long been observed with Tk-Cocoa. */
+ /*
+ * This call seems to simply force event processing through and
+ * prevents hangups that have long been observed with Tk-Cocoa.
+ */
Tcl_ServiceAll();
tsdPtr->runLoopServicingEvents = 0;
}
@@ -1753,7 +1825,7 @@ TclUnixWaitForFile(
*----------------------------------------------------------------------
*/
-static void
+static TCL_NORETURN void
NotifierThreadProc(
ClientData clientData) /* Not used. */
{
diff --git a/tests/README b/tests/README
index ce2382e..e86100f 100644
--- a/tests/README
+++ b/tests/README
@@ -59,7 +59,7 @@ 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 may not
correspond to any Tcl or C code file so they should match the pattern
-"*_bb.test".
+"*_bb.test".
Be sure your new test file can be run from any working directory.
@@ -72,12 +72,12 @@ 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.
-4. Incompatibilities of package tcltest 2.1 with
+4. Incompatibilities of package tcltest 2.1 with
testing machinery of very old versions of Tcl:
------------------------------------------------
1) Global variables such as VERBOSE, TESTS, and testConfig of the
- old machinery correspond to the [configure -verbose],
+ old machinery correspond to the [configure -verbose],
[configure -match], and [testConstraint] commands of tcltest 2.1,
respectively.
diff --git a/tests/apply.test b/tests/apply.test
index ba19b81..597cd97 100644
--- a/tests/apply.test
+++ b/tests/apply.test
@@ -228,7 +228,7 @@ test apply-8.3 {args treatment} {
apply [list {x args} $applyBody] 1 2 3
} {{x 1} {args {2 3}}}
test apply-8.4 {default values} {
- apply [list {{x 1} {y 2}} $applyBody]
+ apply [list {{x 1} {y 2}} $applyBody]
} {{x 1} {y 2}}
test apply-8.5 {default values} {
apply [list {{x 1} {y 2}} $applyBody] 3 4
diff --git a/tests/assemble.test b/tests/assemble.test
index 40c132d..05c1f9b 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -12,7 +12,7 @@
# Commands covered: assemble
if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
namespace eval tcl::unsupported {namespace export assemble}
@@ -301,12 +301,12 @@ test assemble-7.1 {add, wrong # args} {
-result {wrong # args*}
}
test assemble-7.2 {add} {
- -body {
+ -body {
assemble {
push 2
push 2
add
- }
+ }
}
-result {4}
}
@@ -349,7 +349,7 @@ test assemble-7.5 {bitwise ops} {
}
test assemble-7.6 {div} {
-body {
- assemble {push 999999; push 7; div}
+ assemble {push 999999; push 7; div}
}
-result 142857
}
@@ -360,7 +360,7 @@ test assemble-7.7 {dup} {
}
}
-result 9
-}
+}
test assemble-7.8 {eq} {
-body {
list \
@@ -638,7 +638,7 @@ test assemble-7.24 {lsetList} {
test assemble-7.25 {lshift} {
-body {
assemble {push 16; push 4; lshift}
- }
+ }
-result 256
}
test assemble-7.26 {mod} {
@@ -678,7 +678,7 @@ test assemble-7.30 {pop} {
test assemble-7.31 {rshift} {
-body {
assemble {push 257; push 4; rshift}
- }
+ }
-result 16
}
test assemble-7.32 {storeArrayStk} {
@@ -852,10 +852,11 @@ test assemble-8.5 {bad context} {
-body {
namespace eval assem {
set x 1
- list [catch {assemble {load x}} result opts] $result [dict get $opts -errorcode]
+ assemble {load x}
}
}
- -result {1 {cannot use this instruction to create a variable in a non-proc context} {TCL ASSEM LVT}}
+ -result {cannot use this instruction to create a variable in a non-proc context}
+ -errorCode {TCL ASSEM LVT}
-cleanup {namespace delete assem}
}
test assemble-8.6 {load1} {
@@ -1110,10 +1111,10 @@ test assemble-9.6 {concat} {
}
test assemble-9.7 {concat} {
-body {
- list [catch {assemble {concat 0}} result] $result $::errorCode
+ assemble {concat 0}
}
- -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
- -cleanup {unset result}
+ -result {operand must be positive}
+ -errorCode {TCL ASSEM POSITIVE}
}
# assemble-10 -- eval and expr
@@ -1201,7 +1202,7 @@ test assemble-10.7 {expr - noncompilable} {
# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend,
# nsupvar, variable, upvar)
-
+
test assemble-11.1 {exist - wrong # args} {
-body {
assemble {exist}
@@ -1310,7 +1311,7 @@ test assemble-11.10 {variable} {
}
# assemble-12 - ASSEM_LVT1 (incr and incrArray)
-
+
test assemble-12.1 {incr - wrong # args} {
-body {
assemble {incr}
@@ -1749,16 +1750,16 @@ test assemble-17.9 {jump - resolve a label multiple times} {
set result {}
assemble {
jump common
-
+
label zero
- pop
+ pop
incrImm case 1
pop
push a
append result
pop
jump common
-
+
label one
pop
incrImm case 1
@@ -1767,7 +1768,7 @@ test assemble-17.9 {jump - resolve a label multiple times} {
append result
pop
jump common
-
+
label common
load case
dup
@@ -1786,7 +1787,7 @@ test assemble-17.9 {jump - resolve a label multiple times} {
push 3
eq
jumpTrue three
-
+
label two
pop
incrImm case 1
@@ -1795,7 +1796,7 @@ test assemble-17.9 {jump - resolve a label multiple times} {
append result
pop
jump common
-
+
label three
pop
incrImm case 1
@@ -1893,7 +1894,7 @@ test assemble-17.15 {multiple passes of code resizing} {
append body {label b15; push b; concat 2; nop; nop; jump c} \n
append body {label d}
proc x {} [list assemble $body]
- }
+ }
-body {
x
}
@@ -2086,7 +2087,7 @@ test assemble-20.5 {lsetFlat - negative operand count} {
test assemble-20.6 {lsetFlat} {
-body {
assemble {push b; push a; lsetFlat 2}
- }
+ }
-result b
}
test assemble-20.7 {lsetFlat} {
@@ -3072,12 +3073,12 @@ test assemble-40.1 {unbalanced stack} {
[catch {
assemble {
push 3
- dup
- mult
+ dup
+ mult
push 4
- dup
- mult
- pop
+ dup
+ mult
+ pop
expon
}
} result] $result $::errorInfo
@@ -3176,7 +3177,7 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
load n; # max
dup; # max n
jump start; # max n
-
+
label loop; # max n
over 1; # max n max
over 1; # max in max n
@@ -3186,29 +3187,29 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
reverse 2; # n max
pop; # n
dup; # n n
-
+
label skip; # max n
dup; # max n n
push 2; # max n n 2
mod; # max n n%2
jumpTrue odd; # max n
-
+
push 2; # max n 2
div; # max n/2 -> max n
jump start; # max n
-
+
label odd; # max n
push 3; # max n 3
mult; # max 3*n
push 1; # max 3*n 1
add; # max 3*n+1
-
+
label start; # max n
dup; # max n n
push 1; # max n n 1
neq; # max n n>1
jumpTrue loop; # max n
-
+
pop; # max
}
}
@@ -3238,7 +3239,7 @@ test assemble-51.3 {memory leak testing} memory {
load n; # max
dup; # max n
jump start; # max n
-
+
label loop; # max n
over 1; # max n max
over 1; # max in max n
@@ -3248,29 +3249,29 @@ test assemble-51.3 {memory leak testing} memory {
reverse 2; # n max
pop; # n
dup; # n n
-
+
label skip; # max n
dup; # max n n
push 2; # max n n 2
mod; # max n n%2
jumpTrue odd; # max n
-
+
push 2; # max n 2
div; # max n/2 -> max n
jump start; # max n
-
+
label odd; # max n
push 3; # max n 3
mult; # max 3*n
push 1; # max 3*n 1
add; # max 3*n+1
-
+
label start; # max n
dup; # max n n
push 1; # max n n 1
neq; # max n n>1
jumpTrue loop; # max n
-
+
pop; # max
}
}} 1
@@ -3303,7 +3304,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel
endCatch
pop
-
+
beginCatch @badLabel2
push error
push testing
@@ -3316,7 +3317,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel2
endCatch
pop
-
+
beginCatch @badLabel3
push error
push testing
@@ -3329,7 +3330,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel3
endCatch
pop
-
+
beginCatch @badLabel4
push error
push testing
@@ -3342,7 +3343,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel4
endCatch
pop
-
+
beginCatch @badLabel5
push error
push testing
@@ -3355,7 +3356,7 @@ test assemble-52.1 {Bug 3154ea2759} {
label @okLabel5
endCatch
pop
-
+
beginCatch @badLabel6
push error
push testing
diff --git a/tests/assemble1.bench b/tests/assemble1.bench
index 18fd3a9..e294108 100644
--- a/tests/assemble1.bench
+++ b/tests/assemble1.bench
@@ -20,7 +20,7 @@ proc ulam2 {n} {
load n; # max
dup; # max n
jump start; # max n
-
+
label loop; # max n
over 1; # max n max
over 1; # max in max n
@@ -30,29 +30,29 @@ proc ulam2 {n} {
reverse 2; # n max
pop; # n
dup; # n n
-
+
label skip; # max n
dup; # max n n
push 2; # max n n 2
mod; # max n n%2
jumpTrue odd; # max n
-
+
push 2; # max n 2
div; # max n/2 -> max n
jump start; # max n
-
+
label odd; # max n
push 3; # max n 3
mult; # max 3*n
push 1; # max 3*n 1
add; # max 3*n+1
-
+
label start; # max n
dup; # max n n
push 1; # max n n 1
neq; # max n n>1
jumpTrue loop; # max n
-
+
pop; # max
}
}
@@ -60,12 +60,12 @@ set tcl_traceCompile 2; ulam2 1; set tcl_traceCompile 0
proc test1 {n} {
for {set i 1} {$i <= $n} {incr i} {
- ulam1 $i
+ ulam1 $i
}
}
proc test2 {n} {
for {set i 1} {$i <= $n} {incr i} {
- ulam2 $i
+ ulam2 $i
}
}
@@ -75,11 +75,10 @@ for {set j 0} {$j < 10} {incr j} {
test1 30000
set after [clock microseconds]
puts "compiled: [expr {1e-6 * ($after - $before)}]"
-
+
test2 1
set before [clock microseconds]
test2 30000
set after [clock microseconds]
puts "assembled: [expr {1e-6 * ($after - $before)}]"
}
- \ No newline at end of file
diff --git a/tests/async.test b/tests/async.test
index e7fc45a..34c2fdc 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -20,7 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testasync [llength [info commands testasync]]
-testConstraint threaded [::tcl::pkgconfig get threaded]
proc async1 {result code} {
global aresult acode
@@ -149,7 +148,7 @@ test async-3.1 {deleting handlers} testasync {
} {3 del2 {0 0 0 del1 del2}}
test async-4.1 {async interrupting bytecode sequence} -constraints {
- testasync threaded
+ testasync
} -setup {
set hm [testasync create async3]
proc nothing {} {
@@ -178,7 +177,7 @@ test async-4.1 {async interrupting bytecode sequence} -constraints {
testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
- testasync threaded
+ testasync
} -setup {
set hm [testasync create async3]
} -body {
@@ -203,7 +202,7 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
- testasync threaded
+ testasync
} -setup {
set hm [testasync create async3]
} -body {
diff --git a/tests/autoMkindex.test b/tests/autoMkindex.test
index 4721553..b42d50d 100644
--- a/tests/autoMkindex.test
+++ b/tests/autoMkindex.test
@@ -180,7 +180,7 @@ test autoMkindex-3.1 {slaveHook} -setup {
} -cleanup {
# Reset initCommands to avoid trashing other tests
AutoMkindexTestReset
-} -result 1
+} -result 1
# The auto_mkindex_parser::command is used to register commands that create
# new commands.
test autoMkindex-3.2 {auto_mkindex_parser::command} -setup {
diff --git a/tests/basic.test b/tests/basic.test
index 089a62b..1890042 100644
--- a/tests/basic.test
+++ b/tests/basic.test
@@ -256,7 +256,7 @@ test basic-18.1 {TclRenameCommand, name of existing cmd can have namespace quali
}
list [test_ns_basic::p] \
[rename test_ns_basic::p test_ns_basic::q] \
- [test_ns_basic::q]
+ [test_ns_basic::q]
} {{p in ::test_ns_basic} {} {p in ::test_ns_basic}}
test basic-18.2 {TclRenameCommand, existing cmd must be found} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -469,11 +469,11 @@ test basic-26.2 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
# a - the pure-list internal rep is destroyed by shimmering
# b - the command returns an error
# As the error code in Tcl_EvalObjv accesses the list elements, this will
- # cause a segfault if [Bug 1119369] has not been fixed.
+ # cause a segfault if [Bug 1119369] has not been fixed.
# NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
#
- set SRC [list foo 1] ;# pure-list command
+ set SRC [list foo 1] ;# pure-list command
proc foo str {
# Shimmer pure-list to cmdName, cleanup and error
proc $::SRC {} {}; $::SRC
@@ -491,11 +491,11 @@ test basic-26.3 {Tcl_EvalObjEx, pure-list branch: preserve "objv"} -body {
# Follow the pure-list branch in a manner that
# a - the pure-list internal rep is destroyed by shimmering
# b - the command accesses its command line
- # This will cause a segfault if [Bug 1119369] has not been fixed.
+ # This will cause a segfault if [Bug 1119369] has not been fixed.
# NOTE: a MEM_DEBUG build may be necessary to guarantee the segfault.
#
- set SRC [list foo 1] ;# pure-list command
+ set SRC [list foo 1] ;# pure-list command
proc foo str {
# Shimmer pure-list to cmdName, cleanup and error
proc $::SRC {} {}; $::SRC
@@ -607,7 +607,7 @@ test basic-46.2 {Tcl_AllowExceptions: exception return not allowed} -setup {
invoked "break" outside of a loop
while executing
"break"
- (file "*BREAKtest" line 3)}
+ (file "*BREAKtest" line 3)}
test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
set fName [makeFile {
@@ -624,7 +624,7 @@ test basic-46.3 {Tcl_AllowExceptions: exception return not allowed} -setup {
} -returnCodes error -match glob -result {invoked "break" outside of a loop
while executing
"break"
- (file "*BREAKtest" line 4)}
+ (file "*BREAKtest" line 4)}
test basic-46.4 {Tcl_AllowExceptions: exception return not allowed} -setup {
set fName [makeFile {
@@ -670,7 +670,7 @@ proc l3 {} {
}
# Do all tests once byte compiled and once with direct string evaluation
-for {set noComp 0} {$noComp <= 1} {incr noComp} {
+foreach noComp {0 1} {
if $noComp {
interp alias {} run {} testevalex
@@ -752,7 +752,7 @@ test basic-48.1.$noComp {expansion: parsing} $constraints {
# Another comment
list 1 2\
3 {*}$::l1
-
+
# Comment again
}
} {1 2 3 a {b b} c d}
@@ -825,7 +825,7 @@ test basic-48.13.$noComp {expansion: odd usage} $constraints {
test basic-48.14.$noComp {expansion: hash command} -setup {
catch {rename \# ""}
set cmd "#"
- } -constraints $constraints -body {
+ } -constraints $constraints -body {
run { {*}$cmd apa bepa }
} -cleanup {
unset cmd
@@ -885,7 +885,7 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup {
stress
set tmp $end
set end [getbytes]
- }
+ }
set leak [expr {$end - $tmp}]
} -cleanup {
unset end i tmp
@@ -893,21 +893,17 @@ test basic-48.16.$noComp {expansion: testing for leaks} -setup {
rename stress {}
} -result 0
-test basic-48.17.$noComp {expansion: object safety} -setup {
- set old_precision $::tcl_precision
- set ::tcl_precision 4
- } -constraints $constraints -body {
+test basic-48.17.$noComp {expansion: object safety} -constraints $constraints -body {
set third [expr {1.0/3.0}]
set l [list $third $third]
set x [run {list $third {*}$l $third}]
- set res [list]
+ set res [list]
foreach t $x {
lappend res [expr {$t * 3.0}]
}
set res
} -cleanup {
- set ::tcl_precision $old_precision
- unset old_precision res t l x third
+ unset res t l x third
} -result {1.0 1.0 1.0 1.0}
test basic-48.18.$noComp {expansion: list semantics} -constraints $constraints -body {
diff --git a/tests/binary.test b/tests/binary.test
index 8c1dedb..aede659 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -1647,22 +1647,6 @@ 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-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
- binary scan [binary format w [expr {wide(3) << 31}]] w x
- set x
-} 6442450944
-test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
- binary scan [binary format W [expr {wide(3) << 31}]] W x
- set x
-} 6442450944
test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
unset -nocomplain arg1
list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
@@ -1684,6 +1668,31 @@ test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
} {2 9223372036854775808 -9223372036854775808}
+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-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
+ binary scan [binary format w [expr {wide(3) << 31}]] w x
+ set x
+} 6442450944
+test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
+ binary scan [binary format W [expr {wide(3) << 31}]] W x
+ set x
+} 6442450944
+test binary-44.5 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
+ binary scan [binary format w [expr {(wide(3) << 31) + (wide(3) << 64)}]] w x
+ set x
+} 6442450944
+test binary-44.6 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
+ binary scan [binary format W [expr {(wide(3) << 31) + (wide(3) << 64)}]] W x
+ set x
+} 6442450944
+
test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
binary scan [binary format sws 16450 -1 19521] c* x
set x
@@ -2889,6 +2898,25 @@ test binary-76.2 {binary string appending growth algorithm} win {
# Append to it
string length [append str [binary format a* foo]]
} 3
+
+test binary-77.1 {string cat ops on all bytearrays} {
+ apply {{a b} {
+ return [binary format H* $a][binary format H* $b]
+ }} ab cd
+} [binary format H* abcd]
+test binary-77.2 {string cat ops on all bytearrays} {
+ apply {{a b} {
+ set one [binary format H* $a]
+ return $one[binary format H* $b]
+ }} ab cd
+} [binary format H* abcd]
+
+test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678]} -body {
+ # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX <= 4):
+ binary encode hex \U0001f415
+ binary scan \U0001f415 a* v; set v
+ set str {}
+} -result {}
# ----------------------------------------------------------------------
# cleanup
diff --git a/tests/case.test b/tests/case.test
index 6d63cea..d7558a9 100644
--- a/tests/case.test
+++ b/tests/case.test
@@ -11,6 +11,11 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+if {![llength [info commands case]]} {
+ # No "case" command? So no need to test
+ return
+}
+
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
diff --git a/tests/chan.test b/tests/chan.test
index d8390e2..6808453 100644
--- a/tests/chan.test
+++ b/tests/chan.test
@@ -135,7 +135,7 @@ test chan-16.4 {chan command: pending subcommand} -body {
chan pending {input output} stdout
} -returnCodes error -result "bad mode \"input output\": must be input or output"
test chan-16.5 {chan command: pending input subcommand} -body {
- chan pending input stdout
+ chan pending input stdout
} -result -1
test chan-16.6 {chan command: pending input subcommand} -body {
chan pending input stdin
@@ -194,7 +194,7 @@ test chan-16.9 {chan command: pending input subcommand} -setup {
set ::chan-16.9-data [list]
set ::chan-16.9-done 0
} -body {
- after idle chan-16.9-client
+ after idle chan-16.9-client
vwait ::chan-16.9-done
set ::chan-16.9-data
} -result {-1 0 0 1 36 -1 0 0 1 72 -1 0 0 1 108 -1 0 0 1 144 ABC 890} -cleanup {
diff --git a/tests/chanio.test b/tests/chanio.test
index 230d37c..9dc9e7c 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -36,7 +36,7 @@ namespace eval ::tcl::test::io {
set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}
package require tcltests
-
+
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel [llength [info commands testchannel]]
testConstraint openpipe 1
@@ -126,10 +126,10 @@ test chan-io-1.8 {Tcl_WriteChars: WriteChars} {
# Executing this test without the fix for the referenced bug applied to
# tcl will cause tcl, more specifically WriteChars, to go into an infinite
# loop.
- set f [open $path(test2) w]
- chan configure $f -encoding iso2022-jp
- chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
- chan close $f
+ set f [open $path(test2) w]
+ chan configure $f -encoding iso2022-jp
+ chan puts -nonewline $f [format %s%c [string repeat " " 4] 12399]
+ chan close $f
contents $path(test2)
} " \x1b\$B\$O\x1b(B"
test chan-io-1.9 {Tcl_WriteChars: WriteChars} {
@@ -244,7 +244,7 @@ test chan-io-3.3 {WriteChars: compatibility with WriteBytes: flush on line} -bod
test chan-io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
- chan configure $f -encoding jis0208 -buffersize 16
+ chan configure $f -encoding jis0208 -buffersize 16
chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
chan close $f
@@ -255,7 +255,7 @@ test chan-io-3.5 {WriteChars: saved != 0} {
# be moved to beginning of next channel buffer to preserve requested
# buffersize.
set f [open $path(test1) w]
- chan configure $f -encoding jis0208 -buffersize 17
+ chan configure $f -encoding jis0208 -buffersize 17
chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
chan close $f
@@ -284,7 +284,7 @@ test chan-io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# on flush. The truncated bytes are moved to the beginning of the next
# channel buffer.
set f [open $path(test1) w]
- chan configure $f -encoding jis0208 -buffersize 17
+ chan configure $f -encoding jis0208 -buffersize 17
chan puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
chan close $f
@@ -349,7 +349,7 @@ test chan-io-4.5 {TranslateOutputEOL: crlf} {
test chan-io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
- chan configure $f
+ chan configure $f
chan puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
chan close $f
@@ -437,7 +437,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test chan-io-6.6 {Tcl_GetsObj: loop test} -body {
- # if (dst >= dstEnd)
+ # if (dst >= dstEnd)
set f [open $path(test1) w]
chan puts $f $a
chan puts $f hi
@@ -746,7 +746,7 @@ test chan-io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} -body {
chan close $f
} -result [list 16 "123456789012345\r" 1]
test chan-io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} -body {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456789012345\rabcd\r\nefg"
@@ -856,7 +856,7 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
- lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+ lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "\nabcd\refg\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
@@ -867,14 +867,14 @@ test chan-io-6.43 {Tcl_GetsObj: input saw cr} -setup {
test chan-io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} -setup {
set x ""
} -constraints {stdio testchannel openpipe fileevent} -body {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto lf} -buffering none
chan puts -nonewline $f "bbbbbbbbbbbbbbb\n123456789abcdef\r"
chan configure $f -buffersize 16
lappend x [chan gets $f]
chan configure $f -blocking 0
- lappend x [chan gets $f line] $line [testchannel queuedcr $f]
+ lappend x [chan gets $f line] $line [testchannel queuedcr $f]
chan configure $f -blocking 1
chan puts -nonewline $f "abcd\refg\x1a"
lappend x [chan gets $f line] $line [testchannel queuedcr $f]
@@ -953,7 +953,7 @@ test chan-io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} -constraints {test
chan close $f
} -result {123456 0 8 78901}
test chan-io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} -constraints {testchannel} -body {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "123456\r78901"
@@ -1179,7 +1179,7 @@ test chan-io-8.5 {PeekAhead: don't peek if last read was short} -constraints {st
chan close $f
} -result {15 abcdefghijklmno 1}
test chan-io-8.6 {PeekAhead: change to non-blocking mode} -constraints {stdio testchannel openpipe fileevent} -body {
- # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [openpipe w+ $path(cat)]
chan configure $f -translation {auto binary} -buffersize 16
chan puts -nonewline $f "abcdefghijklmno\r"
@@ -1419,7 +1419,7 @@ test chan-io-13.2 {TranslateInputEOL: crlf mode} -body {
chan close $f
} -result "abcd\ndef\n"
test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\r"
@@ -1431,7 +1431,7 @@ test chan-io-13.3 {TranslateInputEOL: crlf mode: naked cr} -body {
chan close $f
} -result "abcd\ndef\r"
test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\rfgh"
@@ -1443,7 +1443,7 @@ test chan-io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} -body {
chan close $f
} -result "abcd\ndef\rfgh"
test chan-io-13.5 {TranslateInputEOL: crlf mode: naked lf} -body {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\r\ndef\nfgh"
@@ -1511,7 +1511,7 @@ test chan-io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} -body {
chan close $f
} -result "abcd\ndef"
test chan-io-13.10 {TranslateInputEOL: auto mode: \n} -body {
- # not (*src == '\r')
+ # not (*src == '\r')
set f [open $path(test1) w]
chan configure $f -translation lf
chan puts -nonewline $f "abcd\ndef"
@@ -3897,7 +3897,7 @@ test chan-io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} -setup {
}
chan close $f
set f [open $path(test1) r]
- chan configure $f -translation crlf
+ chan configure $f -translation crlf
while {[chan gets $f line] >= 0} {
append c $line\n
}
@@ -5159,7 +5159,7 @@ test chan-io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} -setup {
file delete $path(test1)
} -body {
set f [open $path(test1) w]
- chan configure $f -encoding {}
+ chan configure $f -encoding {}
chan puts -nonewline $f \xe7\x89\xa6
chan close $f
set f [open $path(test1) r]
@@ -5304,7 +5304,7 @@ test chan-io-39.23 {Tcl_GetChannelOption, server socket is not readable or\
test chan-io-39.24 {Tcl_SetChannelOption, server socket is not readable or\
writable so we can't change -eofchar or -translation} -setup {
set l [list]
-} -body {
+} -body {
set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
chan configure $sock -eofchar D -translation lf
lappend l [chan configure $sock -eofchar] \
@@ -5341,7 +5341,7 @@ test chan-io-40.2 {POSIX open access modes: CREAT} -setup {
lappend x [chan gets $f]
} -cleanup {
chan close $f
-} -result {0600 {line 1}}
+} -result {0o600 {line 1}}
test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
} -constraints {unix umask} -body {
@@ -5349,7 +5349,7 @@ test chan-io-40.3 {POSIX open access modes: CREAT} -setup {
chan close [open $path(test3) {WRONLY CREAT}]
file stat $path(test3) stats
format "%#o" [expr $stats(mode)&0o777]
-} -result [format %#4o [expr {0o666 & ~ $umaskValue}]]
+} -result [format %#5o [expr {0o666 & ~ $umaskValue}]]
test chan-io-40.4 {POSIX open access modes: CREAT} -setup {
file delete $path(test3)
} -body {
@@ -5457,7 +5457,7 @@ test chan-io-40.13 {POSIX open access modes: WRONLY} -body {
set x [list [catch {chan gets $f} msg] $msg]
chan close $f
lappend x [viewFile test3]
-} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
+} -match glob -result {1 {channel "*" wasn't opened for reading} abzzy}
test chan-io-40.14 {POSIX open access modes: RDWR} -match regexp -body {
file delete $path(test3)
open $path(test3) RDWR
@@ -5960,7 +5960,7 @@ test chan-io-48.3 {testing readability conditions} -setup {
chan close $f
} -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
unset path(bar)
-removeFile bar
+removeFile bar
test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
file delete $path(test1)
diff --git a/tests/cmdIL.test b/tests/cmdIL.test
index 68122dd..e4931a4 100644
--- a/tests/cmdIL.test
+++ b/tests/cmdIL.test
@@ -147,6 +147,18 @@ test cmdIL-1.36 {lsort -stride and -index: Bug 2918962} {
{{b i g} 12345} {{d e m o} 34512}
}
} {{{b i g} 12345} {{d e m o} 34512} {{c o d e} 54321} {{b l a h} 94729}}
+test cmdIL-1.37 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
+ lsort -ascii [list \0 \x7f \x80 \uffff]
+} [list \0 \x7f \x80 \uffff]
+test cmdIL-1.38 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
+ lsort -ascii -nocase [list \0 \x7f \x80 \uffff]
+} [list \0 \x7f \x80 \uffff]
+test cmdIL-1.39 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
+ lsort -ascii [list \0 \x7f \x80 \U01ffff \uffff]
+} [list \0 \x7f \x80 \uffff \U01ffff]
+test cmdIL-1.40 {Tcl_LsortObjCmd procedure, Bug 8e1e31eac0fd6b6c} {
+ lsort -ascii -nocase [list \0 \x7f \x80 \U01ffff \uffff]
+} [list \0 \x7f \x80 \uffff \U01ffff]
test cmdIL-1.41 {lsort -stride and -index} -body {
lsort -stride 2 -index -2 {a 2 b 1}
} -returnCodes error -result {index "-2" cannot select an element from any list}
@@ -220,7 +232,7 @@ test cmdIL-3.5.3 {SortCompare procedure, -index option (out of range, calculated
} -returnCodes error -result {index "-2" cannot select an element from any list}
test cmdIL-3.5.4 {SortCompare procedure, -index option (out of range, calculated index)} -body {
lsort -index end-4 {{1 . c} {2 . b} {3 . a}}
-} -returnCodes error -result {element -2 missing from sublist "1 . c"}
+} -returnCodes error -result {element end-4 missing from sublist "1 . c"}
test cmdIL-3.5.5 {SortCompare procedure, -index option} {
lsort -index {} {a b}
} {a b}
@@ -236,6 +248,9 @@ test cmdIL-3.5.8 {SortCompare procedure, -index option (out of range, calculated
test cmdIL-3.5.9 {SortCompare procedure, -index option (out of range, calculated index)} -body {
lsort -index end+2 {{1 . c} {2 . b} {3 . a}}
} -returnCodes error -result {index "end+2" cannot select an element from any list}
+test cmdIL-3.5.10 {SortCompare procedure, -index option (out of range, calculated index)} -body {
+ lsort -index 0 {{}}
+} -returnCodes error -result {element 0 missing from sublist ""}
test cmdIL-3.6 {SortCompare procedure, -index option} {
lsort -integer -index 2 {{1 15 30} {2 5 25} {3 25 20}}
} {{3 25 20} {2 5 25} {1 15 30}}
@@ -252,8 +267,8 @@ test cmdIL-3.10 {SortCompare procedure, -integer option} -body {
lsort -integer {3 q}
} -returnCodes error -result {expected integer but got "q"}
test cmdIL-3.11 {SortCompare procedure, -integer option} {
- lsort -integer {35 21 0x20 30 0o23 100 8}
-} {8 0o23 21 30 0x20 35 100}
+ lsort -integer {35 21 0x20 0d30 0o23 100 8}
+} {8 0o23 21 0d30 0x20 35 100}
test cmdIL-3.12 {SortCompare procedure, -real option} -body {
lsort -real {6...4 3}
} -returnCodes error -result {expected floating-point number but got "6...4"}
diff --git a/tests/cmdMZ.test b/tests/cmdMZ.test
index 2d68138..a5f3009 100644
--- a/tests/cmdMZ.test
+++ b/tests/cmdMZ.test
@@ -234,7 +234,7 @@ test cmdMZ-3.3 {Tcl_SourceObjCmd: error conditions} -constraints {
test cmdMZ-3.4 {Tcl_SourceObjCmd: error conditions} -constraints {
unixOrPc
} -returnCodes error -body {
- source a b
+ source a b c d e f
} -match glob -result {wrong # args: should be "source*fileName"}
test cmdMZ-3.5 {Tcl_SourceObjCmd: error in script} -body {
set file [makeFile {
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index bae26a0..e57f799 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -20,12 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
- testConstraint testmathfunctions 0
-} else {
- testConstraint testmathfunctions 1
-}
-
# Big test for correct ordering of data in [expr]
proc testIEEE {} {
@@ -84,8 +78,8 @@ proc testIEEE {} {
}
testConstraint ieeeFloatingPoint [testIEEE]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
# procedures used below
@@ -337,16 +331,9 @@ 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
-
-test compExpr-old-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
+test compExpr-old-9.5 {CompileRelationalExpr: large shift expr} {
expr {int(1<<63)}
-} -9223372036854775808
-test compExpr-old-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
- expr {int(1<<31)}
-} -2147483648
+} 9223372036854775808
test compExpr-old-9.6 {CompileRelationalExpr: error in shift expr} -body {
expr x>>3
@@ -602,22 +589,6 @@ test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body {
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
-test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr 2*T1()
-} 246
-test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr T2()*3
-} 1035
-test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr T3(21, 37)
-} 37
-test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr T3(21.2, 37)
-} 37.0
-test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr T3(-21.2, -17.5)
-} -17.5
-
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
diff --git a/tests/compExpr.test b/tests/compExpr.test
index 14c875d..3b44af8 100644
--- a/tests/compExpr.test
+++ b/tests/compExpr.test
@@ -16,12 +16,6 @@ if {"::tcltest" ni [namespace children]} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
- testConstraint testmathfunctions 0
-} else {
- testConstraint testmathfunctions 1
-}
-
# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]
@@ -319,12 +313,6 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
-test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr 3*T1()-1
-} 368
-test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions {
- expr T2()*3
-} 1035
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
expr {atan2(1.0)}
} -returnCodes error -match glob -result {too few arguments for math function*}
diff --git a/tests/compile.test b/tests/compile.test
index f021cf2..fb9a87a 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -122,7 +122,7 @@ test compile-3.4 {TclCompileCatchCmd: bcc'ed [return] is caught} {
proc foo {} {
set fail [catch {
return 1
- }] ; # {}
+ }] ; # {}
return 2
}
foo
@@ -132,8 +132,8 @@ test compile-3.5 {TclCompileCatchCmd: recover from error, [Bug 705406]} {
catch {
if {[a]} {
if b {}
- }
- }
+ }
+ }
}
list [catch foo msg] $msg
} {0 1}
@@ -344,13 +344,13 @@ test compile-11.9 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
list [catch {p} msg] $msg
} -returnCodes error -result {unmatched open brace in list}
-#
+#
# Special section for tests of tclLiteral.c
# The following tests check for incorrect memory handling in
# TclReleaseLiteral. They are only effective when tcl is compiled with
# TCL_MEM_DEBUG
#
-# Special test for leak on interp delete [Bug 467523].
+# Special test for leak on interp delete [Bug 467523].
test compile-12.1 {testing literal leak on interp delete} -setup {
proc getbytes {} {
set lines [split [memory info] "\n"]
@@ -359,10 +359,10 @@ test compile-12.1 {testing literal leak on interp delete} -setup {
} -constraints memory -body {
set end [getbytes]
for {set i 0} {$i < 5} {incr i} {
- interp create foo
- foo eval {
+ interp create foo
+ foo eval {
namespace eval bar {}
- }
+ }
interp delete foo
set tmp $end
set end [getbytes]
@@ -383,7 +383,7 @@ test compile-12.2 {testing error on literal deletion} -constraints {memory exec}
}
puts 0
} source.file]
- exec [interpreter] $sourceFile
+ exec [interpreter] $sourceFile
} -cleanup {
catch {removeFile $sourceFile}
} -result 0
@@ -476,7 +476,7 @@ test compile-14.1 {testing errors in element name; segfault?} {} {
test compile-14.2 {testing element name "$"} -body {
unset -nocomplain a
set a() 1
- set a(1) 2
+ set a(1) 2
set a($) 3
list [set a()] [set a(1)] [set a($)] [unset a() a(1); lindex [array names a] 0]
} -cleanup {unset a} -result [list 1 2 3 {$}]
@@ -499,7 +499,8 @@ test compile-15.5 {proper TCL_RETURN code from [return]} {
apply {{} {catch {set a 1}; return}}
} ""
-for {set noComp 0} {$noComp <= 1} {incr noComp} {
+# Do all tests once byte compiled and once with direct string evaluation
+foreach noComp {0 1} {
if $noComp {
interp alias {} run {} testevalex
diff --git a/tests/config.test b/tests/config.test
index d14837e..468a1df 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
test pkgconfig-1.1 {query keys} {
lsort [::tcl::pkgconfig list]
-} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
+} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
test pkgconfig-1.2 {query keys multiple times} {
string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 8a5494d..8217a92 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -66,7 +66,7 @@ test coroutine-1.3 {yield returns new arg} -setup {
incr i
}
}
- coroutine foo ::apply [list {{start 2} {stop 10}} $body]
+ coroutine foo ::apply [list {{start 2} {stop 10}} $body]
set res {}
} -body {
for {set k 1} {$k < 4} {incr k} {
@@ -476,7 +476,7 @@ test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels}
expr {[lindex [testnrelevels] 1] - 1}
}
proc relativeLevel base {
- # remove the level for this proc's call
+ # remove the level for this proc's call
expr {[getNumLevel] - $base - 1}
}
proc foo {} {
@@ -517,7 +517,7 @@ test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \
expr {[lindex [testnrelevels] 1] - 1}
}
proc relativeLevel base {
- # remove the level for this proc's call
+ # remove the level for this proc's call
expr {[getNumLevel] - $base - 1}
}
proc foo base {
@@ -588,7 +588,7 @@ test coroutine-7.2 {multi-argument yielding with yieldto} -body {
coroutine a corobody
coroutine b corobody
list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
- [b ok] [rename b {}]
+ [b ok] [rename b {}]
} -cleanup {
rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
diff --git a/tests/dict.test b/tests/dict.test
index a6b0cb4..904ec53 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -10,7 +10,7 @@
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -175,11 +175,7 @@ test dict-4.12 {dict replace command: canonicality is forced} {
} {a e c d}
test dict-4.13 {dict replace command: type check is mandatory} -body {
dict replace { a b c d e }
-} -returnCodes error -result {missing value to go with key}
-test dict-4.13a {dict replace command: type check is mandatory} {
- catch {dict replace { a b c d e }} -> opt
- dict get $opt -errorcode
-} {TCL VALUE DICTIONARY}
+} -errorCode {TCL VALUE DICTIONARY} -result {missing value to go with key}
test dict-4.14 {dict replace command: type check is mandatory} -body {
dict replace { a b {}c d }
} -returnCodes error -result {dict element in braces followed by "c" instead of space}
@@ -203,11 +199,7 @@ test dict-4.16a {dict replace command: type check is mandatory} {
} {TCL VALUE DICTIONARY QUOTE}
test dict-4.17 {dict replace command: type check is mandatory} -body {
dict replace " a b \{c d "
-} -returnCodes error -result {unmatched open brace in dict}
-test dict-4.17a {dict replace command: type check is mandatory} {
- catch {dict replace " a b \{c d "} -> opt
- dict get $opt -errorcode
-} {TCL VALUE DICTIONARY BRACE}
+} -errorCode {TCL VALUE DICTIONARY BRACE} -result {unmatched open brace in dict}
test dict-4.18 {dict replace command: canonicality forcing doesn't leak} {
set example { a b c d }
list $example [dict replace $example]
diff --git a/tests/encoding.test b/tests/encoding.test
index ed0e6a4..ab60617 100644
--- a/tests/encoding.test
+++ b/tests/encoding.test
@@ -34,9 +34,11 @@ proc runtests {} {
# Some tests require the testencoding command
testConstraint testencoding [llength [info commands testencoding]]
-testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
+testConstraint testbytestring [llength [info commands testbytestring]]
+testConstraint teststringbytes [llength [info commands teststringbytes]]
+testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint exec [llength [info commands exec]]
-testConstraint testgetdefenc [llength [info commands testgetdefenc]]
+testConstraint testgetencpath [llength [info commands testgetencpath]]
# TclInitEncodingSubsystem is tested by the rest of this file
# TclFinalizeEncodingSubsystem is not currently tested
@@ -308,37 +310,29 @@ test encoding-13.1 {LoadEscapeTable} {
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
-} "\x12\x34\x56\xc3\xbf\x69"
-
test encoding-15.1 {UtfToUtfProc} {
encoding convertto utf-8 \xa3
} "\xc2\xa3"
-test encoding-15.2 {UtfToUtfProc null character output} {
- set x \u0000
- set y [encoding convertto utf-8 \u0000]
- set y [encoding convertfrom identity $y]
- binary scan $y H* z
- list [string bytelength $x] [string bytelength $y] $z
-} {2 1 00}
-test encoding-15.3 {UtfToUtfProc null character input} {
- set x [encoding convertfrom identity \x00]
- set y [encoding convertfrom utf-8 $x]
- binary scan [encoding convertto identity $y] H* z
- list [string bytelength $x] [string bytelength $y] $z
-} {1 2 c080}
-
-test encoding-16.1 {UnicodeToUtfProc} {
+test encoding-15.2 {UtfToUtfProc null character output} testbytestring {
+ binary scan [testbytestring [encoding convertto utf-8 \u0000]] H* z
+ set z
+} 00
+test encoding-15.3 {UtfToUtfProc null character input} teststringbytes {
+ set y [encoding convertfrom utf-8 [encoding convertto utf-8 \u0000]]
+ binary scan [teststringbytes $y] H* z
+ set z
+} c080
+
+test encoding-16.1 {UnicodeToUtfProc} -constraints tip389 -body {
set val [encoding convertfrom unicode NN]
list $val [format %x [scan $val %c]]
-} "\u4e4e 4e4e"
-test encoding-16.2 {UnicodeToUtfProc} -constraints fullutf -body {
+} -result "\u4e4e 4e4e"
+test encoding-16.2 {UnicodeToUtfProc} -constraints tip389 -body {
set val [encoding convertfrom unicode "\xd8\xd8\xdc\xdc"]
list $val [format %x [scan $val %c]]
} -result "\U460dc 460dc"
-test encoding-17.1 {UtfToUnicodeProc} -constraints fullutf -body {
+test encoding-17.1 {UtfToUnicodeProc} -constraints tip389 -body {
encoding convertto unicode "\U460dc"
} -result "\xd8\xd8\xdc\xdc"
@@ -601,15 +595,15 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} {
}
}
-test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints {
- testgetdefenc
+test encoding-26.0 {Tcl_GetEncodingSearchPath} -constraints {
+ testgetencpath
} -setup {
- set origDir [testgetdefenc]
- testsetdefenc slappy
+ set origPath [testgetencpath]
+ testsetencpath slappy
} -body {
- testgetdefenc
+ testgetencpath
} -cleanup {
- testsetdefenc $origDir
+ testsetencpath $origPath
} -result slappy
file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout]
diff --git a/tests/env.test b/tests/env.test
index e6ce44d..79a353a 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -16,6 +16,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
namespace import -force ::tcltest::*
}
+loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests
# [exec] is required here to see the actual environment received by child
@@ -399,8 +401,8 @@ test env-8.0 {
# cleanup
-rename getenv {}
-rename envrestore {}
+rename getenv {}
+rename envrestore {}
rename envprep {}
rename encodingrestore {}
rename encodingswitch {}
diff --git a/tests/event.test b/tests/event.test
index 67a980b..5c111f8 100644
--- a/tests/event.test
+++ b/tests/event.test
@@ -595,16 +595,16 @@ test event-11.7 {Bug 16828b3744} {
test event-11.8 {Bug 16828b3744} -setup {
oo::class create A {
variable continue
-
+
method start {} {
after idle [self] destroy
-
+
set continue 0
vwait [namespace current]::continue
}
destructor {
set continue 1
- }
+ }
}
} -body {
[A new] start
diff --git a/tests/exec.test b/tests/exec.test
index 6570e57..4fd8b8d 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -17,6 +17,8 @@
package require tcltest 2
namespace import -force ::tcltest::*
+loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
package require tcltests
# All tests require the "exec" command.
@@ -703,9 +705,6 @@ test exec-20.1 {exec .CMD file} -constraints {win} -body {
exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
viewFile $log
} -result "\"Testing exec-20.1\""
-
-
-
# ----------------------------------------------------------------------
# cleanup
diff --git a/tests/execute.test b/tests/execute.test
index e1ed68b..3b62bc9 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -34,7 +34,7 @@ testConstraint testobj [expr {
&& [llength [info commands teststringobj]]
}]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint testexprlongobj [llength [info commands testexprlongobj]]
# Tests for the omnibus TclExecuteByteCode function:
@@ -698,7 +698,7 @@ test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
lappend result [e $e]
interp delete slave
interp create slave
- interp alias {} e slave expr
+ interp alias {} e slave expr
lappend result [e $e]
} -cleanup {
interp delete slave
@@ -805,9 +805,9 @@ test execute-7.7 {Wide int handling in INST_EQ and [incr]} {
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)}
+test execute-7.8 {Wide int conversions can change sign} {
+ set x 0x8000000000000000
+ expr {wide($x) < 0}
} 1
test execute-7.9 {Wide int handling in INST_MOD} {
expr {(wide(1)<<60) % ((wide(47)<<45)-1)}
@@ -887,12 +887,12 @@ test execute-7.31 {Wide int handling in abs()} {
set y 0x123456871234568
concat [expr {abs($x)}] [expr {abs($y)}]
} {730503879441204585 81985533099853160}
-test execute-7.32 {Wide int handling} longIs32bit {
+test execute-7.32 {Wide int handling} {
expr {int(1024 * 1024 * 1024 * 1024)}
-} 0
-test execute-7.33 {Wide int handling} longIs32bit {
+} 1099511627776
+test execute-7.33 {Wide int handling} {
expr {int(0x1 * 1024 * 1024 * 1024 * 1024)}
-} 0
+} 1099511627776
test execute-7.34 {Wide int handling} {
expr {wide(0x1) * 1024 * 1024 * 1024 * 1024}
} 1099511627776
@@ -1013,8 +1013,8 @@ test execute-10.3 {Bug 3072640} -setup {
yield $i
}
}
- proc t {args} {
- incr ::foo
+ proc t {args} {
+ incr ::foo
}
trace add execution ::generate enterstep ::t
} -body {
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 06a00ba..003ee00 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -22,13 +22,8 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testexprlong [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-
-if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
- testConstraint testmathfunctions 0
-} else {
- testConstraint testmathfunctions 1
-}
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
# Big test for correct ordering of data in [expr]
@@ -420,13 +415,13 @@ test expr-old-21.3 {parenthesization} {expr +(3-4)} -1
# Embedded commands and variable names.
-set a 16
-test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
+set a 16
+test expr-old-22.1 {embedded variables} {expr {2*$a}} 32
test expr-old-22.2 {embedded variables} {
set x -5
set y 10
expr {$x + $y}
-} {5}
+} {5}
test expr-old-22.3 {embedded variables} {
set x " -5"
set y " +10"
@@ -819,10 +814,10 @@ test expr-old-32.32 {math functions in expressions} {
} {-1}
test expr-old-32.33 {math functions in expressions} {
expr int(1e60)
-} 0
+} 999999999999999949387135297074018866963645011013410073083904
test expr-old-32.34 {math functions in expressions} {
expr int(-1e60)
-} 0
+} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.35 {math functions in expressions} {
expr round(1.49)
} {1}
@@ -847,12 +842,6 @@ test expr-old-32.41 {math functions in expressions} {
test expr-old-32.42 {math functions in expressions} {
list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
-test expr-old-32.43 {math functions in expressions} testmathfunctions {
- expr 2*T1()
-} 246
-test expr-old-32.44 {math functions in expressions} testmathfunctions {
- expr T2()*3
-} 1035
test expr-old-32.45 {math functions in expressions} {
expr (0 <= rand()) && (rand() < 1)
} {1}
@@ -952,11 +941,6 @@ test expr-old-34.15 {errors in math functions} {
test expr-old-34.16 {errors in math functions} {
expr round(-1.0e30)
} -1000000000000000019884624838656
-test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
- -body {
- list [catch {expr T1(4)} msg] $msg
- } -match glob -result {1 {too many arguments for math function*}}
-
test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
@@ -1052,8 +1036,8 @@ test expr-old-37.8 {Tcl_ExprLong handles overflows} testexprlong {
testexprlong -0x80000000
} {This is a result: -2147483648}
test expr-old-37.9 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
- testexprlong -0xffffffff
-} {This is a result: 1}
+ testexprlong -0x7fffffff
+} {This is a result: -2147483647}
test expr-old-37.10 {Tcl_ExprLong handles overflows} \
-constraints {testexprlong longIs32bit} \
-match glob \
@@ -1077,9 +1061,13 @@ test expr-old-37.13 {Tcl_ExprLong handles overflows} \
test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong {
testexprlong -2147483648.
} {This is a result: -2147483648}
-test expr-old-37.15 {Tcl_ExprLong handles overflows} {testexprlong longIs32bit} {
- testexprlong -4294967295.
-} {This is a result: 1}
+test expr-old-37.15 {Tcl_ExprLong handles overflows} \
+ -constraints {testexprlong longIs32bit} \
+ -match glob \
+ -body {
+ list [catch {testexprlong -2147483649.} result] $result
+ } \
+ -result {1 {integer value too large to represent*}}
test expr-old-37.16 {Tcl_ExprLong handles overflows} \
-constraints {testexprlong longIs32bit} \
-match glob \
@@ -1120,7 +1108,7 @@ test expr-old-37.25 {Tcl_ExprDouble and NaN} \
{ieeeFloatingPoint testexprdouble} {
list [catch {testexprdouble 0.0/0.0} result] $result
} {1 {domain error: argument not in valid range}}
-
+
test expr-old-38.1 {Verify Tcl_ExprString's basic operation} -constraints {testexprstring} -body {
list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \
[catch {testexprstring "1+"} msg] $msg
@@ -1159,8 +1147,8 @@ test expr-old-40.2 {min math function} -body {
expr {min(0.0)}
} -result 0.0
test expr-old-40.3 {min math function} -body {
- list [catch {expr {min()}} msg] $msg
-} -result {1 {too few arguments to math function "min"}}
+ expr {min()}
+} -returnCodes error -result {too few arguments for math function "min"}
test expr-old-40.4 {min math function} -body {
expr {min(wide(-1) << 30, 4.5, -10)}
} -result [expr {wide(-1) << 30}]
@@ -1170,6 +1158,12 @@ test expr-old-40.5 {min math function} -body {
test expr-old-40.6 {min math function} -body {
expr {min(300, "0xFF")}
} -result 255
+test expr-old-40.7 {min math function} -body {
+ expr min(1[string repeat 0 10000], 1e300)
+} -result 1e+300
+test expr-old-40.8 {min math function} -body {
+ expr {min(0, "a")}
+} -returnCodes error -match glob -result *
test expr-old-41.1 {max math function} -body {
expr {max(0)}
@@ -1178,8 +1172,8 @@ test expr-old-41.2 {max math function} -body {
expr {max(0.0)}
} -result 0.0
test expr-old-41.3 {max math function} -body {
- list [catch {expr {max()}} msg] $msg
-} -result {1 {too few arguments to math function "max"}}
+ expr {max()}
+} -returnCodes error -result {too few arguments for math function "max"}
test expr-old-41.4 {max math function} -body {
expr {max(wide(1) << 30, 4.5, -10)}
} -result [expr {wide(1) << 30}]
@@ -1189,6 +1183,12 @@ test expr-old-41.5 {max math function} -body {
test expr-old-41.6 {max math function} -body {
expr {max(200, "0xFF")}
} -result 255
+test expr-old-41.7 {max math function} -body {
+ expr max(1[string repeat 0 10000], 1e300)
+} -result 1[string repeat 0 10000]
+test expr-old-41.8 {max math function} -body {
+ expr {max(0, "a")}
+} -returnCodes error -match glob -result *
# Special test for Pentium arithmetic bug of 1994:
diff --git a/tests/expr.test b/tests/expr.test
index a265ac6..7136afc 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -18,17 +18,12 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-testConstraint testmathfunctions [expr {
- ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
-}]
-
# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit \
- [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
# Big test for correct ordering of data in [expr]
@@ -421,12 +416,9 @@ test expr-9.1 {CompileRelationalExpr: just shift expr} {expr 3<<2} 12
test expr-9.2 {CompileRelationalExpr: just shift expr} {expr 0xff>>2} 63
test expr-9.3 {CompileRelationalExpr: just shift expr} {expr -1>>2} -1
test expr-9.4 {CompileRelationalExpr: just shift expr} {expr {1<<3}} 8
-test expr-9.5a {CompileRelationalExpr: shift expr producing LONG_MIN} longIs64bit {
+test expr-9.5 {CompileRelationalExpr: shift expr producing LONG_MIN} {
expr {int(1<<63)}
-} -9223372036854775808
-test expr-9.5b {CompileRelationalExpr: shift expr producing LONG_MIN} longIs32bit {
- expr {int(1<<31)}
-} -2147483648
+} 9223372036854775808
test expr-9.6 {CompileRelationalExpr: error in shift expr} -body {
expr x>>3
} -returnCodes error -match glob -result *
@@ -685,41 +677,6 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} -body {
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
expr sin(1
} -returnCodes error -match glob -result *
-test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
- expr 2*T1()
-} 246
-test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
- expr T2()*3
-} 1035
-test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
- expr T3(21, 37)
-} 37
-test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
- expr T3(21.2, 37)
-} 37.0
-test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
- expr T3(-21.2, -17.5)
-} -17.5
-test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
- expr T3(21, wide(37))
-} 37
-test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
- expr T3(wide(21), 37)
-} 37
-test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
- expr T3(wide(21), wide(37))
-} 37
-test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
- expr T3(21.0, wide(37))
-} 37.0
-test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
- expr T3(wide(21), 37.0)
-} 37.0
-test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
- testmathfunctions
-} -body {
- expr T3(0,"a")
-} -returnCodes error -result {argument to math function didn't have numeric value}
test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
@@ -1438,14 +1395,14 @@ test expr-23.74.3 {INST_EXPON: Bug 2798543} {
expr {(-14)**17 == (-14)**65553}
} 0
-
+
# Some compilers get this wrong; ensure that we work around it correctly
test expr-24.1 {expr edge cases; shifting} {expr int(5)>>32} 0
test expr-24.2 {expr edge cases; shifting} {expr int(5)>>63} 0
test expr-24.3 {expr edge cases; shifting} {expr wide(5)>>32} 0
test expr-24.4 {expr edge cases; shifting} {expr wide(5)>>63} 0
-test expr-24.5 {expr edge cases; shifting} longIs32bit {expr int(5<<32)} 0
-test expr-24.6 {expr edge cases; shifting} longIs32bit {expr int(5<<63)} 0
+test expr-24.5 {expr edge cases; shifting} {expr int(5<<32)} 21474836480
+test expr-24.6 {expr edge cases; shifting} {expr int(5<<63)} 46116860184273879040
test expr-24.7 {expr edge cases; shifting} {expr wide(5)<<32} 21474836480
test expr-24.8 {expr edge cases; shifting} {expr wide(10<<63)} 0
test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0
@@ -5786,7 +5743,7 @@ test expr-32.1 {expr mod basics} {
0 1 0 3 3 \
0 -1 0 -1 -2 \
]
-
+
test expr-32.2 {expr div basics} {
set mod_nums [list \
{-3 1} {-3 2} {-3 3} {-3 4} {-3 5} \
@@ -5848,7 +5805,7 @@ test expr-32.9 {bignum regression} {
expr {0%-(1+(1<<63))}
} 0
-test expr-33.1 {parse largest long value} longIs32bit {
+test expr-33.1 {parse largest long value} {
set max_long_str 2147483647
set max_long_hex "0x7FFFFFFF "
@@ -5862,7 +5819,7 @@ test expr-33.1 {parse largest long value} longIs32bit {
[expr {$max_long + 0}] \
[expr {2147483647 + 0}] \
[expr {$max_long == $max_long_hex}] \
- [expr {int(2147483647 + 1) < 0}] \
+ [expr {int(2147483647 + 1) > 0}] \
} {2147483647 2147483647 2147483647 2147483647 1 1}
test expr-33.2 {parse smallest long value} longIs32bit {
@@ -5882,7 +5839,7 @@ test expr-33.2 {parse smallest long value} longIs32bit {
[expr {$min_long + 0}] \
[expr {-2147483648 + 0}] \
[expr {$min_long == $min_long_hex}] \
- [expr {int(-2147483648 - 1) == 0x7FFFFFFF}] \
+ [expr {int(-2147483648 - 1) == -0x80000001}] \
} {-2147483648 -2147483648 -2147483648 -2147483648 1 1}
test expr-33.3 {parse largest wide value} wideIs64bit {
@@ -5962,17 +5919,17 @@ test expr-34.11 {expr edge cases} {
test expr-34.12 {expr edge cases} {
expr {$min % -2}
} {0}
-test expr-34.13 {expr edge cases} longIs32bit {
+test expr-34.13 {expr edge cases} {
expr {int($min / -1)}
-} {-2147483648}
+} {2147483648}
test expr-34.14 {expr edge cases} {
expr {$min % -1}
} {0}
-test expr-34.15 {expr edge cases} longIs32bit {
- expr {int($min * -1)}
+test expr-34.15 {expr edge cases} {
+ expr {-int($min * -1)}
} $min
-test expr-34.16 {expr edge cases} longIs32bit {
- expr {int(-$min)}
+test expr-34.16 {expr edge cases} {
+ expr {-int(-$min)}
} $min
test expr-34.17 {expr edge cases} {
expr {$min / 1}
@@ -6759,8 +6716,8 @@ test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj {
testexprlongobj -0x80000000
} {This is a result: -2147483648}
test expr-39.9 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
- testexprlongobj -0xffffffff
-} {This is a result: 1}
+ testexprlongobj -0x7fffffff
+} {This is a result: -2147483647}
test expr-39.10 {Tcl_ExprLongObj handles overflows} \
-constraints {testexprlongobj longIs32bit} \
-match glob \
@@ -6785,8 +6742,8 @@ test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj {
testexprlongobj -2147483648.
} {This is a result: -2147483648}
test expr-39.15 {Tcl_ExprLongObj handles overflows} {testexprlongobj longIs32bit} {
- testexprlongobj -4294967295.
-} {This is a result: 1}
+ testexprlongobj -2147483648.
+} {This is a result: -2147483648}
test expr-39.16 {Tcl_ExprLongObj handles overflows} \
-constraints {testexprlongobj longIs32bit} \
-match glob \
@@ -6794,7 +6751,7 @@ test expr-39.16 {Tcl_ExprLongObj handles overflows} \
list [catch {testexprlongobj 4294967296.} result] $result
} \
-result {1 {integer value too large to represent*}}
-
+
test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj {
testexprdoubleobj 4.+1.
} {This is a result: 5.0}
@@ -7203,7 +7160,7 @@ test expr-52.1 {
list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [
string match {*no string representation*} [
::tcl::unsupported::representation $a]]
-} {0 0 1 1}
+} {0 0 1 1}
diff --git a/tests/fCmd.test b/tests/fCmd.test
index 11ab79e..a6e90a1 100644
--- a/tests/fCmd.test
+++ b/tests/fCmd.test
@@ -23,7 +23,7 @@ cd [temporaryDirectory]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
-testConstraint win2000orXP 0
+testConstraint winXP 0
# Don't know how to determine this constraint correctly
testConstraint notNetworkFilesystem 0
testConstraint reg 0
@@ -65,12 +65,10 @@ if {[testConstraint unix]} {
# Also used in winFCmd...
if {[testConstraint win]} {
- if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
- if {$::tcl_platform(osVersion) >= 6.0} {
- testConstraint winVista 1
- } else {
- testConstraint win2000orXP 1
- }
+ if {$::tcl_platform(osVersion) >= 5.0} {
+ testConstraint winVista 1
+ } else {
+ testConstraint winXP 1
}
}
@@ -791,7 +789,7 @@ test fCmd-9.3 {file rename: comprehensive: file to new name} -setup {
} -result {{tf3 tf4} 1 0}
test fCmd-9.4.a {file rename: comprehensive: dir to new name} -setup {
cleanup
-} -constraints {win win2000orXP testchmod} -body {
+} -constraints {win winXP testchmod} -body {
file mkdir td1 td2
testchmod 0o555 td2
file rename td1 td3
@@ -823,7 +821,7 @@ test fCmd-9.5 {file rename: comprehensive: file to self} -setup {
} -result {tf1 tf2 1 0}
test fCmd-9.6.a {file rename: comprehensive: dir to self} -setup {
cleanup
-} -constraints {win win2000orXP testchmod} -body {
+} -constraints {win winXP testchmod} -body {
file mkdir td1
file mkdir td2
testchmod 0o555 td2
diff --git a/tests/fileSystem.test b/tests/fileSystem.test
index f778112..2494cb4 100644
--- a/tests/fileSystem.test
+++ b/tests/fileSystem.test
@@ -146,7 +146,7 @@ test filesystem-1.10 {link normalisation: double link} -constraints {
[file normalize [file join dir2.link inside.file foo]]
} -cleanup {
file delete dir2.link
-} -result ok
+} -result ok
makeDirectory dir2.file
test filesystem-1.11 {link normalisation: double link, back in tree} {unix hasLinks} {
file link dir2.link dir.link
@@ -906,7 +906,7 @@ test filesystem-9.5 {path objects and file tail and object rep} -setup {
}
return $res
} -cleanup {
- file delete -force dgp
+ file delete -force dgp
cd $origdir
} -result {test test}
test filesystem-9.6 {path objects and file tail and object rep} win {
diff --git a/tests/for.test b/tests/for.test
index 1a65274..c8a8187 100644
--- a/tests/for.test
+++ b/tests/for.test
@@ -303,35 +303,35 @@ proc formatMail {} {
16 {This page contains information about Tcl 7.6 and Tk4.2, which are the most recent} \
17 {releases of the Tcl scripting language and the Tk toolkit. The first beta versions of these} \
18 {releases were released on August 30, 1996. These releases contain only minor changes,} \
- 19 {so we hope to have only a single beta release and to go final in early October, 1996. } \
+ 19 {so we hope to have only a single beta release and to go final in early October, 1996.} \
20 {} \
21 {} \
- 22 {What's new } \
+ 22 {What's new} \
23 {} \
24 {The most important changes in the releases are summarized below. See the README} \
25 {and changes files in the distributions for more complete information on what has} \
- 26 {changed, including both feature changes and bug fixes. } \
+ 26 {changed, including both feature changes and bug fixes.} \
27 {} \
28 { There are new options to the file command for copying files (file copy),} \
29 { deleting files and directories (file delete), creating directories (file} \
- 30 { mkdir), and renaming files (file rename). } \
+ 30 { mkdir), and renaming files (file rename).} \
31 { The implementation of exec has been improved greatly for Windows 95 and} \
- 32 { Windows NT. } \
+ 32 { Windows NT.} \
33 { There is a new memory allocator for the Macintosh version, which should be} \
- 34 { more efficient than the old one. } \
+ 34 { more efficient than the old one.} \
35 { Tk's grid geometry manager has been completely rewritten. The layout} \
36 { algorithm produces much better layouts than before, especially where rows or} \
- 37 { columns were stretchable. } \
+ 37 { columns were stretchable.} \
38 { There are new commands for creating common dialog boxes:} \
39 { tk_chooseColor, tk_getOpenFile, tk_getSaveFile and} \
- 40 { tk_messageBox. These use native dialog boxes if they are available. } \
+ 40 { tk_messageBox. These use native dialog boxes if they are available.} \
41 { There is a new virtual event mechanism for handling events in a more portable} \
42 { way. See the new command event. It also allows events (both physical and} \
- 43 { virtual) to be generated dynamically. } \
+ 43 { virtual) to be generated dynamically.} \
44 {} \
45 {Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl 7.5 and Tk 4.1 except for} \
46 {changes in the C APIs for custom channel drivers. Scripts written for earlier releases} \
- 47 {should work on these new releases as well. } \
+ 47 {should work on these new releases as well.} \
48 {} \
49 {Obtaining The Releases} \
50 {} \
@@ -342,7 +342,7 @@ proc formatMail {} {
55 { Windows 3.1, Windows 95, and Windows NT: Fetch} \
56 { ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then execute it. The file is a} \
57 { self-extracting executable. It will install the Tcl and Tk libraries, the wish and} \
- 58 { tclsh programs, and documentation. } \
+ 58 { tclsh programs, and documentation.} \
59 { Macintosh (both 68K and PowerPC): Fetch} \
60 { ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx. The file is in binhex format,} \
61 { which is understood by Fetch, StuffIt, and many other Mac utilities. The} \
@@ -451,7 +451,7 @@ proc formatMail {} {
set c [string length $line]
}
}
- set newline [string range $line 0 $c]
+ set newline [string trimright [string range $line 0 $c]]
if {! $continuation} {
append result $newline $NL
} else {
@@ -507,76 +507,76 @@ releases of the Tcl scripting language and the Tk toolk
it. The first beta versions of these
releases were released on August 30, 1996. These releas
es contain only minor changes,
-so we hope to have only a single beta release and to
+so we hope to have only a single beta release and to
go final in early October, 1996.
-What's new
+What's new
The most important changes in the releases are summariz
ed below. See the README
and changes files in the distributions for more complet
e information on what has
-changed, including both feature changes and bug fixes.
+changed, including both feature changes and bug fixes.
- There are new options to the file command for
+ There are new options to the file command for
copying files (file copy),
- deleting files and directories (file delete),
+ deleting files and directories (file delete),
creating directories (file
- mkdir), and renaming files (file rename).
+ mkdir), and renaming files (file rename).
The implementation of exec has been improved great
ly for Windows 95 and
- Windows NT.
- There is a new memory allocator for the Macintosh
+ Windows NT.
+ There is a new memory allocator for the Macintosh
version, which should be
- more efficient than the old one.
- Tk's grid geometry manager has been completely
+ more efficient than the old one.
+ Tk's grid geometry manager has been completely
rewritten. The layout
algorithm produces much better layouts than before
, especially where rows or
- columns were stretchable.
- There are new commands for creating common dialog
+ columns were stretchable.
+ There are new commands for creating common dialog
boxes:
tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
- tk_messageBox. These use native dialog boxes if
+ tk_messageBox. These use native dialog boxes if
they are available.
There is a new virtual event mechanism for handlin
g events in a more portable
- way. See the new command event. It also allows
+ way. See the new command event. It also allows
events (both physical and
- virtual) to be generated dynamically.
+ virtual) to be generated dynamically.
-Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
+Tcl 7.6 and Tk 4.2 are backwards-compatible with Tcl
7.5 and Tk 4.1 except for
changes in the C APIs for custom channel drivers. Scrip
ts written for earlier releases
-should work on these new releases as well.
+should work on these new releases as well.
Obtaining The Releases
Binary Releases
-Pre-compiled releases are available for the following
+Pre-compiled releases are available for the following
platforms:
Windows 3.1, Windows 95, and Windows NT: Fetch
- ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
+ ftp://ftp.sunlabs.com/pub/tcl/win42b1.exe, then
execute it. The file is a
- self-extracting executable. It will install the
+ self-extracting executable. It will install the
Tcl and Tk libraries, the wish and
- tclsh programs, and documentation.
+ tclsh programs, and documentation.
Macintosh (both 68K and PowerPC): Fetch
- ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
+ ftp://ftp.sunlabs.com/pub/tcl/mactk4.2b1.sea.hqx.
The file is in binhex format,
- which is understood by Fetch, StuffIt, and many
+ which is understood by Fetch, StuffIt, and many
other Mac utilities. The
- unpacked file is a self-installing executable:
+ unpacked file is a self-installing executable:
double-click on it and it will create a
- folder containing all that you need to run Tcl
+ folder containing all that you need to run Tcl
and Tk.
- UNIX (Solaris 2.* and SunOS, other systems
+ UNIX (Solaris 2.* and SunOS, other systems
soon to follow). Easy to install
- binary packages are now for sale at the Sun Labs
+ binary packages are now for sale at the Sun Labs
Tcl/Tk Shop. Check it out!
}
diff --git a/tests/format.test b/tests/format.test
index 88013cf..1bf46a1 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -16,18 +16,17 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
}
# %u output depends on word length, so this test is not portable.
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit \
- [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
-testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
+testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
test format-1.1 {integer formatting} {
format "%*d %d %d %d" 6 34 16923 -12 -1
} { 34 16923 -12 -1}
test format-1.2 {integer formatting} {
format "%4d %4d %4d %4d %d %#x %#X" 6 34 16923 -12 -1 14 12
-} { 6 34 16923 -12 -1 0xe 0XC}
+} { 6 34 16923 -12 -1 0xe 0xC}
test format-1.3 {integer formatting} longIs32bit {
format "%4u %4u %4u %4u %d %#o" 6 34 16923 -12 -1 0
} { 6 34 16923 4294967284 -1 0}
@@ -53,49 +52,40 @@ test format-1.7.1 {integer formatting} longIs64bit {
} { 6 22 421b fffffffffffffff4}
test format-1.8 {integer formatting} longIs32bit {
format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0X22 0X421B 0xfffffff4}
+} {0 0x6 0x22 0x421B 0xfffffff4}
test format-1.8.1 {integer formatting} longIs64bit {
format "%#x %#x %#X %#X %#x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0X22 0X421B 0xfffffffffffffff4}
+} {0 0x6 0x22 0x421B 0xfffffffffffffff4}
test format-1.9 {integer formatting} longIs32bit {
format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
-} { 0x0 0x6 0x22 0x421b 0xfffffff4}
+} { 0 0x6 0x22 0x421b 0xfffffff4}
test format-1.9.1 {integer formatting} longIs64bit {
format "%#5x %#20x %#20x %#20x %#20x" 0 6 34 16923 -12 -1
-} { 0x0 0x6 0x22 0x421b 0xfffffffffffffff4}
+} { 0 0x6 0x22 0x421b 0xfffffffffffffff4}
test format-1.10 {integer formatting} longIs32bit {
format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0x22 0x421b 0xfffffff4 }
+} {0 0x6 0x22 0x421b 0xfffffff4 }
test format-1.10.1 {integer formatting} longIs64bit {
format "%-#5x %-#20x %-#20x %-#20x %-#20x" 0 6 34 16923 -12 -1
-} {0x0 0x6 0x22 0x421b 0xfffffffffffffff4 }
+} {0 0x6 0x22 0x421b 0xfffffffffffffff4 }
test format-1.11 {integer formatting} longIs32bit {
format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
-} {0 06 042 041033 037777777764 }
+} {0 0o6 0o42 0o41033 0o37777777764 }
test format-1.11.1 {integer formatting} longIs64bit {
format "%-#5o %-#20o %#-20o %#-20o %#-20o" 0 6 34 16923 -12 -1
-} {0 06 042 041033 01777777777777777777764}
+} {0 0o6 0o42 0o41033 0o1777777777777777777764}
test format-1.12 {integer formatting} {
format "%b %#b %#b %llb" 5 0 5 [expr {2**100}]
-} {101 0b0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
-test format-1.13 {integer formatting} longIs32bit {
- format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12}
-test format-1.13.1 {integer formatting} longIs64bit {
- format "%#d %#d %#d %#d %#d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12}
-test format-1.14 {integer formatting} longIs32bit {
- format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
-} { 0 6 34 16923 -12}
-test format-1.14.1 {integer formatting} longIs64bit {
- format "%#5d %#20d %#20d %#20d %#20d" 0 6 34 16923 -12 -1
-} { 0 6 34 16923 -12}
-test format-1.15 {integer formatting} longIs32bit {
- format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12 }
-test format-1.15.1 {integer formatting} longIs64bit {
- format "%-#5d %-#20d %-#20d %-#20d %-#20d" 0 6 34 16923 -12 -1
-} {0 6 34 16923 -12 }
+} {101 0 0b101 10000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000}
+test format-1.13 {integer formatting} {
+ format "%#0d %#0d %#0d %#0d %#0d" 0 6 34 16923 -12 -1
+} {0 0d6 0d34 0d16923 -0d12}
+test format-1.14 {integer formatting} {
+ format "%#05d %#020d %#020d %#020d %#020d" 0 6 34 16923 -12 -1
+} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012}
+test format-1.15 {integer formatting} {
+ format "%-#05d %-#020d %-#020d %-#020d %-#020d" 0 6 34 16923 -12 -1
+} {00000 0d000000000000000006 0d000000000000000034 0d000000000000016923 -0d00000000000000012}
test format-2.1 {string formatting} {
@@ -368,9 +358,9 @@ test format-8.19 {error conditions} {
catch {format %q x}
} 1
test format-8.20 {error conditions} {
- catch {format %q x} msg
+ catch {format %r x} msg
set msg
-} {bad field specifier "q"}
+} {bad field specifier "r"}
test format-8.21 {error conditions} {
catch {format %d}
} 1
@@ -382,6 +372,26 @@ test format-8.23 {error conditions} {
catch {format "%d %d" 24 xyz} msg
set msg
} {expected integer but got "xyz"}
+# Since "%zd" and "%td" are equivalent to "%lld" in 64-bit platforms and
+# equivalent to "%d" in 32-bit platforms, they are really not useful in
+# scripts, therefore they are not documented. It's intended use is through
+# the function Tcl_AppendPrintfToObj (et al).
+test format-8.24 {Undocumented formats} -body {
+ format "%zd %td %d" [expr 2**30] [expr 2**30] [expr 2**30]
+} -result {1073741824 1073741824 1073741824}
+test format-8.25 {Undocumented formats} -constraints pointerIs64bit -body {
+ format "%zd %td %lld" [expr 2**33] [expr 2**33] [expr 2**33]
+} -result {8589934592 8589934592 8589934592}
+# Since "%p" is equivalent to "%#llx" in 64-bit platforms and equivalent
+# to "%#x" in 32-bit platforms, it are really not useful in scripts,
+# therefore they are not documented. It's intended use is through the
+# function Tcl_AppendPrintfToObj (et al).
+test format-8.26 {Undocumented formats} -body {
+ format "%p %#x" [expr 2**31] [expr 2**31]
+} -result {0x80000000 0x80000000}
+test format-8.27 {Undocumented formats} -constraints pointerIs64bit -body {
+ format "%p %#llx" [expr 2**33] [expr 2**33]
+} -result {0x200000000 0x200000000}
test format-9.1 {long result} {
set a {1234567890abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1 2 3 4 5 6 7 8 9 0 a b c d e f g h i j k l m n o p q r s t u v w x y z A B C D E F G H I J K L M N O P Q R S T U V W X Y Z}
@@ -535,7 +545,7 @@ for {set i 290} {$i < 400} {incr i} {
append b "x"
}
-test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
+test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
format %d 7810179016327718216
} 1819043144
test format-17.2 {testing %ld with wide} {wideIs64bit} {
@@ -549,7 +559,7 @@ test format-17.4 {testing %l with non-integer} {
} 1.000000
test format-17.5 {testing %llu with positive bignum} -body {
format %llu 0xabcdef0123456789abcdef
-} -returnCodes 1 -result {unsigned bignum format is invalid}
+} -result 207698809136909011942886895
test format-17.6 {testing %llu with negative number} -body {
format %llu -1
} -returnCodes 1 -result {unsigned bignum format is invalid}
@@ -568,7 +578,7 @@ test format-18.1 {do not demote existing numeric values} {
format %08x $b
lappend result [expr {$a == $b}]
} {1 1 1 1}
-test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
+test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} {
set a [expr {0xaaaaaaaaaa + 1}]
set b 0xaaaaaaaaab
list [format %08x $a] [expr {$a == $b}]
diff --git a/tests/get.test b/tests/get.test
index 7aa06c1..e35b2cc 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -20,8 +20,8 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
test get-1.1 {Tcl_GetInt procedure} testgetint {
testgetint 44 { 22}
@@ -45,14 +45,14 @@ test get-1.7 {Tcl_GetInt procedure} {testgetint longIs64bit} {
list [catch {testgetint 44 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} {testgetint longIs64bit} {
- list [catch {testgetint 18446744073709551614} msg] $msg
-} {0 -2}
+ testgetint 18446744073709551614
+} {-2}
test get-1.9 {Tcl_GetInt procedure} {testgetint longIs64bit} {
- list [catch {testgetint +18446744073709551614} msg] $msg
-} {0 -2}
+ testgetint +18446744073709551614
+} {-2}
test get-1.10 {Tcl_GetInt procedure} {testgetint longIs64bit} {
- list [catch {testgetint -18446744073709551614} msg] $msg
-} {0 2}
+ list [catch {testgetint -18446744073709551614} msg] $msg $errorCode
+} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
test get-1.11 {Tcl_GetInt procedure} {testgetint longIs32bit} {
list [catch {testgetint 44 4294967296} msg] $msg $errorCode
} {1 {integer value too large to represent} {ARITH IOVERFLOW {integer value too large to represent}}}
@@ -64,7 +64,7 @@ test get-1.13 {Tcl_GetInt procedure} {testgetint longIs32bit} {
} {0 -2}
test get-1.14 {Tcl_GetInt procedure} {testgetint longIs32bit} {
list [catch {testgetint -4294967294} msg] $msg
-} {0 2}
+} {1 {integer value too large to represent}}
test get-2.1 {Tcl_GetInt procedure} {
format %g 1.23
@@ -98,17 +98,17 @@ test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} {
} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
# Bug 7114ac6141
test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
- lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} {
+ lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} {
catch {testgetint 44 $x} x
set x
}
-} {44 44 44 44 54 52 52 46}
+} {44 44 44 44 54 51 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
- lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} {
+ lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} {
catch {testdoubleobj set 1 $x} x
set x
}
-} {0.0 0.0 0.0 0.0 0.0 {expected floating-point number but got "09" (looks like invalid octal number)} {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
+} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/history.test b/tests/history.test
index 3201ad7..9ff41f2 100644
--- a/tests/history.test
+++ b/tests/history.test
@@ -10,7 +10,7 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
+
if {"::tcltest" ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
diff --git a/tests/http.test b/tests/http.test
index 242dceb..cf30348 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -43,7 +43,6 @@ if {$::tcl_platform(os) eq "Darwin"} {
set HOST [info hostname]
}
-set port 8010
set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
catch {unset data}
@@ -62,9 +61,8 @@ catch {package require Thread 2.7-}
if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
set httpthread [thread::create -preserved]
thread::send $httpthread [list source $httpdFile]
- thread::send $httpthread [list set port $port]
thread::send $httpthread [list set bindata $bindata]
- thread::send $httpthread {httpd_init $port}
+ thread::send $httpthread {httpd_init 0; set port} port
puts "Running httpd in thread $httpthread"
} else {
if {![file exists $httpdFile]} {
@@ -76,17 +74,15 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
# 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
+ catch {unset port}
return
- } else {
- set port [lindex [fconfigure $listen -sockname] 2]
}
}
test http-1.1 {http::config} {
http::config -useragent UserAgent
http::config
-} [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
+} [list -accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
test http-1.2 {http::config} {
http::config -proxyfilter
} http::ProxyRequired
@@ -101,10 +97,10 @@ test http-1.4 {http::config} {
set x [http::config]
http::config {*}$savedconf
set x
-} {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
+} {-accept */* -cookiejar {} -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
test http-1.5 {http::config} -returnCodes error -body {
http::config -proxyhost {} -junk 8080
-} -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
+} -result {Unknown option -junk, must be: -accept, -cookiejar, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
test http-1.6 {http::config} -setup {
set oldenc [http::config -urlencoding]
} -body {
@@ -674,6 +670,451 @@ test http-7.4 {http::formatQuery} -setup {
http::config -urlencoding $enc
} -result {%3F}
+package require -exact tcl::idna 1.0
+
+test http-idna-1.1 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna
+} -result {wrong # args: should be "::tcl::idna subcommand ?arg ...?"}
+test http-idna-1.2 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna ?
+} -result {unknown or ambiguous subcommand "?": must be decode, encode, puny, or version}
+test http-idna-1.3 {IDNA package: basics} -body {
+ ::tcl::idna version
+} -result 1.0
+test http-idna-1.4 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna version what
+} -result {wrong # args: should be "::tcl::idna version"}
+test http-idna-1.5 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna puny
+} -result {wrong # args: should be "::tcl::idna puny subcommand ?arg ...?"}
+test http-idna-1.6 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna puny ?
+} -result {unknown or ambiguous subcommand "?": must be decode, or encode}
+test http-idna-1.7 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna puny encode
+} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
+test http-idna-1.8 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna puny encode a b c
+} -result {wrong # args: should be "::tcl::idna puny encode string ?case?"}
+test http-idna-1.9 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna puny decode
+} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
+test http-idna-1.10 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna puny decode a b c
+} -result {wrong # args: should be "::tcl::idna puny decode string ?case?"}
+test http-idna-1.11 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna decode
+} -result {wrong # args: should be "::tcl::idna decode hostname"}
+test http-idna-1.12 {IDNA package: basics} -returnCodes error -body {
+ ::tcl::idna encode
+} -result {wrong # args: should be "::tcl::idna encode hostname"}
+
+test http-idna-2.1 {puny encode: functional test} {
+ ::tcl::idna puny encode abc
+} abc-
+test http-idna-2.2 {puny encode: functional test} {
+ ::tcl::idna puny encode a\u20acb\u20acc
+} abc-k50ab
+test http-idna-2.3 {puny encode: functional test} {
+ ::tcl::idna puny encode ABC
+} ABC-
+test http-idna-2.4 {puny encode: functional test} {
+ ::tcl::idna puny encode A\u20ACB\u20ACC
+} ABC-k50ab
+test http-idna-2.5 {puny encode: functional test} {
+ ::tcl::idna puny encode ABC 0
+} abc-
+test http-idna-2.6 {puny encode: functional test} {
+ ::tcl::idna puny encode A\u20ACB\u20ACC 0
+} abc-k50ab
+test http-idna-2.7 {puny encode: functional test} {
+ ::tcl::idna puny encode ABC 1
+} ABC-
+test http-idna-2.8 {puny encode: functional test} {
+ ::tcl::idna puny encode A\u20ACB\u20ACC 1
+} ABC-k50ab
+test http-idna-2.9 {puny encode: functional test} {
+ ::tcl::idna puny encode abc 0
+} abc-
+test http-idna-2.10 {puny encode: functional test} {
+ ::tcl::idna puny encode a\u20ACb\u20ACc 0
+} abc-k50ab
+test http-idna-2.11 {puny encode: functional test} {
+ ::tcl::idna puny encode abc 1
+} ABC-
+test http-idna-2.12 {puny encode: functional test} {
+ ::tcl::idna puny encode a\u20ACb\u20ACc 1
+} ABC-k50ab
+test http-idna-2.13 {puny encode: edge cases} {
+ ::tcl::idna puny encode ""
+} ""
+test http-idna-2.14-A {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
+ u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
+ }]] ""]
+} egbpdaj6bu4bxfgehfvwxn
+test http-idna-2.14-B {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587
+ }]] ""]
+} ihqwcrb4cv8a8dqg056pqjye
+test http-idna-2.14-C {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587
+ }]] ""]
+} ihqwctvzc91f659drss3x8bo0yb
+test http-idna-2.14-D {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
+ u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
+ u+0065 u+0073 u+006B u+0079
+ }]] ""]
+} Proprostnemluvesky-uyb24dma41a
+test http-idna-2.14-E {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
+ u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
+ u+05D1 u+05E8 u+05D9 u+05EA
+ }]] ""]
+} 4dbcagdahymbxekheh6e0a7fei0b
+test http-idna-2.14-F {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
+ u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
+ u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
+ u+0939 u+0948 u+0902
+ }]] ""]
+} i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd
+test http-idna-2.14-G {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
+ u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
+ }]] ""]
+} n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa
+test http-idna-2.14-H {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
+ u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
+ u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
+ }]] ""]
+} 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c
+test http-idna-2.14-I {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
+ u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
+ u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
+ u+0438
+ }]] ""]
+} b1abfaaepdrnnbgefbadotcwatmq2g4l
+test http-idna-2.14-J {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
+ u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
+ u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
+ u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
+ u+0061 u+00F1 u+006F u+006C
+ }]] ""]
+} PorqunopuedensimplementehablarenEspaol-fmd56a
+test http-idna-2.14-K {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
+ u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
+ u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
+ u+0056 u+0069 u+1EC7 u+0074
+ }]] ""]
+} TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g
+test http-idna-2.14-L {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F
+ }]] ""]
+} 3B-ww4c5e180e575a65lsy2b
+test http-idna-2.14-M {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
+ u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
+ u+004F u+004E u+004B u+0045 u+0059 u+0053
+ }]] ""]
+} -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n
+test http-idna-2.14-N {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
+ u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
+ u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
+ }]] ""]
+} Hello-Another-Way--fc4qua05auwb3674vfr0b
+test http-idna-2.14-O {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032
+ }]] ""]
+} 2-u9tlzr9756bt3uc0v
+test http-idna-2.14-P {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
+ u+308B u+0035 u+79D2 u+524D
+ }]] ""]
+} MajiKoi5-783gue6qz075azm5e
+test http-idna-2.14-Q {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0
+ }]] ""]
+} de-jg4avhby1noc0d
+test http-idna-2.14-R {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode [join [subst [string map {u+ \\u} {
+ u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067
+ }]] ""]
+} d9juau41awczczp
+test http-idna-2.14-S {puny encode: examples from RFC 3492} {
+ ::tcl::idna puny encode {-> $1.00 <-}
+} {-> $1.00 <--}
+
+test http-idna-3.1 {puny decode: functional test} {
+ ::tcl::idna puny decode abc-
+} abc
+test http-idna-3.2 {puny decode: functional test} {
+ ::tcl::idna puny decode abc-k50ab
+} a\u20acb\u20acc
+test http-idna-3.3 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC-
+} ABC
+test http-idna-3.4 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC-k50ab
+} A\u20ACB\u20ACC
+test http-idna-3.5 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC-K50AB
+} A\u20ACB\u20ACC
+test http-idna-3.6 {puny decode: functional test} {
+ ::tcl::idna puny decode abc-K50AB
+} a\u20ACb\u20ACc
+test http-idna-3.7 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC- 0
+} abc
+test http-idna-3.8 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC-K50AB 0
+} a\u20ACb\u20ACc
+test http-idna-3.9 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC- 1
+} ABC
+test http-idna-3.10 {puny decode: functional test} {
+ ::tcl::idna puny decode ABC-K50AB 1
+} A\u20ACB\u20ACC
+test http-idna-3.11 {puny decode: functional test} {
+ ::tcl::idna puny decode abc- 0
+} abc
+test http-idna-3.12 {puny decode: functional test} {
+ ::tcl::idna puny decode abc-k50ab 0
+} a\u20ACb\u20ACc
+test http-idna-3.13 {puny decode: functional test} {
+ ::tcl::idna puny decode abc- 1
+} ABC
+test http-idna-3.14 {puny decode: functional test} {
+ ::tcl::idna puny decode abc-k50ab 1
+} A\u20ACB\u20ACC
+test http-idna-3.15 {puny decode: edge cases and errors} {
+ # Is this case actually correct?
+ binary encode hex [encoding convertto utf-8 [::tcl::idna puny decode abc]]
+} c282c281c280
+test http-idna-3.16 {puny decode: edge cases and errors} -returnCodes error -body {
+ ::tcl::idna puny decode abc!
+} -result {bad decode character "!"}
+test http-idna-3.17 {puny decode: edge cases and errors} {
+ catch {::tcl::idna puny decode abc!} -> opt
+ dict get $opt -errorcode
+} {PUNYCODE BAD_INPUT CHAR}
+test http-idna-3.18 {puny decode: edge cases and errors} {
+ ::tcl::idna puny decode ""
+} {}
+# A helper so we don't get lots of crap in failures
+proc hexify s {lmap c [split $s ""] {format u+%04X [scan $c %c]}}
+test http-idna-3.19-A {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode egbpdaj6bu4bxfgehfvwxn]
+} [list {*}{
+ u+0644 u+064A u+0647 u+0645 u+0627 u+0628 u+062A u+0643 u+0644
+ u+0645 u+0648 u+0634 u+0639 u+0631 u+0628 u+064A u+061F
+}]
+test http-idna-3.19-B {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode ihqwcrb4cv8a8dqg056pqjye]
+} {u+4ED6 u+4EEC u+4E3A u+4EC0 u+4E48 u+4E0D u+8BF4 u+4E2D u+6587}
+test http-idna-3.19-C {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode ihqwctvzc91f659drss3x8bo0yb]
+} {u+4ED6 u+5011 u+7232 u+4EC0 u+9EBD u+4E0D u+8AAA u+4E2D u+6587}
+test http-idna-3.19-D {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode Proprostnemluvesky-uyb24dma41a]
+} [list {*}{
+ u+0050 u+0072 u+006F u+010D u+0070 u+0072 u+006F u+0073 u+0074
+ u+011B u+006E u+0065 u+006D u+006C u+0075 u+0076 u+00ED u+010D
+ u+0065 u+0073 u+006B u+0079
+}]
+test http-idna-3.19-E {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode 4dbcagdahymbxekheh6e0a7fei0b]
+} [list {*}{
+ u+05DC u+05DE u+05D4 u+05D4 u+05DD u+05E4 u+05E9 u+05D5 u+05D8
+ u+05DC u+05D0 u+05DE u+05D3 u+05D1 u+05E8 u+05D9 u+05DD u+05E2
+ u+05D1 u+05E8 u+05D9 u+05EA
+}]
+test http-idna-3.19-F {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode \
+ i1baa7eci9glrd9b2ae1bj0hfcgg6iyaf8o0a1dig0cd]
+} [list {*}{
+ u+092F u+0939 u+0932 u+094B u+0917 u+0939 u+093F u+0928 u+094D
+ u+0926 u+0940 u+0915 u+094D u+092F u+094B u+0902 u+0928 u+0939
+ u+0940 u+0902 u+092C u+094B u+0932 u+0938 u+0915 u+0924 u+0947
+ u+0939 u+0948 u+0902
+}]
+test http-idna-3.19-G {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode n8jok5ay5dzabd5bym9f0cm5685rrjetr6pdxa]
+} [list {*}{
+ u+306A u+305C u+307F u+3093 u+306A u+65E5 u+672C u+8A9E u+3092
+ u+8A71 u+3057 u+3066 u+304F u+308C u+306A u+3044 u+306E u+304B
+}]
+test http-idna-3.19-H {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode \
+ 989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c]
+} [list {*}{
+ u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
+ u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
+ u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
+}]
+test http-idna-3.19-I {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode b1abfaaepdrnnbgefbadotcwatmq2g4l]
+} [list {*}{
+ u+043F u+043E u+0447 u+0435 u+043C u+0443 u+0436 u+0435 u+043E
+ u+043D u+0438 u+043D u+0435 u+0433 u+043E u+0432 u+043E u+0440
+ u+044F u+0442 u+043F u+043E u+0440 u+0443 u+0441 u+0441 u+043A
+ u+0438
+}]
+test http-idna-3.19-J {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode \
+ PorqunopuedensimplementehablarenEspaol-fmd56a]
+} [list {*}{
+ u+0050 u+006F u+0072 u+0071 u+0075 u+00E9 u+006E u+006F u+0070
+ u+0075 u+0065 u+0064 u+0065 u+006E u+0073 u+0069 u+006D u+0070
+ u+006C u+0065 u+006D u+0065 u+006E u+0074 u+0065 u+0068 u+0061
+ u+0062 u+006C u+0061 u+0072 u+0065 u+006E u+0045 u+0073 u+0070
+ u+0061 u+00F1 u+006F u+006C
+}]
+test http-idna-3.19-K {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode \
+ TisaohkhngthchnitingVit-kjcr8268qyxafd2f1b9g]
+} [list {*}{
+ u+0054 u+1EA1 u+0069 u+0073 u+0061 u+006F u+0068 u+1ECD u+006B
+ u+0068 u+00F4 u+006E u+0067 u+0074 u+0068 u+1EC3 u+0063 u+0068
+ u+1EC9 u+006E u+00F3 u+0069 u+0074 u+0069 u+1EBF u+006E u+0067
+ u+0056 u+0069 u+1EC7 u+0074
+}]
+test http-idna-3.19-L {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode 3B-ww4c5e180e575a65lsy2b]
+} {u+0033 u+5E74 u+0042 u+7D44 u+91D1 u+516B u+5148 u+751F}
+test http-idna-3.19-M {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode -with-SUPER-MONKEYS-pc58ag80a8qai00g7n9n]
+} [list {*}{
+ u+5B89 u+5BA4 u+5948 u+7F8E u+6075 u+002D u+0077 u+0069 u+0074
+ u+0068 u+002D u+0053 u+0055 u+0050 u+0045 u+0052 u+002D u+004D
+ u+004F u+004E u+004B u+0045 u+0059 u+0053
+}]
+test http-idna-3.19-N {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode Hello-Another-Way--fc4qua05auwb3674vfr0b]
+} [list {*}{
+ u+0048 u+0065 u+006C u+006C u+006F u+002D u+0041 u+006E u+006F
+ u+0074 u+0068 u+0065 u+0072 u+002D u+0057 u+0061 u+0079 u+002D
+ u+305D u+308C u+305E u+308C u+306E u+5834 u+6240
+}]
+test http-idna-3.19-O {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode 2-u9tlzr9756bt3uc0v]
+} {u+3072 u+3068 u+3064 u+5C4B u+6839 u+306E u+4E0B u+0032}
+test http-idna-3.19-P {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode MajiKoi5-783gue6qz075azm5e]
+} [list {*}{
+ u+004D u+0061 u+006A u+0069 u+3067 u+004B u+006F u+0069 u+3059
+ u+308B u+0035 u+79D2 u+524D
+}]
+test http-idna-3.19-Q {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode de-jg4avhby1noc0d]
+} {u+30D1 u+30D5 u+30A3 u+30FC u+0064 u+0065 u+30EB u+30F3 u+30D0}
+test http-idna-3.19-R {puny decode: examples from RFC 3492} {
+ hexify [::tcl::idna puny decode d9juau41awczczp]
+} {u+305D u+306E u+30B9 u+30D4 u+30FC u+30C9 u+3067}
+test http-idna-3.19-S {puny decode: examples from RFC 3492} {
+ ::tcl::idna puny decode {-> $1.00 <--}
+} {-> $1.00 <-}
+rename hexify ""
+
+test http-idna-4.1 {IDNA encoding} {
+ ::tcl::idna encode abc.def
+} abc.def
+test http-idna-4.2 {IDNA encoding} {
+ ::tcl::idna encode a\u20acb\u20acc.def
+} xn--abc-k50ab.def
+test http-idna-4.3 {IDNA encoding} {
+ ::tcl::idna encode def.a\u20acb\u20acc
+} def.xn--abc-k50ab
+test http-idna-4.4 {IDNA encoding} {
+ ::tcl::idna encode ABC.DEF
+} ABC.DEF
+test http-idna-4.5 {IDNA encoding} {
+ ::tcl::idna encode A\u20acB\u20acC.def
+} xn--ABC-k50ab.def
+test http-idna-4.6 {IDNA encoding: invalid edge case} {
+ # Should this be an error?
+ ::tcl::idna encode abc..def
+} abc..def
+test http-idna-4.7 {IDNA encoding: invalid char} -returnCodes error -body {
+ ::tcl::idna encode abc.$.def
+} -result {bad character "$" in DNS name}
+test http-idna-4.7.1 {IDNA encoding: invalid char} {
+ catch {::tcl::idna encode abc.$.def} -> opt
+ dict get $opt -errorcode
+} {IDNA INVALID_NAME_CHARACTER {$}}
+test http-idna-4.8 {IDNA encoding: empty} {
+ ::tcl::idna encode ""
+} {}
+set overlong www.[join [subst [string map {u+ \\u} {
+ u+C138 u+ACC4 u+C758 u+BAA8 u+B4E0 u+C0AC u+B78C u+B4E4 u+C774
+ u+D55C u+AD6D u+C5B4 u+B97C u+C774 u+D574 u+D55C u+B2E4 u+BA74
+ u+C5BC u+B9C8 u+B098 u+C88B u+C744 u+AE4C
+}]] ""].com
+test http-idna-4.9 {IDNA encoding: max lengths from RFC 5890} -body {
+ ::tcl::idna encode $overlong
+} -returnCodes error -result "hostname part too long"
+test http-idna-4.9.1 {IDNA encoding: max lengths from RFC 5890} {
+ catch {::tcl::idna encode $overlong} -> opt
+ dict get $opt -errorcode
+} {IDNA OVERLONG_PART xn--989aomsvi5e83db1d2a355cv1e0vak1dwrv93d5xbh15a0dt30a5jpsd879ccm6fea98c}
+unset overlong
+test http-idna-4.10 {IDNA encoding: edge cases} {
+ ::tcl::idna encode pass\u00e9.example.com
+} xn--pass-epa.example.com
+
+test http-idna-5.1 {IDNA decoding} {
+ ::tcl::idna decode abc.def
+} abc.def
+test http-idna-5.2 {IDNA decoding} {
+ # Invalid entry that's just a wrapper
+ ::tcl::idna decode xn--abc-.def
+} abc.def
+test http-idna-5.3 {IDNA decoding} {
+ # Invalid entry that's just a wrapper
+ ::tcl::idna decode xn--abc-.xn--def-
+} abc.def
+test http-idna-5.4 {IDNA decoding} {
+ # Invalid entry that's just a wrapper
+ ::tcl::idna decode XN--abc-.XN--def-
+} abc.def
+test http-idna-5.5 {IDNA decoding: error cases} -returnCodes error -body {
+ ::tcl::idna decode xn--$$$.example.com
+} -result {bad decode character "$"}
+test http-idna-5.5.1 {IDNA decoding: error cases} {
+ catch {::tcl::idna decode xn--$$$.example.com} -> opt
+ dict get $opt -errorcode
+} {PUNYCODE BAD_INPUT CHAR}
+test http-idna-5.6 {IDNA decoding: error cases} -returnCodes error -body {
+ ::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def
+} -result {exceeded input data}
+test http-idna-5.6.1 {IDNA decoding: error cases} {
+ catch {::tcl::idna decode xn--a-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzz.def} -> opt
+ dict get $opt -errorcode
+} {PUNYCODE BAD_INPUT LENGTH}
+
# cleanup
catch {unset url}
catch {unset badurl}
diff --git a/tests/httpcookie.test b/tests/httpcookie.test
new file mode 100644
index 0000000..a6b193f
--- /dev/null
+++ b/tests/httpcookie.test
@@ -0,0 +1,876 @@
+# Commands covered: http::cookiejar
+#
+# This file contains a collection of tests for the cookiejar package.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright (c) 2014 Donal K. Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+::tcltest::loadTestedCommands
+
+testConstraint notOSXtravis [apply {{} {
+ upvar 1 env(TRAVIS_OSX_IMAGE) travis
+ return [expr {![info exists travis] || ![string match xcode* $travis]}]
+}}]
+testConstraint sqlite3 [expr {[testConstraint notOSXtravis] && ![catch {
+ package require sqlite3
+}]}]
+testConstraint cookiejar [expr {[testConstraint sqlite3] && ![catch {
+ package require cookiejar
+}]}]
+
+set COOKIEJAR_VERSION 0.1
+test http-cookiejar-1.1 "cookie storage: packaging" {notOSXtravis sqlite3 cookiejar} {
+ package require cookiejar
+} $COOKIEJAR_VERSION
+test http-cookiejar-1.2 "cookie storage: packaging" {notOSXtravis sqlite3 cookiejar} {
+ package require cookiejar
+ package require cookiejar
+} $COOKIEJAR_VERSION
+
+test http-cookiejar-2.1 "cookie storage: basics" -constraints {
+ notOSXtravis sqlite3 cookiejar
+} -returnCodes error -body {
+ http::cookiejar
+} -result {wrong # args: should be "http::cookiejar method ?arg ...?"}
+test http-cookiejar-2.2 "cookie storage: basics" -constraints {
+ notOSXtravis sqlite3 cookiejar
+} -returnCodes error -body {
+ http::cookiejar ?
+} -result {unknown method "?": must be configure, create, destroy or new}
+test http-cookiejar-2.3 "cookie storage: basics" -constraints {
+ notOSXtravis sqlite3 cookiejar
+} -body {
+ http::cookiejar configure
+} -result {-domainfile -domainlist -domainrefresh -loglevel -offline -purgeold -retain -vacuumtrigger}
+test http-cookiejar-2.4 "cookie storage: basics" -constraints {
+ notOSXtravis sqlite3 cookiejar
+} -returnCodes error -body {
+ http::cookiejar configure a b c d e
+} -result {wrong # args: should be "http::cookiejar configure ?optionName? ?optionValue?"}
+test http-cookiejar-2.5 "cookie storage: basics" -constraints {
+ notOSXtravis sqlite3 cookiejar
+} -returnCodes error -body {
+ http::cookiejar configure a
+} -result {bad option "a": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger}
+test http-cookiejar-2.6 "cookie storage: basics" -constraints {
+ notOSXtravis sqlite3 cookiejar
+} -returnCodes error -body {
+ http::cookiejar configure -d
+} -result {ambiguous option "-d": must be -domainfile, -domainlist, -domainrefresh, -loglevel, -offline, -purgeold, -retain, or -vacuumtrigger}
+test http-cookiejar-2.7 "cookie storage: basics" -setup {
+ set old [http::cookiejar configure -loglevel]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ list [http::cookiejar configure -loglevel] \
+ [http::cookiejar configure -loglevel debug] \
+ [http::cookiejar configure -loglevel] \
+ [http::cookiejar configure -loglevel error] \
+ [http::cookiejar configure -loglevel]
+} -cleanup {
+ http::cookiejar configure -loglevel $old
+} -result {info debug debug error error}
+test http-cookiejar-2.8 "cookie storage: basics" -setup {
+ set old [http::cookiejar configure -loglevel]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ list [http::cookiejar configure -loglevel] \
+ [http::cookiejar configure -loglevel d] \
+ [http::cookiejar configure -loglevel i] \
+ [http::cookiejar configure -loglevel w] \
+ [http::cookiejar configure -loglevel e]
+} -cleanup {
+ http::cookiejar configure -loglevel $old
+} -result {info debug info warn error}
+test http-cookiejar-2.9 "cookie storage: basics" -body {
+ http::cookiejar configure -off
+} -constraints {notOSXtravis sqlite3 cookiejar} -match glob -result *
+test http-cookiejar-2.10 "cookie storage: basics" -setup {
+ set oldval [http::cookiejar configure -offline]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -offline true
+} -cleanup {
+ catch {http::cookiejar configure -offline $oldval}
+} -result 1
+test http-cookiejar-2.11 "cookie storage: basics" -setup {
+ set oldval [http::cookiejar configure -offline]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -offline nonbool
+} -cleanup {
+ catch {http::cookiejar configure -offline $oldval}
+} -returnCodes error -result {expected boolean value but got "nonbool"}
+test http-cookiejar-2.12 "cookie storage: basics" -setup {
+ set oldval [http::cookiejar configure -purgeold]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -purge nonint
+} -cleanup {
+ catch {http::cookiejar configure -purgeold $oldval}
+} -returnCodes error -result {expected positive integer but got "nonint"}
+test http-cookiejar-2.13 "cookie storage: basics" -setup {
+ set oldval [http::cookiejar configure -domainrefresh]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -domainref nonint
+} -cleanup {
+ catch {http::cookiejar configure -domainrefresh $oldval}
+} -returnCodes error -result {expected positive integer but got "nonint"}
+test http-cookiejar-2.14 "cookie storage: basics" -setup {
+ set oldval [http::cookiejar configure -domainrefresh]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -domainref -42
+} -cleanup {
+ catch {http::cookiejar configure -domainrefresh $oldval}
+} -returnCodes error -result {expected positive integer but got "-42"}
+test http-cookiejar-2.15 "cookie storage: basics" -setup {
+ set oldval [http::cookiejar configure -domainrefresh]
+ set result unset
+ set tracer [http::cookiejar create tracer]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ oo::objdefine $tracer method PostponeRefresh {} {
+ set ::result set
+ next
+ }
+ http::cookiejar configure -domainref 12345
+ return $result
+} -cleanup {
+ $tracer destroy
+ catch {http::cookiejar configure -domainrefresh $oldval}
+} -result set
+
+test http-cookiejar-3.1 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} {
+ info object isa object http::cookiejar
+} 1
+test http-cookiejar-3.2 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} {
+ info object isa class http::cookiejar
+} 1
+test http-cookiejar-3.3 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} {
+ lsort [info object methods http::cookiejar]
+} {configure}
+test http-cookiejar-3.4 "cookie storage: class" {notOSXtravis sqlite3 cookiejar} {
+ lsort [info object methods http::cookiejar -all]
+} {configure create destroy new}
+test http-cookiejar-3.5 "cookie storage: class" -setup {
+ catch {rename ::cookiejar ""}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ namespace eval :: {http::cookiejar create cookiejar}
+} -cleanup {
+ catch {rename ::cookiejar ""}
+} -result ::cookiejar
+test http-cookiejar-3.6 "cookie storage: class" -setup {
+ catch {rename ::cookiejar ""}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ list [http::cookiejar create ::cookiejar] [info commands ::cookiejar] \
+ [::cookiejar destroy] [info commands ::cookiejar]
+} -cleanup {
+ catch {rename ::cookiejar ""}
+} -result {::cookiejar ::cookiejar {} {}}
+test http-cookiejar-3.7 "cookie storage: class" -setup {
+ catch {rename ::cookiejar ""}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar create ::cookiejar foo bar
+} -returnCodes error -cleanup {
+ catch {rename ::cookiejar ""}
+} -result {wrong # args: should be "http::cookiejar create ::cookiejar ?path?"}
+test http-cookiejar-3.8 "cookie storage: class" -setup {
+ catch {rename ::cookiejar ""}
+ set f [makeFile "" cookiejar]
+ file delete $f
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ list [file exists $f] [http::cookiejar create ::cookiejar $f] \
+ [file exists $f]
+} -cleanup {
+ catch {rename ::cookiejar ""}
+ removeFile $f
+} -result {0 ::cookiejar 1}
+test http-cookiejar-3.9 "cookie storage: class" -setup {
+ catch {rename ::cookiejar ""}
+ set f [makeFile "bogus content for a database" cookiejar]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar create ::cookiejar $f
+} -returnCodes error -cleanup {
+ catch {rename ::cookiejar ""}
+ removeFile $f
+} -match glob -result *
+test http-cookiejar-3.10 "cookie storage: class" -setup {
+ catch {rename ::cookiejar ""}
+ set dir [makeDirectory cookiejar]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar create ::cookiejar $dir
+} -returnCodes error -cleanup {
+ catch {rename ::cookiejar ""}
+ removeDirectory $dir
+} -match glob -result *
+
+test http-cookiejar-4.1 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar
+} -returnCodes error -cleanup {
+ ::cookiejar destroy
+} -result {wrong # args: should be "cookiejar method ?arg ...?"}
+test http-cookiejar-4.2 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar ?
+} -returnCodes error -cleanup {
+ ::cookiejar destroy
+} -result {unknown method "?": must be destroy, forceLoadDomainData, getCookies, lookup, policyAllow or storeCookie}
+test http-cookiejar-4.3 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ lsort [info object methods cookiejar -all]
+} -cleanup {
+ ::cookiejar destroy
+} -result {destroy forceLoadDomainData getCookies lookup policyAllow storeCookie}
+test http-cookiejar-4.4 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar getCookies
+} -returnCodes error -cleanup {
+ ::cookiejar destroy
+} -result {wrong # args: should be "cookiejar getCookies proto host path"}
+test http-cookiejar-4.5 "cookie storage" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar getCookies http www.example.com /
+} -cleanup {
+ ::cookiejar destroy
+} -result {}
+test http-cookiejar-4.6 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie
+} -returnCodes error -cleanup {
+ ::cookiejar destroy
+} -result {wrong # args: should be "cookiejar storeCookie options"}
+test http-cookiejar-4.7 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+} -cleanup {
+ ::cookiejar destroy
+} -result {}
+test http-cookiejar-4.8 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ oo::objdefine ::cookiejar export Database
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ # Poke inside implementation!
+ cookiejar Database eval {SELECT count(*) FROM sessionCookies}
+} -cleanup {
+ ::cookiejar destroy
+} -result 1
+test http-cookiejar-4.9 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ oo::objdefine ::cookiejar export Database
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ # Poke inside implementation!
+ cookiejar Database eval {SELECT count(*) FROM persistentCookies}
+} -cleanup {
+ ::cookiejar destroy
+} -result 0
+test http-cookiejar-4.10 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie [dict replace {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+} -cleanup {
+ ::cookiejar destroy
+} -result {}
+test http-cookiejar-4.11 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ oo::objdefine ::cookiejar export Database
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie [dict replace {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+ # Poke inside implementation!
+ cookiejar Database eval {SELECT count(*) FROM sessionCookies}
+} -cleanup {
+ ::cookiejar destroy
+} -result 0
+test http-cookiejar-4.12 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ oo::objdefine ::cookiejar export Database
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie [dict replace {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+ # Poke inside implementation!
+ cookiejar Database eval {SELECT count(*) FROM persistentCookies}
+} -cleanup {
+ ::cookiejar destroy
+} -result 1
+test http-cookiejar-4.13 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ lappend result [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ lappend result [cookiejar getCookies http www.example.com /]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{} {foo bar}}
+test http-cookiejar-4.14 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ lappend result [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie [dict replace {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+ lappend result [cookiejar getCookies http www.example.com /]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{} {foo bar}}
+test http-cookiejar-4.15 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ lappend result [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie [dict replace {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+ lappend result [cookiejar getCookies http www.example.com /]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{} {foo bar}}
+test http-cookiejar-4.16 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ lappend result [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie {
+ key foo1
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie [dict replace {
+ key foo2
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+ lappend result [lsort -stride 2 [cookiejar getCookies http www.example.com /]]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{} {foo1 bar foo2 bar}}
+test http-cookiejar-4.17 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar lookup a b c d
+} -returnCodes error -cleanup {
+ ::cookiejar destroy
+} -result {wrong # args: should be "cookiejar lookup ?host? ?key?"}
+test http-cookiejar-4.18 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ lappend result [cookiejar lookup]
+ lappend result [cookiejar lookup www.example.com]
+ lappend result [catch {cookiejar lookup www.example.com foo} value] $value
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ lappend result [cookiejar lookup]
+ lappend result [cookiejar lookup www.example.com]
+ lappend result [cookiejar lookup www.example.com foo]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{} {} 1 {no such key for that host} www.example.com foo bar}
+test http-cookiejar-4.19 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key bar
+ value foo
+ secure 0
+ domain www.example.org
+ origin www.example.org
+ path /
+ hostonly 1
+ }
+ lappend result [lsort [cookiejar lookup]]
+ lappend result [cookiejar lookup www.example.com]
+ lappend result [cookiejar lookup www.example.com foo]
+ lappend result [cookiejar lookup www.example.org]
+ lappend result [cookiejar lookup www.example.org bar]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{www.example.com www.example.org} foo bar bar foo}
+test http-cookiejar-4.20 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo1
+ value bar1
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie [dict replace {
+ key foo2
+ value bar2
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+5}]]
+ lappend result [cookiejar lookup]
+ lappend result [lsort [cookiejar lookup www.example.com]]
+ lappend result [cookiejar lookup www.example.com foo1]
+ lappend result [cookiejar lookup www.example.com foo2]
+} -cleanup {
+ ::cookiejar destroy
+} -result {www.example.com {foo1 foo2} bar1 bar2}
+test http-cookiejar-4.21 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo1
+ value bar1
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo2
+ value bar2
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ lappend result [cookiejar lookup]
+ lappend result [lsort [cookiejar lookup www.example.com]]
+ lappend result [cookiejar lookup www.example.com foo1]
+ lappend result [cookiejar lookup www.example.com foo2]
+} -cleanup {
+ ::cookiejar destroy
+} -result {www.example.com {foo1 foo2} bar1 bar2}
+test http-cookiejar-4.22 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar forceLoadDomainData x y z
+} -returnCodes error -cleanup {
+ ::cookiejar destroy
+} -result {wrong # args: should be "cookiejar forceLoadDomainData"}
+test http-cookiejar-4.23 "cookie storage: instance" -setup {
+ http::cookiejar create ::cookiejar
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar forceLoadDomainData
+} -cleanup {
+ ::cookiejar destroy
+} -result {}
+test http-cookiejar-4.23.a {cookie storage: instance} -setup {
+ set off [http::cookiejar configure -offline]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -offline 1
+ [http::cookiejar create ::cookiejar] destroy
+} -cleanup {
+ catch {::cookiejar destroy}
+ http::cookiejar configure -offline $off
+} -result {}
+test http-cookiejar-4.23.b {cookie storage: instance} -setup {
+ set off [http::cookiejar configure -offline]
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar configure -offline 0
+ [http::cookiejar create ::cookiejar] destroy
+} -cleanup {
+ catch {::cookiejar destroy}
+ http::cookiejar configure -offline $off
+} -result {}
+
+test http-cookiejar-5.1 "cookie storage: constraints" -setup {
+ http::cookiejar create ::cookiejar
+ cookiejar forceLoadDomainData
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain com
+ origin com
+ path /
+ hostonly 1
+ }
+ cookiejar lookup
+} -cleanup {
+ ::cookiejar destroy
+} -result {}
+test http-cookiejar-5.2 "cookie storage: constraints" -setup {
+ http::cookiejar create ::cookiejar
+ cookiejar forceLoadDomainData
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar
+ secure 0
+ domain foo.example.com
+ origin bar.example.org
+ path /
+ hostonly 1
+ }
+ cookiejar lookup
+} -cleanup {
+ ::cookiejar destroy
+} -result {}
+test http-cookiejar-5.3 "cookie storage: constraints" -setup {
+ http::cookiejar create ::cookiejar
+ cookiejar forceLoadDomainData
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo1
+ value bar
+ secure 0
+ domain com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo2
+ value bar
+ secure 0
+ domain example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar lookup
+} -cleanup {
+ ::cookiejar destroy
+} -result {example.com}
+test http-cookiejar-5.4 "cookie storage: constraints" -setup {
+ http::cookiejar create ::cookiejar
+ cookiejar forceLoadDomainData
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo
+ value bar1
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo
+ value bar2
+ secure 0
+ domain example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ lsort [cookiejar lookup]
+} -cleanup {
+ ::cookiejar destroy
+} -result {example.com www.example.com}
+test http-cookiejar-5.5 "cookie storage: constraints" -setup {
+ http::cookiejar create ::cookiejar
+ cookiejar forceLoadDomainData
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ cookiejar storeCookie {
+ key foo1
+ value 1
+ secure 0
+ domain com
+ origin www.example.com
+ path /
+ hostonly 0
+ }
+ cookiejar storeCookie {
+ key foo2
+ value 2
+ secure 0
+ domain com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo3
+ value 3
+ secure 0
+ domain example.com
+ origin www.example.com
+ path /
+ hostonly 0
+ }
+ cookiejar storeCookie {
+ key foo4
+ value 4
+ secure 0
+ domain example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo5
+ value 5
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 0
+ }
+ cookiejar storeCookie {
+ key foo6
+ value 6
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo7
+ value 7
+ secure 1
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 0
+ }
+ cookiejar storeCookie {
+ key foo8
+ value 8
+ secure 1
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ cookiejar storeCookie {
+ key foo9
+ value 9
+ secure 0
+ domain sub.www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ list [cookiejar getCookies http www.example.com /] \
+ [cookiejar getCookies http www2.example.com /] \
+ [cookiejar getCookies https www.example.com /] \
+ [cookiejar getCookies http sub.www.example.com /]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{foo3 3 foo6 6} {foo3 3} {foo3 3 foo6 6 foo8 8} {foo3 3 foo5 5}}
+
+test http-cookiejar-6.1 "cookie storage: expiry and lookup" -setup {
+ http::cookiejar create ::cookiejar
+ oo::objdefine cookiejar export PurgeCookies
+ set result {}
+ proc values cookies {
+ global result
+ lappend result [lsort [lmap {k v} $cookies {set v}]]
+ }
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ values [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie {
+ key foo
+ value session
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ }
+ values [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie [dict replace {
+ key foo
+ value cookie
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+1}]]
+ values [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie {
+ key foo
+ value session-global
+ secure 0
+ domain example.com
+ origin www.example.com
+ path /
+ hostonly 0
+ }
+ values [cookiejar getCookies http www.example.com /]
+ after 2500
+ update
+ values [cookiejar getCookies http www.example.com /]
+ cookiejar PurgeCookies
+ values [cookiejar getCookies http www.example.com /]
+ cookiejar storeCookie {
+ key foo
+ value go-away
+ secure 0
+ domain example.com
+ origin www.example.com
+ path /
+ hostonly 0
+ expires 0
+ }
+ values [cookiejar getCookies http www.example.com /]
+} -cleanup {
+ ::cookiejar destroy
+} -result {{} session cookie {cookie session-global} {cookie session-global} session-global {}}
+
+test http-cookiejar-7.1 "cookie storage: persistence of persistent cookies" -setup {
+ catch {rename ::cookiejar ""}
+ set f [makeFile "" cookiejar]
+ file delete $f
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar create ::cookiejar $f
+ ::cookiejar destroy
+ http::cookiejar create ::cookiejar $f
+} -cleanup {
+ catch {rename ::cookiejar ""}
+ removeFile $f
+} -result ::cookiejar
+test http-cookiejar-7.2 "cookie storage: persistence of persistent cookies" -setup {
+ catch {rename ::cookiejar ""}
+ set f [makeFile "" cookiejar]
+ file delete $f
+ set result {}
+} -constraints {notOSXtravis sqlite3 cookiejar} -body {
+ http::cookiejar create ::cookiejar $f
+ cookiejar storeCookie [dict replace {
+ key foo
+ value cookie
+ secure 0
+ domain www.example.com
+ origin www.example.com
+ path /
+ hostonly 1
+ } expires [expr {[clock seconds]+1}]]
+ lappend result [::cookiejar getCookies http www.example.com /]
+ ::cookiejar destroy
+ http::cookiejar create ::cookiejar
+ lappend result [::cookiejar getCookies http www.example.com /]
+ ::cookiejar destroy
+ http::cookiejar create ::cookiejar $f
+ lappend result [::cookiejar getCookies http www.example.com /]
+} -cleanup {
+ catch {rename ::cookiejar ""}
+ removeFile $f
+} -result {{foo cookie} {} {foo cookie}}
+
+::tcltest::cleanupTests
+
+# Local variables:
+# mode: tcl
+# End:
diff --git a/tests/httpd b/tests/httpd
index 16e0382..982f3b8 100644
--- a/tests/httpd
+++ b/tests/httpd
@@ -18,7 +18,12 @@ if {$::tcl_platform(os) eq "Darwin"} {
}
proc httpd_init {{port 8015}} {
- socket -server httpdAccept $port
+ set s [socket -server httpdAccept $port]
+ # Save the actual port number in a global variable.
+ # This is important when we're called with port 0
+ # for picking an unused port at random.
+ set ::port [lindex [chan configure $s -sockname] 2]
+ return $s
}
proc httpd_log {args} {
global httpLog
@@ -216,7 +221,7 @@ proc httpdRespond { sock } {
}
# Catch errors from premature client closes
-
+
catch {
if {$data(proto) == "HEAD"} {
puts $sock "HTTP/1.0 200 OK"
diff --git a/tests/httpold.test b/tests/httpold.test
deleted file mode 100644
index e63bcda..0000000
--- a/tests/httpold.test
+++ /dev/null
@@ -1,300 +0,0 @@
-# Commands covered: http_config, http_get, http_wait, http_reset
-#
-# This file contains a collection of tests for the http script library.
-# Sourcing this file into Tcl runs the tests and
-# generates output for errors. No output means no errors were found.
-#
-# 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.
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-if {[catch {package require http 1.0}]} {
- if {[info exists httpold]} {
- catch {puts "Cannot load http 1.0 package"}
- ::tcltest::cleanupTests
- return
- } else {
- 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
- return
- }
-}
-
-if {$::tcl_platform(os) eq "Darwin"} {
- # Name resolution often a problem on OSX; not focus of HTTP package anyway
- set HOST localhost
-} else {
- set HOST [info hostname]
-}
-
-set bindata "This is binary data\x0d\x0amore\x0dmore\x0amore\x00null"
-catch {unset data}
-
-##
-## The httpd script implement a stub http server
-##
-source [file join [file dirname [info script]] httpd]
-
-set port 8010
-if [catch {httpd_init $port} listen] {
- puts "Cannot start http server, http test skipped"
- unset port
- ::tcltest::cleanupTests
- return
-}
-
-test httpold-1.1 {http_config} {
- http_config
-} {-accept */* -proxyfilter httpProxyRequired -proxyhost {} -proxyport {} -useragent {Tcl http client package 1.0}}
-
-test httpold-1.2 {http_config} {
- http_config -proxyfilter
-} httpProxyRequired
-
-test httpold-1.3 {http_config} {
- catch {http_config -junk}
-} 1
-
-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 \
- -useragent "Tcl http client package 1.0"
- set x
-} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -useragent {Tcl Test Suite}}
-
-test httpold-1.5 {http_config} {
- catch {http_config -proxyhost {} -junk 8080}
-} 1
-
-test httpold-2.1 {http_reset} {
- catch {http_reset http#1}
-} 0
-
-test httpold-3.1 {http_get} {
- catch {http_get -bogus flag}
-} 1
-test httpold-3.2 {http_get} {
- catch {http_get http:junk} err
- set err
-} {Unsupported URL: http:junk}
-
-set url ${::HOST}:$port
-test httpold-3.3 {http_get} {
- set token [http_get $url]
- http_data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>GET /</h2>
-</body></html>"
-
-set tail /a/b/c
-set url ${::HOST}:$port/a/b/c
-set binurl ${::HOST}:$port/binary
-
-test httpold-3.4 {http_get} {
- set token [http_get $url]
- http_data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>GET $tail</h2>
-</body></html>"
-
-proc selfproxy {host} {
- global port
- return [list ${::HOST} $port]
-}
-test httpold-3.5 {http_get} {
- http_config -proxyfilter selfproxy
- set token [http_get $url]
- http_config -proxyfilter httpProxyRequired
- http_data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>GET http://$url</h2>
-</body></html>"
-
-test httpold-3.6 {http_get} {
- http_config -proxyfilter bogus
- set token [http_get $url]
- http_config -proxyfilter httpProxyRequired
- http_data $token
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>GET $tail</h2>
-</body></html>"
-
-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>
-<h1>Hello, World!</h1>
-<h2>GET $tail</h2>
-</body></html>"
-
-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>
-<h1>Hello, World!</h1>
-<h2>POST $tail</h2>
-<h2>Query</h2>
-<dl>
-<dt>Name<dd>Value
-<dt>Foo<dd>Bar
-</dl>
-</body></html>"
-
-test httpold-3.9 {http_get} {
- set token [http_get $url -validate 1]
- http_code $token
-} "HTTP/1.0 200 OK"
-
-
-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 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 httpold-4.3 {httpEvent} {
- set token [http_get $url]
- http_code $token
-} {HTTP/1.0 200 Data follows}
-
-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 x [read $in]
- close $in
- 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 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
- removeFile $testfile
- expr $data(currentsize) == $data(totalsize)
-} 1
-
-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]
- fconfigure $in -translation binary
- set x [read $in]
- close $in
- removeFile $testfile
- set x
-} "$bindata$binurl"
-
-proc myProgress {token total current} {
- global progress httpLog
- if {[info exists httpLog] && $httpLog} {
- puts "progress $total $current"
- }
- set progress [list $total $current]
-}
-if 0 {
- # This test hangs on Windows95 because the client never gets EOF
- set httpLog 1
- test httpold-4.6 {httpEvent} {
- set token [http_get $url -blocksize 50 -progress myProgress]
- set progress
- } {111 111}
-}
-test httpold-4.7 {httpEvent} {
- set token [http_get $url -progress myProgress]
- set progress
-} {111 111}
-test httpold-4.8 {httpEvent} {
- set token [http_get $url]
- http_status $token
-} {ok}
-test httpold-4.9 {httpEvent} {
- set token [http_get $url -progress myProgress]
- http_code $token
-} {HTTP/1.0 200 Data follows}
-test httpold-4.10 {httpEvent} {
- set token [http_get $url -progress myProgress]
- http_size $token
-} {111}
-test httpold-4.11 {httpEvent} {
- set token [http_get $url -timeout 1 -command {#}]
- http_reset $token
- http_status $token
-} {reset}
-test httpold-4.12 {httpEvent} {
- update
- set x {}
- after 500 {lappend x ok}
- set token [http_get $url -timeout 1 -command {lappend x fail}]
- vwait x
- list [http_status $token] $x
-} {timeout ok}
-
-test httpold-5.1 {http_formatQuery} {
- http_formatQuery name1 value1 name2 "value two"
-} {name1=value1&name2=value+two}
-
-test httpold-5.2 {http_formatQuery} {
- http_formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
-} {name1=%7ebwelch&name2=%a1%a2%a2}
-
-test httpold-5.3 {http_formatQuery} {
- http_formatQuery lines "line1\nline2\nline3"
-} {lines=line1%0d%0aline2%0d%0aline3}
-
-test httpold-6.1 {httpProxyRequired} {
- update
- http_config -proxyhost ${::HOST} -proxyport $port
- set token [http_get $url]
- http_wait $token
- http_config -proxyhost {} -proxyport {}
- upvar #0 $token data
- set data(body)
-} "<html><head><title>HTTP/1.0 TEST</title></head><body>
-<h1>Hello, World!</h1>
-<h2>GET http://$url</h2>
-</body></html>"
-
-# cleanup
-catch {unset url}
-catch {unset port}
-catch {unset data}
-close $listen
-::tcltest::cleanupTests
-return
diff --git a/tests/incr.test b/tests/incr.test
index 9243be0..aa2872a 100644
--- a/tests/incr.test
+++ b/tests/incr.test
@@ -494,6 +494,18 @@ test incr-2.31 {incr command (compiled): bad increment} {
(reading increment)
invoked from within
"incr x 1a"}}
+test incr-2.32 {incr command (compiled): bad pure list increment} {
+ list [catch {incr x [list 1 2]} msg] $msg $::errorInfo
+} {1 {expected integer but got "1 2"} {expected integer but got "1 2"
+ (reading increment)
+ invoked from within
+"incr x [list 1 2]"}}
+test incr-2.33 {incr command (compiled): bad pure dict increment} {
+ list [catch {incr x [dict create 1 2]} msg] $msg $::errorInfo
+} {1 {expected integer but got "1 2"} {expected integer but got "1 2"
+ (reading increment)
+ invoked from within
+"incr x [dict create 1 2]"}}
test incr-3.1 {increment by wide amount: bytecode route} {
set x 0
diff --git a/tests/indexObj.test b/tests/indexObj.test
index 646cb02..126d062 100644
--- a/tests/indexObj.test
+++ b/tests/indexObj.test
@@ -109,7 +109,7 @@ test indexObj-5.6 {Tcl_WrongNumArgs} testindexobj {
} "wrong # args: should be \"mycmd foo\""
# Contrast this with test proc-3.6; they have to be like this because
# of [Bug 1066837] so Itcl won't break.
-test indexObj-5.7 {Tcl_WrongNumArgs} testindexobj {
+test indexObj-5.7 {Tcl_WrongNumArgs} {testindexobj obsolete} {
testwrongnumargs 2 "fee fi" "fo fum" foo bar
} "wrong # args: should be \"fo fum foo fee fi\""
diff --git a/tests/info.test b/tests/info.test
index 1b52cf5..a12d45c 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -19,9 +19,9 @@ if {{::tcltest} ni [namespace children]} {
package require tcltest 2
namespace import -force ::tcltest::*
}
-
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
+testConstraint zlib [llength [info commands zlib]]
# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.
@@ -33,7 +33,7 @@ namespace eval test_ns_info1 {
proc p {x} {return "x=$x"}
proc q {{y 27} {z {}}} {return "y=$y"}
}
-
+
test info-1.1 {info args option} {
proc t1 {a bbb c} {return foo}
info args t1
@@ -110,7 +110,7 @@ test info-2.6 {info body option, returning list bodies} {
proc testinfocmdcount {} {
set x [info cmdcount]
set y 12345
- set z [info cm]
+ set z [info cmdc]
expr {$z-$x}
}
test info-3.1 {info cmdcount compiled} {
@@ -119,7 +119,7 @@ test info-3.1 {info cmdcount compiled} {
test info-3.2 {info cmdcount evaled} -body {
set x [info cmdcount]
set y 12345
- set z [info cm]
+ set z [info cmdc]
expr {$z-$x}
} -cleanup {unset x y z} -result 4
test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
@@ -397,8 +397,8 @@ test info-10.3 {info library option} -body {
set tcl_library $savedLibrary; unset savedLibrary
test info-11.1 {info loaded option} -body {
- info loaded a b
-} -returnCodes error -result {wrong # args: should be "info loaded ?interp?"}
+ info loaded a b c
+} -returnCodes error -result {wrong # args: should be "info loaded ?interp? ?packageName?"}
test info-11.2 {info loaded option} -body {
info loaded {}; info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
@@ -678,16 +678,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
} -result {wrong # args: should be "info subcommand ?arg ...?"}
test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
info gorp
-} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
info c
-} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
info l
-} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
info s
-} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
##
# ### ### ### ######### ######### #########
@@ -1841,7 +1841,7 @@ test info-30.48 {Bug 2850901} testevalex {
# -------------------------------------------------------------------------
# literal sharing 2, bug 2933089
-test info-40.1 {location information not confused by literal sharing, bug 2933089} -setup {
+test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
set result {}
proc print_one {} {}
@@ -2099,7 +2099,7 @@ proc foo::bar {} {
foreach {*}{
x y
{set res [info frame 0]}
- }
+ }
return $res
}
test info-33.13 {{*}, literal, simple, bytecompiled} -body {
@@ -2114,7 +2114,7 @@ proc foo::bar {} {
if {*}{
{[return [info frame 0]]}
{}
- }
+ }
}
test info-33.14 {{*}, literal, simple, bytecompiled} -body {
reduce [foo::bar]
@@ -2128,7 +2128,7 @@ proc foo::bar {} {
if 0 {*}{
{} else
{return [info frame 0]}
- }
+ }
}
test info-33.15 {{*}, literal, simple, bytecompiled} -body {
reduce [foo::bar]
@@ -2229,7 +2229,7 @@ namespace eval foo {}
proc foo::bar {} {
try {*}{
{set res [info frame 0]}
- }
+ }
return $res
}
test info-33.23 {{*}, literal, simple, bytecompiled} -body {
@@ -2396,6 +2396,174 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body {
} -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
# -------------------------------------------------------------------------
+namespace eval ::testinfocmdtype {
+ apply {cmds {
+ foreach c $cmds {rename $c {}}
+ } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
+}
+test info-40.1 {info cmdtype: syntax} -body {
+ info cmdtype
+} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
+test info-40.2 {info cmdtype: syntax} -body {
+ info cmdtype foo bar
+} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
+test info-40.3 {info cmdtype: no such command} -body {
+ info cmdtype ::testinfocmdtype::foo
+} -returnCodes error -result {unknown command "::testinfocmdtype::foo"}
+test info-40.4 {info cmdtype: native commands} -body {
+ info cmdtype ::if
+} -result native
+test info-40.5 {info cmdtype: native commands} -body {
+ info cmdtype ::puts
+} -result native
+test info-40.6 {info cmdtype: native commands} -body {
+ info cmdtype ::yield
+} -result native
+test info-40.7 {info cmdtype: procedures} -setup {
+ proc ::testinfocmdtype::someproc {} {}
+} -body {
+ info cmdtype ::testinfocmdtype::someproc
+} -cleanup {
+ rename ::testinfocmdtype::someproc {}
+} -result proc
+test info-40.8 {info cmdtype: aliases} -setup {
+ interp alias {} ::testinfocmdtype::somealias {} ::puts
+} -body {
+ info cmdtype ::testinfocmdtype::somealias
+} -cleanup {
+ rename ::testinfocmdtype::somealias {}
+} -result alias
+test info-40.9 {info cmdtype: imports} -setup {
+ namespace eval ::testinfocmdtype {
+ namespace eval foo {
+ proc bar {} {}
+ namespace export bar
+ }
+ namespace import foo::bar
+ }
+} -body {
+ info cmdtype ::testinfocmdtype::bar
+} -cleanup {
+ rename ::testinfocmdtype::bar {}
+ namespace delete ::testinfocmdtype::foo
+} -result import
+test info-40.10 {info cmdtype: slaves} -setup {
+ apply {i {
+ rename $i ::testinfocmdtype::slave
+ variable ::testinfocmdtype::slave $i
+ }} [interp create]
+} -body {
+ info cmdtype ::testinfocmdtype::slave
+} -cleanup {
+ interp delete $::testinfocmdtype::slave
+} -result slave
+test info-40.11 {info cmdtype: objects} -setup {
+ apply {{} {
+ oo::object create obj
+ } ::testinfocmdtype}
+} -body {
+ info cmdtype ::testinfocmdtype::obj
+} -cleanup {
+ ::testinfocmdtype::obj destroy
+} -result object
+test info-40.12 {info cmdtype: objects} -setup {
+ apply {{} {
+ oo::object create obj
+ } ::testinfocmdtype}
+} -body {
+ info cmdtype [info object namespace ::testinfocmdtype::obj]::my
+} -cleanup {
+ ::testinfocmdtype::obj destroy
+} -result privateObject
+test info-40.13 {info cmdtype: ensembles} -setup {
+ namespace eval ::testinfocmdtype {
+ namespace eval ensmbl {
+ proc bar {} {}
+ namespace export *
+ namespace ensemble create
+ }
+ }
+} -body {
+ info cmdtype ::testinfocmdtype::ensmbl
+} -cleanup {
+ namespace delete ::testinfocmdtype::ensmbl
+} -result ensemble
+test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
+ namespace eval ::testinfocmdtype {
+ rename [zlib stream gzip] zstream
+ }
+} -body {
+ info cmdtype ::testinfocmdtype::zstream
+} -cleanup {
+ ::testinfocmdtype::zstream close
+} -result zlibStream
+test info-40.15 {info cmdtype: coroutines} -setup {
+ coroutine ::testinfocmdtype::coro eval yield
+} -body {
+ info cmdtype ::testinfocmdtype::coro
+} -cleanup {
+ ::testinfocmdtype::coro
+} -result coroutine
+test info-40.16 {info cmdtype: dynamic behavior} -setup {
+ proc ::testinfocmdtype::foo {} {}
+} -body {
+ namespace eval ::testinfocmdtype {
+ list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \
+ [namespace which foo] [rename foo bar] [namespace which bar] \
+ [catch {info cmdtype foo}] [catch {info cmdtype bar}]
+ }
+} -cleanup {
+ namespace eval ::testinfocmdtype {
+ catch {rename foo {}}
+ catch {rename bar {}}
+ }
+} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
+test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
+ set i [interp create]
+} -body {
+ $i alias foo gorp
+ $i eval {
+ info cmdtype foo
+ }
+} -cleanup {
+ interp delete $i
+} -result alias
+test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
+ set safe [interp create -safe]
+} -body {
+ $safe alias foo gorp
+ $safe eval {
+ info cmdtype foo
+ }
+} -returnCodes error -cleanup {
+ interp delete $safe
+} -result {not allowed to invoke subcommand cmdtype of info}
+test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
+ set safe [interp create -safe]
+} -body {
+ set inner [interp create [list $safe bar]]
+ interp alias $inner foo $safe gorp
+ $safe eval {
+ bar eval {
+ info cmdtype foo
+ }
+ }
+} -returnCodes error -cleanup {
+ interp delete $safe
+} -result {not allowed to invoke subcommand cmdtype of info}
+test info-40.20 {info cmdtype: aliases in slave interpreters} -setup {
+ set safe [interp create -safe]
+} -body {
+ $safe eval {
+ interp alias {} foo {} gorp
+ info cmdtype foo
+ }
+} -returnCodes error -cleanup {
+ interp delete $safe
+} -result {not allowed to invoke subcommand cmdtype of info}
+namespace delete ::testinfocmdtype
+
+# -------------------------------------------------------------------------
unset -nocomplain res
test info-39.2 {Bug 4b61afd660} -setup {
diff --git a/tests/init.test b/tests/init.test
index 639389f..2a81b52 100644
--- a/tests/init.test
+++ b/tests/init.test
@@ -28,7 +28,7 @@ test init-1.2 {auto_qualify - absolute cmd - global} {
} global
test init-1.3 {auto_qualify - no colons cmd - global} {
auto_qualify nocolons ::
-} nocolons
+} nocolons
test init-1.4 {auto_qualify - no colons cmd - namespace} {
auto_qualify nocolons ::sub
} {::sub::nocolons nocolons}
@@ -93,11 +93,11 @@ test init-2.5 {load safe:::setLogCmd - stage 2} {
auto_reset
catch {rename ::safe::setLogCmd {}}
test init-2.6 {load setLogCmd from safe:: - stage 1} {
- namespace eval safe setLogCmd
+ namespace eval safe setLogCmd
rename ::safe::setLogCmd {} ;# should not fail
} {}
test init-2.7 {oad setLogCmd from safe:: - stage 2} {
- namespace eval safe setLogCmd
+ namespace eval safe setLogCmd
rename ::safe::setLogCmd {} ;# should not fail
} {}
test init-2.8 {load tcl::HistAdd} -setup {
@@ -132,12 +132,12 @@ foreach arg [subst -nocommands -novariables {
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
+ {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
+ {contrived example: rare circumstance
where the point at which to prune the
error stack cannot be uniquely determined.
foo bar
diff --git a/tests/interp.test b/tests/interp.test
index 5299d82..29e3b2d 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -20,7 +20,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testinterpdelete [llength [info commands testinterpdelete]]
-set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable unload}
+set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}
foreach i [interp slaves] {
interp delete $i
@@ -56,7 +56,7 @@ test interp-1.8 {options for interp command} -returnCodes error -body {
} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.9 {options for interp command} -returnCodes error -body {
interp -froboz -safe
-} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
+} -result {bad option "-froboz": must be alias, aliases, bgerror, cancel, create, debug, delete, eval, exists, expose, hide, hidden, issafe, invokehidden, limit, marktrusted, recursionlimit, slaves, share, target, or transfer}
test interp-1.10 {options for interp command} -returnCodes error -body {
interp target
} -result {wrong # args: should be "interp target path alias"}
@@ -70,7 +70,7 @@ test interp-2.2 {basic interpreter creation} {
} 0
test interp-2.3 {basic interpreter creation} {
catch {interp create -safe}
-} 0
+} 0
test interp-2.4 {basic interpreter creation} -setup {
catch {interp create a}
} -returnCodes error -body {
@@ -106,7 +106,7 @@ test interp-2.11 {anonymous interps vs existing procs} {
set x [interp create]
regexp "interp(\[0-9]+)" $x dummy anothernum
expr $anothernum > $thenum
-} 1
+} 1
test interp-2.12 {anonymous interps vs existing procs} {
set x [interp create -safe]
regexp "interp(\[0-9]+)" $x dummy thenum
@@ -876,12 +876,12 @@ test interp-18.9 {eval in deleted interp, bug 495830} {
interp create tst
interp alias tst suicide {} interp delete tst
list [catch {tst eval {suicide; set a 5}} msg] $msg
-} {1 {attempt to call eval in deleted interpreter}}
+} {1 {attempt to call eval in deleted interpreter}}
test interp-18.10 {eval in deleted interp, bug 495830} {
interp create tst
interp alias tst suicide {} interp delete tst
list [catch {tst eval {set set set; suicide; $set a 5}} msg] $msg
-} {1 {attempt to call eval in deleted interpreter}}
+} {1 {attempt to call eval in deleted interpreter}}
# Test alias deletion
@@ -971,7 +971,7 @@ test interp-19.9 {alias deletion, renaming} {
set l [interp eval a foo]
interp delete a
set l
-} 1156
+} 1156
test interp-20.1 {interp hide, interp expose and interp invokehidden} {
set a [interp create]
@@ -1192,7 +1192,7 @@ test interp-20.21 {interp hide vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a hide list} msg]
+ lappend l [catch {a hide list} msg]
lappend l $msg
interp delete a
set l
@@ -1201,7 +1201,7 @@ test interp-20.22 {interp hide vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {interp hide a list} msg]
+ lappend l [catch {interp hide a list} msg]
lappend l $msg
interp delete a
set l
@@ -1210,7 +1210,7 @@ test interp-20.23 {interp hide vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a eval {interp hide {} list}} msg]
+ lappend l [catch {a eval {interp hide {} list}} msg]
lappend l $msg
interp delete a
set l
@@ -1220,7 +1220,7 @@ test interp-20.24 {interp hide vs safety} {
interp create a -safe
interp create {a b}
set l ""
- lappend l [catch {a eval {interp hide b list}} msg]
+ lappend l [catch {a eval {interp hide b list}} msg]
lappend l $msg
interp delete a
set l
@@ -1239,7 +1239,7 @@ test interp-20.26 {interp expoose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a hide list} msg]
+ lappend l [catch {a hide list} msg]
lappend l $msg
lappend l [catch {a expose list} msg]
lappend l $msg
@@ -1250,9 +1250,9 @@ test interp-20.27 {interp expose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {interp hide a list} msg]
+ lappend l [catch {interp hide a list} msg]
lappend l $msg
- lappend l [catch {interp expose a list} msg]
+ lappend l [catch {interp expose a list} msg]
lappend l $msg
interp delete a
set l
@@ -1261,7 +1261,7 @@ test interp-20.28 {interp expose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {a hide list} msg]
+ lappend l [catch {a hide list} msg]
lappend l $msg
lappend l [catch {a eval {interp expose {} list}} msg]
lappend l $msg
@@ -1272,9 +1272,9 @@ test interp-20.29 {interp expose vs safety} {
catch {interp delete a}
interp create a -safe
set l ""
- lappend l [catch {interp hide a list} msg]
+ lappend l [catch {interp hide a list} msg]
lappend l $msg
- lappend l [catch {a eval {interp expose {} list}} msg]
+ lappend l [catch {a eval {interp expose {} list}} msg]
lappend l $msg
interp delete a
set l
@@ -1284,9 +1284,9 @@ test interp-20.30 {interp expose vs safety} {
interp create a -safe
interp create {a b}
set l ""
- lappend l [catch {interp hide {a b} list} msg]
+ lappend l [catch {interp hide {a b} list} msg]
lappend l $msg
- lappend l [catch {a eval {interp expose b list}} msg]
+ lappend l [catch {a eval {interp expose b list}} msg]
lappend l $msg
interp delete a
set l
@@ -1296,7 +1296,7 @@ test interp-20.31 {interp expose vs safety} {
interp create a -safe
interp create {a b}
set l ""
- lappend l [catch {interp hide {a b} list} msg]
+ lappend l [catch {interp hide {a b} list} msg]
lappend l $msg
lappend l [catch {interp expose {a b} list} msg]
lappend l $msg
@@ -1676,7 +1676,7 @@ test interp-21.5 {interp hidden} -setup {
lsort [interp hidden a]
} -cleanup {
interp delete a
-} -result $hidden_cmds
+} -result $hidden_cmds
test interp-21.6 {interp hidden vs interp hide, interp expose} -setup {
catch {interp delete a}
set l ""
@@ -1847,7 +1847,7 @@ test interp-23.2 {testing hiding vs aliases: safe interp} -setup {
lappend l [lsort [interp aliases a]] [lsort [interp hidden a]]
} -cleanup {
interp delete a
-} -result [list $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} $hidden_cmds {::tcl::mathfunc::max ::tcl::mathfunc::min bar clock} [lsort [concat $hidden_cmds bar]] {::tcl::mathfunc::max ::tcl::mathfunc::min clock} $hidden_cmds]
+} -result [list $hidden_cmds {bar clock} $hidden_cmds {bar clock} [lsort [concat $hidden_cmds bar]] {clock} $hidden_cmds]
test interp-24.1 {result resetting on error} -setup {
catch {interp delete a}
@@ -2200,7 +2200,7 @@ test interp-27.1 {interp aliases & namespaces} -setup {
set i [interp create]
} -body {
set aliasTrace {}
- proc tstAlias {args} {
+ proc tstAlias {args} {
global aliasTrace
lappend aliasTrace [list [namespace current] $args]
}
@@ -2214,7 +2214,7 @@ test interp-27.2 {interp aliases & namespaces} -setup {
set i [interp create]
} -body {
set aliasTrace {}
- proc tstAlias {args} {
+ proc tstAlias {args} {
global aliasTrace
lappend aliasTrace [list [namespace current] $args]
}
@@ -2228,7 +2228,7 @@ test interp-27.3 {interp aliases & namespaces} -setup {
set i [interp create]
} -body {
set aliasTrace {}
- proc tstAlias {args} {
+ proc tstAlias {args} {
global aliasTrace
lappend aliasTrace [list [namespace current] $args]
}
@@ -2244,7 +2244,7 @@ test interp-27.4 {interp aliases & namespaces} -setup {
} -body {
namespace eval foo2 {
variable aliasTrace {}
- proc bar {args} {
+ proc bar {args} {
variable aliasTrace
lappend aliasTrace [list [namespace current] $args]
}
@@ -3321,7 +3321,7 @@ test interp-34.9 {time limits trigger in blocking after} {
} msg]
set t1 [clock seconds]
interp delete $i
- list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]
+ list $code $msg [expr {($t1-$t0) < 3 ? "OK" : $t1-$t0}]
} {1 {time limit exceeded} OK}
test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body {
set i [interp create]
@@ -3555,7 +3555,7 @@ test interp-35.24 {interp time limits can't touch current interp} -body {
test interp-36.1 {interp bgerror syntax} -body {
interp bgerror
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
-test interp-36.2 {interp bgerror syntax} -body {
+test interp-36.2 {interp bgerror syntax} -body {
interp bgerror x y z
} -returnCodes error -result {wrong # args: should be "interp bgerror path ?cmdPrefix?"}
test interp-36.3 {interp bgerror syntax} -setup {
diff --git a/tests/io.test b/tests/io.test
index fe1052a..d42f59e 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -122,10 +122,10 @@ test io-1.8 {Tcl_WriteChars: WriteChars} {
# 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
+ 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"
@@ -191,7 +191,7 @@ test io-1.9 {Tcl_WriteChars: WriteChars} {
test io-2.1 {WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -213,7 +213,7 @@ 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 $path(test1) w]
fconfigure $f -encoding binary -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -233,7 +233,7 @@ test io-2.4 {WriteBytes: reset sawLF after each buffer} {
test io-3.1 {WriteChars: compatibility with WriteBytes} {
# loop until all bytes are written
-
+
set f [open $path(test1) w]
fconfigure $f -encoding ascii -buffersize 16 -translation crlf
puts $f "abcdefghijklmnopqrstuvwxyz"
@@ -255,7 +255,7 @@ 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 $path(test1) w]
fconfigure $f -encoding ascii -buffering line -translation crlf
puts -nonewline $f "\n12"
@@ -267,7 +267,7 @@ test io-3.4 {WriteChars: loop over stage buffer} {
# stage buffer maps to more than can be queued at once.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 16
+ fconfigure $f -encoding jis0208 -buffersize 16
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -279,7 +279,7 @@ test io-3.5 {WriteChars: saved != 0} {
# requested buffersize.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -310,7 +310,7 @@ test io-3.7 {WriteChars: (bufPtr->nextAdded > bufPtr->length)} {
# of the next channel buffer.
set f [open $path(test1) w]
- fconfigure $f -encoding jis0208 -buffersize 17
+ fconfigure $f -encoding jis0208 -buffersize 17
puts -nonewline $f "\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\"
set x [list [contents $path(test1)]]
close $f
@@ -380,7 +380,7 @@ test io-4.5 {TranslateOutputEOL: crlf} {
test io-5.1 {CheckFlush: not full} {
set f [open $path(test1) w]
- fconfigure $f
+ fconfigure $f
puts -nonewline $f "12345678901234567890"
set x [list [contents $path(test1)]]
close $f
@@ -469,7 +469,7 @@ set a "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
append a $a
append a $a
test io-6.6 {Tcl_GetsObj: loop test} {
- # if (dst >= dstEnd)
+ # if (dst >= dstEnd)
set f [open $path(test1) w]
puts $f $a
@@ -768,7 +768,7 @@ test io-6.32 {Tcl_GetsObj: crlf mode: buffer exhausted, more data} {testchannel}
} [list 15 "123456789012345" 17 3]
test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
# eol still equals dstEnd
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -780,8 +780,8 @@ test io-6.33 {Tcl_GetsObj: crlf mode: buffer exhausted, at eof} {
set x
} [list 16 "123456789012345\r" 1]
test io-6.34 {Tcl_GetsObj: crlf mode: buffer exhausted, not followed by \n} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\rabcd\r\nefg"
@@ -888,7 +888,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "\nabcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -897,7 +897,7 @@ test io-6.43 {Tcl_GetsObj: input saw cr} {stdio testchannel openpipe fileevent}
set x
} [list "bbbbbbbbbbbbbbb" 15 "123456789abcdef" 1 4 "abcd" 0 3 "efg"]
test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel openpipe fileevent} {
- # not (*eol == '\n')
+ # not (*eol == '\n')
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto lf} -buffering none
@@ -905,7 +905,7 @@ test io-6.44 {Tcl_GetsObj: input saw cr, not followed by cr} {stdio testchannel
fconfigure $f -buffersize 16
set x [list [gets $f]]
fconfigure $f -blocking 0
- lappend x [gets $f line] $line [testchannel queuedcr $f]
+ lappend x [gets $f line] $line [testchannel queuedcr $f]
fconfigure $f -blocking 1
puts -nonewline $f "abcd\refg\x1a"
lappend x [gets $f line] $line [testchannel queuedcr $f]
@@ -958,10 +958,10 @@ test io-6.47 {Tcl_GetsObj: auto mode: \r at end of buffer, peek for \n} {testcha
set x [list [gets $f] [testchannel inputbuffered $f]]
close $f
set x
-} [list "123456789012345" 15]
+} [list "123456789012345" 15]
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 $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456789012345\r"
@@ -974,7 +974,7 @@ test io-6.48 {Tcl_GetsObj: auto mode: \r at end of buffer, no more avail} {testc
} [list "123456789012345" 1]
test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
# if (*eol == '\n') {skip++}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r\n78901"
@@ -985,8 +985,8 @@ test io-6.49 {Tcl_GetsObj: auto mode: \r followed by \n} {testchannel} {
set x
} [list "123456" 0 8 "78901"]
test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
- # not (*eol == '\n')
-
+ # not (*eol == '\n')
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\r78901"
@@ -998,7 +998,7 @@ test io-6.50 {Tcl_GetsObj: auto mode: \r not followed by \n} {testchannel} {
} [list "123456" 0 7 "78901"]
test io-6.51 {Tcl_GetsObj: auto mode: \n} {
# else if (*eol == '\n') {goto gotoeol;}
-
+
set f [open $path(test1) w]
fconfigure $f -translation lf
puts -nonewline $f "123456\n78901"
@@ -1091,7 +1091,7 @@ test io-7.1 {FilterInputBytes: split up character at end of buffer} {
} "1234567890123\uff10\uff11\uff12\uff13\uff14"
test io-7.2 {FilterInputBytes: split up character in middle of buffer} {
# (bufPtr->nextAdded < bufPtr->bufLength)
-
+
set f [open $path(test1) w]
fconfigure $f -encoding binary
puts -nonewline $f "1234567890\n123\x82\x4f\x82\x50\x82"
@@ -1200,7 +1200,7 @@ test io-8.4 {PeekAhead: cached data available in this buffer} {
set x [gets $f]
close $f
- set x
+ set x
} $a
unset a
test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel openpipe fileevent} {
@@ -1216,7 +1216,7 @@ test io-8.5 {PeekAhead: don't peek if last read was short} {stdio testchannel op
set x
} {15 abcdefghijklmno 1}
test io-8.6 {PeekAhead: change to non-blocking mode} {stdio testchannel openpipe fileevent} {
- # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
+ # ((chanPtr->flags & CHANNEL_NONBLOCKING) == 0)
set f [open "|[list [interpreter] $path(cat)]" w+]
fconfigure $f -translation {auto binary} -buffersize 16
@@ -1573,7 +1573,7 @@ test io-13.2 {TranslateInputEOL: crlf mode} {
set x
} "abcd\ndef\n"
test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1586,7 +1586,7 @@ test io-13.3 {TranslateInputEOL: crlf mode: naked cr} {
set x
} "abcd\ndef\r"
test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1599,7 +1599,7 @@ test io-13.4 {TranslateInputEOL: crlf mode: cr followed by not \n} {
set x
} "abcd\ndef\rfgh"
test io-13.5 {TranslateInputEOL: crlf mode: naked lf} {
- # (src >= srcMax)
+ # (src >= srcMax)
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -1714,7 +1714,7 @@ test io-13.9 {TranslateInputEOL: auto mode: \r followed by not \n} {
set x
} "abcd\ndef"
test io-13.10 {TranslateInputEOL: auto mode: \n} {
- # not (*src == '\r')
+ # not (*src == '\r')
set f [open $path(test1) w]
fconfigure $f -translation lf
@@ -2063,7 +2063,7 @@ test io-20.1 {Tcl_CreateChannel: initial settings} {
encoding system $old
close $a
set x
-} {ascii}
+} {ascii}
test io-20.2 {Tcl_CreateChannel: initial settings} {win} {
set f [open $path(test1) w+]
set x [list [fconfigure $f -eofchar] [fconfigure $f -translation]]
@@ -2158,7 +2158,7 @@ test io-26.1 {Tcl_GetChannelInstanceData} {stdio openpipe} {
set f [open "|[list [interpreter] << exit]"]
expr [pid $f]
close $f
-} {}
+} {}
# Test flushing. The functions tested here are FlushChannel.
@@ -3056,7 +3056,7 @@ test io-30.6 {Tcl_Write cr, Tcl_Read crlf} {
fconfigure $f -translation crlf
set x [read $f]
close $f
- set x
+ set x
} "hello\rthere\rand\rhere\r"
test io-30.7 {Tcl_Write crlf, Tcl_Read crlf} {
file delete $path(test1)
@@ -3984,7 +3984,7 @@ test io-31.31 {Tcl_Write crlf on block boundary, Tcl_Gets crlf} {
}
close $f
set f [open $path(test1) r]
- fconfigure $f -translation crlf
+ fconfigure $f -translation crlf
set c ""
while {[gets $f line] >= 0} {
append c $line\n
@@ -5473,7 +5473,7 @@ test io-39.13 {Tcl_SetChannelOption, Tcl_GetChannelOption, buffer size} {
test io-39.14 {Tcl_SetChannelOption: -encoding, binary & utf-8} {
file delete $path(test1)
set f [open $path(test1) w]
- fconfigure $f -encoding {}
+ fconfigure $f -encoding {}
puts -nonewline $f \xe7\x89\xa6
close $f
set f [open $path(test1) r]
@@ -5636,7 +5636,7 @@ test io-40.2 {POSIX open access modes: CREAT} {unix} {
file delete $path(test3)
set f [open $path(test3) {WRONLY CREAT} 0o600]
file stat $path(test3) stats
- set x [format "0o%o" [expr $stats(mode)&0o777]]
+ set x [format "%#o" [expr $stats(mode)&0o777]]
puts $f "line 1"
close $f
set f [open $path(test3) r]
@@ -5651,7 +5651,7 @@ test io-40.3 {POSIX open access modes: CREAT} {unix umask} {
close $f
file stat $path(test3) stats
format "%#o" [expr $stats(mode)&0o777]
-} [format %#4o [expr {0o666 & ~ $umaskValue}]]
+} [format %#5o [expr {0o666 & ~ $umaskValue}]]
test io-40.4 {POSIX open access modes: CREAT} {
file delete $path(test3)
set f [open $path(test3) w]
@@ -8650,11 +8650,11 @@ test io-74.1 {[104f2885bb] improper cache validity check} -setup {
interp create slave
} -constraints testobj -body {
teststringobj set 1 [string range $rfd 0 end]
- read [teststringobj get 1]
+ read [teststringobj get 1]
testobj duplicate 1 2
interp transfer {} $rfd slave
catch {read [teststringobj get 1]}
- read [teststringobj get 2]
+ read [teststringobj get 2]
} -cleanup {
interp delete slave
testobj freeallvars
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index 948671e..68bc542 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -14,7 +14,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest 2
+ package require tcltest 2.5
namespace import -force ::tcltest::*
}
@@ -154,10 +154,10 @@ test iocmd-4.11 {read command} {
test iocmd-4.12 {read command} -setup {
set f [open $path(test1)]
} -body {
- list [catch {read $f 12z} msg] $msg $::errorCode
+ read $f 12z
} -cleanup {
close $f
-} -result {1 {expected non-negative integer but got "12z"} {TCL VALUE NUMBER}}
+} -result {expected non-negative integer but got "12z"} -errorCode {TCL VALUE NUMBER}
test iocmd-5.1 {seek command} -returnCodes error -body {
seek
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 85e427a..0a335ff 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -1320,7 +1320,7 @@ proc inthread {chan script args} {
# forwarded channel operations.
set ::tres ""
- thread::send -async $tid {
+ thread::send -async $tid {
after 50
catch {s} res; # This runs the script, 's' was defined at (*)
thread::send -async $mid [list set ::tres $res]
diff --git a/tests/iogt.test b/tests/iogt.test
index 269a0ba..3cac2cf 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -5,7 +5,7 @@
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-#
+#
# Copyright (c) 2000 Ajuba Solutions.
# Copyright (c) 2000 Andreas Kupries.
# All rights reserved.
diff --git a/tests/lindex.test b/tests/lindex.test
index e513b62..bb3f005 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -441,7 +441,7 @@ test lindex-16.7 {data reuse} {
test lindex-17.0 {Bug 1718580} {*}{
-body {
lindex {} end foo
- }
+ }
-match glob
-result {bad index "foo"*}
-returnCodes 1
@@ -450,7 +450,7 @@ test lindex-17.0 {Bug 1718580} {*}{
test lindex-17.1 {Bug 1718580} {*}{
-body {
lindex a end foo
- }
+ }
-match glob
-result {bad index "foo"*}
-returnCodes 1
diff --git a/tests/link.test b/tests/link.test
index 6bff356..a12759d 100644
--- a/tests/link.test
+++ b/tests/link.test
@@ -173,6 +173,27 @@ test link-2.9 {writing C variables from Tcl} -constraints {testlink} -setup {
set uwide 0
concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
} -result {0 5000.0 0 0 0 0 0 0 0 0 0 0 -60.0 0 | 0 5000e 0 0 0 0 0 0 0 0 0 0 -60.00e+ 0}
+test link-2.10 {writing C variables from Tcl} -constraints {testlink} -setup {
+ testlink delete
+} -body {
+ testlink set 43 1.21 4 - 56785678 64 250 30000 60000 0xbaadbeef 12321 32123 3.25 1231231234
+ testlink create 1 1 1 1 1 1 1 1 1 1 1 1 1 1
+ set int "0x"
+ set real "0b"
+ set bool 0
+ set string "0"
+ set wide "0D"
+ set char "0X"
+ set uchar "0B"
+ set short "0D"
+ set ushort "0x"
+ set uint "0b"
+ set long "0d"
+ set ulong "0X"
+ set float "0B"
+ set uwide "0D"
+ concat [testlink get] | $int $real $bool $string $wide $char $uchar $short $ushort $uint $long $ulong $float $uwide
+} -result {0 0.0 0 0 0 0 0 0 0 0 0 0 0.0 0 | 0x 0b 0 0 0D 0X 0B 0D 0x 0b 0d 0X 0B 0D}
test link-3.1 {read-only variables} -constraints {testlink} -setup {
testlink delete
diff --git a/tests/lmap.test b/tests/lmap.test
index 08035d9..641eac2 100644
--- a/tests/lmap.test
+++ b/tests/lmap.test
@@ -220,10 +220,10 @@ test lmap-4.14 {lmap errors} -returnCodes error -body {
} -result {list element in braces followed by "3" instead of space}
unset -nocomplain a
test lmap-4.15 {lmap errors} {
- apply {{} {
+ apply {{} {
set a(0) 44
- list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
- }}
+ list [catch {lmap a {1 2 3} {}} msg o] $msg $::errorInfo
+ }}
} {1 {can't set "a": variable is array} {can't set "a": variable is array
while executing
"lmap a {1 2 3} {}"}}
diff --git a/tests/lpop.test b/tests/lpop.test
new file mode 100644
index 0000000..089299b
--- /dev/null
+++ b/tests/lpop.test
@@ -0,0 +1,140 @@
+# Commands covered: lpop
+#
+# This file contains a collection of tests for one or more of the Tcl
+# built-in commands. Sourcing this file into Tcl runs the tests and
+# generates output for errors. No output means no errors were found.
+#
+# Copyright (c) 1991-1993 The Regents of the University of California.
+# Copyright (c) 1994 Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+test lpop-1.1 {error conditions} -returnCodes error -body {
+ lpop no
+} -result {can't read "no": no such variable}
+test lpop-1.2 {error conditions} -returnCodes error -body {
+ lpop no 0
+} -result {can't read "no": no such variable}
+test lpop-1.3 {error conditions} -returnCodes error -body {
+ set no "x {}x"
+ lpop no
+} -result {list element in braces followed by "x" instead of space}
+test lpop-1.4 {error conditions} -returnCodes error -body {
+ set no "x y"
+ lpop no -1
+} -result {list index out of range}
+test lpop-1.5 {error conditions} -returnCodes error -body {
+ set no "x y z"
+ lpop no 3
+} -result {list index out of range} ;#-errorCode {TCL OPERATION LPOP BADINDEX}
+test lpop-1.6 {error conditions} -returnCodes error -body {
+ set no "x y"
+ lpop no end+1
+} -result {list index out of range}
+test lpop-1.7 {error conditions} -returnCodes error -body {
+ set no "x y"
+ lpop no {}
+} -match glob -result {bad index *}
+test lpop-1.8 {error conditions} -returnCodes error -body {
+ set no "x y"
+ lpop no 0 0 0 0 1
+} -result {list index out of range}
+test lpop-1.9 {error conditions} -returnCodes error -body {
+ set no "x y"
+ lpop no {1 0}
+} -match glob -result {bad index *}
+
+test lpop-2.1 {basic functionality} -body {
+ set l "x y z"
+ list [lpop l 0] $l
+} -result {x {y z}}
+test lpop-2.2 {basic functionality} -body {
+ set l "x y z"
+ list [lpop l 1] $l
+} -result {y {x z}}
+test lpop-2.3 {basic functionality} -body {
+ set l "x y z"
+ list [lpop l] $l
+} -result {z {x y}}
+test lpop-2.4 {basic functionality} -body {
+ set l "x y z"
+ set l2 $l
+ list [lpop l] $l $l2
+} -result {z {x y} {x y z}}
+
+test lpop-3.1 {nested} -body {
+ set l "x y"
+ set l2 $l
+ list [lpop l 0 0 0 0] $l $l2
+} -result {x {{{{}}} y} {x y}}
+test lpop-3.2 {nested} -body {
+ set l "{x y} {a b}"
+ list [lpop l 0 1] $l
+} -result {y {x {a b}}}
+test lpop-3.3 {nested} -body {
+ set l "{x y} {a b}"
+ list [lpop l 1 0] $l
+} -result {a {{x y} b}}
+
+
+
+
+
+test lpop-99.1 {performance} -constraints perf -body {
+ set l [lrepeat 10000 x]
+ set l2 $l
+ set t1 [time {
+ while {[llength $l] >= 2} {
+ lpop l end
+ }
+ }]
+ set l [lrepeat 30000 x]
+ set l2 $l
+ set t2 [time {
+ while {[llength $l] >= 2} {
+ lpop l end
+ }
+ }]
+ regexp {\d+} $t1 ms1
+ regexp {\d+} $t2 ms2
+ set ratio [expr {double($ms2)/$ms1}]
+ # Deleting from end should have linear performance
+ expr {$ratio > 4 ? $ratio : 4}
+} -result {4}
+
+test lpop-99.2 {performance} -constraints perf -body {
+ set l [lrepeat 10000 x]
+ set l2 $l
+ set t1 [time {
+ while {[llength $l] >= 2} {
+ lpop l 1
+ }
+ }]
+ set l [lrepeat 30000 x]
+ set l2 $l
+ set t2 [time {
+ while {[llength $l] >= 2} {
+ lpop l 1
+ }
+ }]
+ regexp {\d+} $t1 ms1
+ regexp {\d+} $t2 ms2
+ set ratio [expr {double($ms2)/$ms1}]
+ expr {$ratio > 10 ? $ratio : 10}
+} -result {10}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/lrange.test b/tests/lrange.test
index 5bb4ee9..dcc0eec 100644
--- a/tests/lrange.test
+++ b/tests/lrange.test
@@ -69,7 +69,7 @@ test lrange-1.15 {range of list elements} {
} {"a b \{\ "}
# emacs highlighting bug workaround --> "
test lrange-1.16 {list element quoting} {
- lrange {[append a .b]} 0 end
+ lrange {[append a .b]} 0 end
} {{[append} a .b\]}
test lrange-2.1 {error conditions} {
@@ -96,7 +96,6 @@ test lrange-3.1 {Bug 3588366: end-offsets before start} {
lrange $l 0 end-5
}} {1 2 3 4 5}
} {}
-
test lrange-3.2 {compiled with static indices out of range, negative} {
list [lrange {a b c} -1 -2] [lrange {a b c} -2 -1] [lrange {a b c} -3 -2] [lrange {a b c} -2 -3]
} [lrepeat 4 {}]
@@ -144,6 +143,107 @@ test lrange-3.7d.2 {not compiled on empty pure bytes object, 2nd regression test
[$cmd [testpurebytesobj] 0-1 end+1] [$cmd [testpurebytesobj { }] 0-1 end+1] [$cmd $a 0-1 end+1]
} [lrepeat 6 {}]
+test lrange-4.1 {lrange pure promise} -body {
+ set ll1 [list $tcl_version 2 3 4]
+ # Shared
+ set ll2 $ll1
+ # With string rep
+ string length $ll1
+ set rep1 [tcl::unsupported::representation $ll1]
+ # Get new pure object
+ set x [lrange $ll1 0 end]
+ set rep2 [tcl::unsupported::representation $x]
+ regexp {object pointer at (\S+)} $rep1 -> obj1
+ regexp {object pointer at (\S+)} $rep2 -> obj2
+ list $rep1 $rep2 [string equal $obj1 $obj2]
+ # Check for a new clean object
+} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0}
+
+test lrange-4.2 {lrange pure promise} -body {
+ set ll1 [list $tcl_version 2 3 4]
+ # Shared
+ set ll2 $ll1
+ # With string rep
+ string length $ll1
+ set rep1 [tcl::unsupported::representation $ll1]
+ # Get new pure object, not compiled
+ set x [[string cat l range] $ll1 0 end]
+ set rep2 [tcl::unsupported::representation $x]
+ regexp {object pointer at (\S+)} $rep1 -> obj1
+ regexp {object pointer at (\S+)} $rep2 -> obj2
+ list $rep1 $rep2 [string equal $obj1 $obj2]
+ # Check for a new clean object
+} -match glob -result {*value is *refcount of 3,*, string rep*value is*refcount of 2,* no string rep* 0}
+
+test lrange-4.3 {lrange pure promise} -body {
+ set ll1 [list $tcl_version 2 3 4]
+ # With string rep
+ string length $ll1
+ set rep1 [tcl::unsupported::representation $ll1]
+ # Get pure object, unshared
+ set ll2 [lrange $ll1[set ll1 {}] 0 end]
+ set rep2 [tcl::unsupported::representation $ll2]
+ regexp {object pointer at (\S+)} $rep1 -> obj1
+ regexp {object pointer at (\S+)} $rep2 -> obj2
+ list $rep1 $rep2 [string equal $obj1 $obj2]
+ # Internal optimisations should keep the same object
+} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1}
+
+test lrange-4.4 {lrange pure promise} -body {
+ set ll1 [list $tcl_version 2 3 4]
+ # With string rep
+ string length $ll1
+ set rep1 [tcl::unsupported::representation $ll1]
+ # Get pure object, unshared, not compiled
+ set ll2 [[string cat l range] $ll1[set ll1 {}] 0 end]
+ set rep2 [tcl::unsupported::representation $ll2]
+ regexp {object pointer at (\S+)} $rep1 -> obj1
+ regexp {object pointer at (\S+)} $rep2 -> obj2
+ list $rep1 $rep2 [string equal $obj1 $obj2]
+ # Internal optimisations should keep the same object
+} -match glob -result {*value is *refcount of 2,*, string rep*value is*refcount of 2,* no string rep* 1}
+
+# Testing for compiled vs non-compiled behaviour, and shared vs non-shared.
+# Far too many variations to check with spelt-out tests.
+# Note that this *just* checks whether the different versions are the same
+# not whether any of them is correct.
+apply {{} {
+ set lss {{} {a} {a b c} {a b c d}}
+ set idxs {-2 -1 0 1 2 3 end-3 end-2 end-1 end end+1 end+2}
+ set lrange lrange
+
+ foreach ls $lss {
+ foreach a $idxs {
+ foreach b $idxs {
+ # Shared, uncompiled
+ set ls2 $ls
+ set expected [list [catch {$lrange $ls $a $b} m] $m]
+ # Shared, compiled
+ set tester [list lrange $ls $a $b]
+ set script [list catch $tester m]
+ set script "list \[$script\] \$m"
+ test lrange-5.[incr n].1 {lrange shared compiled} \
+ [list apply [list {} $script]] $expected
+ # Unshared, uncompiled
+ set tester [string map [list %l [list $ls] %a $a %b $b] {
+ [string cat l range] [lrange %l 0 end] %a %b
+ }]
+ set script [list catch $tester m]
+ set script "list \[$script\] \$m"
+ test lrange-5.$n.2 {lrange unshared uncompiled} \
+ [list apply [list {} $script]] $expected
+ # Unshared, compiled
+ set tester [string map [list %l [list $ls] %a $a %b $b] {
+ lrange [lrange %l 0 end] %a %b
+ }]
+ set script [list catch $tester m]
+ set script "list \[$script\] \$m"
+ test lrange-5.$n.3 {lrange unshared compiled} \
+ [list apply [list {} $script]] $expected
+ }
+ }
+ }
+}}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/lrepeat.test b/tests/lrepeat.test
index 788bb9b..e89f1b7 100644
--- a/tests/lrepeat.test
+++ b/tests/lrepeat.test
@@ -40,7 +40,7 @@ test lrepeat-1.4 {error cases} {
lrepeat -3 1
}
-returnCodes 1
- -result {bad count "-3": must be integer >= 0}
+ -result {bad count "-3": must be integer >= 0}
}
test lrepeat-1.5 {Accept zero repetitions (TIP 323)} {
-body {
@@ -53,7 +53,7 @@ test lrepeat-1.6 {error cases} {
lrepeat 3.5 1
}
-returnCodes 1
- -result {expected integer but got "3.5"}
+ -result {expected integer but got "3.5"}
}
test lrepeat-1.7 {Accept zero repetitions (TIP 323)} {
-body {
diff --git a/tests/lsearch.test b/tests/lsearch.test
index 5e8a1f8..e401581 100644
--- a/tests/lsearch.test
+++ b/tests/lsearch.test
@@ -59,7 +59,7 @@ test lsearch-2.9 {search modes} {
} 1
test lsearch-2.10 {search modes} -returnCodes error -body {
lsearch -glib {b.x bx xy bcx} b.x
-} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+} -result {bad option "-glib": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-2.11 {search modes with -nocase} {
lsearch -exact -nocase {a b c A B C} A
} 0
@@ -87,10 +87,10 @@ test lsearch-3.2 {lsearch errors} -returnCodes error -body {
} -result {wrong # args: should be "lsearch ?-option value ...? list pattern"}
test lsearch-3.3 {lsearch errors} -returnCodes error -body {
lsearch a b c
-} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-3.4 {lsearch errors} -returnCodes error -body {
lsearch a b c d
-} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, or -subindices}
+} -result {bad option "a": must be -all, -ascii, -bisect, -decreasing, -dictionary, -exact, -glob, -increasing, -index, -inline, -integer, -nocase, -not, -real, -regexp, -sorted, -start, -stride, or -subindices}
test lsearch-3.5 {lsearch errors} -returnCodes error -body {
lsearch "\{" b
} -result {unmatched open brace in list}
@@ -404,16 +404,16 @@ test lsearch-17.2 {lsearch -index option, basic functionality} {
lsearch -index 1 -exact {{a c} {a b} {a a}} a
} 2
test lsearch-17.3 {lsearch -index option, basic functionality} {
- lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b*
+ lsearch -index 1 -glob {{ab cb} {ab bb} {ab ab}} b*
} 1
test lsearch-17.4 {lsearch -index option, basic functionality} {
lsearch -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
-} 0
+} 0
test lsearch-17.5 {lsearch -index option, basic functionality} {
lsearch -all -index 0 -exact {{a c} {a b} {d a}} a
} {0 1}
test lsearch-17.6 {lsearch -index option, basic functionality} {
- lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b*
+ lsearch -all -index 1 -glob {{ab cb} {ab bb} {db bx}} b*
} {1 2}
test lsearch-17.7 {lsearch -index option, basic functionality} {
lsearch -all -index 1 -regexp {{ab cb} {ab bb} {ab ab}} {[cb]b}
@@ -454,11 +454,11 @@ test lsearch-18.2 {lsearch -index option, list as index basic functionality} {
lsearch -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} 0
test lsearch-18.3 {lsearch -index option, list as index basic functionality} {
- lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
+ lsearch -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} 0
test lsearch-18.4 {lsearch -index option, list as index basic functionality} {
lsearch -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
-} 0
+} 0
test lsearch-18.5 {lsearch -index option, list as index basic functionality} {
lsearch -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {0 1}
@@ -470,14 +470,17 @@ test lsearch-19.2 {lsearch -subindices option} {
lsearch -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
} {0 2 0}
test lsearch-19.3 {lsearch -subindices option} {
- lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
+ lsearch -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
} {0 1 1}
test lsearch-19.4 {lsearch -subindices option} {
lsearch -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
-} {0 0 1}
+} {0 0 1}
test lsearch-19.5 {lsearch -subindices option} {
lsearch -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
} {{0 0 0} {1 0 0}}
+test lsearch-19.6 {lsearch -subindices option} {
+ lsearch -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
+} {{0 1 0} {1 1 0}}
test lsearch-19.7 {lsearch -subindices option} {
lsearch -subindices -index end {{1 a}} a
} {0 1}
@@ -543,6 +546,149 @@ test lsearch-22.5 {lsearch -bisect, all equal} {
test lsearch-22.6 {lsearch -sorted, all equal} {
lsearch -sorted -integer {5 5 5 5} 5
} {0}
+
+test lsearch-23.1 {lsearch -stride option, errors} -body {
+ lsearch -stride {a b} a
+} -returnCodes error -result {"-stride" option must be followed by stride length}
+test lsearch-23.2 {lsearch -stride option, errors} -body {
+ lsearch -stride 0 {a b} a
+} -returnCodes error -result {stride length must be at least 1}
+test lsearch-23.3 {lsearch -stride option, errors} -body {
+ lsearch -stride 2 {a b c} a
+} -returnCodes error -result {list size must be a multiple of the stride length}
+test lsearch-23.4 {lsearch -stride option, errors} -body {
+ lsearch -stride 5 {a b c} a
+} -returnCodes error -result {list size must be a multiple of the stride length}
+test lsearch-23.5 {lsearch -stride option, errors} -body {
+ # Stride equal to length is ok
+ lsearch -stride 3 {a b c} a
+} -result 0
+
+test lsearch-24.1 {lsearch -stride option} -body {
+ lsearch -stride 2 {a b c d e f g h} d
+} -result -1
+test lsearch-24.2 {lsearch -stride option} -body {
+ lsearch -stride 2 {a b c d e f g h} e
+} -result 4
+test lsearch-24.3 {lsearch -stride option} -body {
+ lsearch -stride 3 {a b c d e f g h i} e
+} -result -1
+test lsearch-24.4 {lsearch -stride option} -body {
+ # Result points first in group
+ lsearch -stride 3 -index 1 {a b c d e f g h i} e
+} -result 3
+test lsearch-24.5 {lsearch -stride option} -body {
+ lsearch -inline -stride 2 {a b c d e f g h} d
+} -result {}
+test lsearch-24.6 {lsearch -stride option} -body {
+ # Inline result is a "single element" strided list
+ lsearch -inline -stride 2 {a b c d e f g h} e
+} -result "e f"
+test lsearch-24.7 {lsearch -stride option} -body {
+ lsearch -inline -stride 3 {a b c d e f g h i} e
+} -result {}
+test lsearch-24.8 {lsearch -stride option} -body {
+ lsearch -inline -stride 3 -index 1 {a b c d e f g h i} e
+} -result "d e f"
+test lsearch-24.9 {lsearch -stride option} -body {
+ lsearch -all -inline -stride 3 -index 1 {a b c d e f g e i} e
+} -result "d e f g e i"
+test lsearch-24.10 {lsearch -stride option} -body {
+ lsearch -all -inline -stride 3 -index 0 {a b c d e f a e i} a
+} -result "a b c a e i"
+test lsearch-24.11 {lsearch -stride option} -body {
+ # Stride 1 is same as no stride
+ lsearch -stride 1 {a b c d e f g h} d
+} -result 3
+
+# 25* mimics 19* but with -inline added to -subindices
+test lsearch-25.1 {lsearch -subindices option} {
+ lsearch -inline -subindices -index {0 0} {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
+} {a}
+test lsearch-25.2 {lsearch -subindices option} {
+ lsearch -inline -subindices -index {2 0} -exact {{{x x} {x b} {a d}} {{a c} {a b} {a a}}} a
+} {a}
+test lsearch-25.3 {lsearch -subindices option} {
+ lsearch -inline -subindices -index {1 1} -glob {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} b*
+} {bb}
+test lsearch-25.4 {lsearch -subindices option} {
+ lsearch -inline -subindices -index {0 1} -regexp {{{ab cb} {ab bb} {ab ab}} {{ab cb} {ab bb} {ab ab}}} {[cb]b}
+} {cb}
+test lsearch-25.5 {lsearch -subindices option} {
+ lsearch -inline -subindices -all -index {0 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
+} {a a}
+test lsearch-25.6 {lsearch -subindices option} {
+ lsearch -inline -subindices -all -index {1 0} -exact {{{a c} {a b} {d a}} {{a c} {a b} {d a}}} a
+} {a a}
+
+# 26* mimics 19* but with -stride added
+test lsearch-26.1 {lsearch -stride + -subindices option} {
+ lsearch -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a
+} {3 0}
+test lsearch-26.2 {lsearch -stride + -subindices option} {
+ lsearch -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a
+} {2 0}
+test lsearch-26.3 {lsearch -stride + -subindices option} {
+ lsearch -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b*
+} {1 1}
+test lsearch-26.4 {lsearch -stride + -subindices option} {
+ lsearch -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b}
+} {0 1}
+test lsearch-26.5 {lsearch -stride + -subindices option} {
+ lsearch -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a
+} {{0 0} {3 0}}
+test lsearch-26.6 {lsearch -stride + -subindices option} {
+ lsearch -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
+} {{1 0} {4 0}}
+
+# 27* mimics 25* but with -stride added
+test lsearch-27.1 {lsearch -stride + -subindices option} {
+ lsearch -inline -stride 3 -subindices -index {0 0} {{x x} {x b} {a d} {a c} {a b} {a a}} a
+} {a}
+test lsearch-27.2 {lsearch -stride + -subindices option} {
+ lsearch -inline -stride 3 -subindices -index {2 0} -exact {{x x} {x b} {a d} {a c} {a b} {a a}} a
+} {a}
+test lsearch-27.3 {lsearch -stride + -subindices option} {
+ lsearch -inline -stride 3 -subindices -index {1 1} -glob {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} b*
+} {bb}
+test lsearch-27.4 {lsearch -stride + -subindices option} {
+ lsearch -inline -stride 3 -subindices -index {0 1} -regexp {{ab cb} {ab bb} {ab ab} {ab cb} {ab bb} {ab ab}} {[cb]b}
+} {cb}
+test lsearch-27.5 {lsearch -stride + -subindices option} {
+ lsearch -inline -stride 3 -subindices -all -index {0 0} -exact {{a c} {a b} {d a} {a c} {a b} {d a}} a
+} {a a}
+test lsearch-27.6 {lsearch -stride + -subindices option} {
+ lsearch -inline -stride 3 -subindices -all -index {1 0} -exact {{a c} {a b} {d a} {x c} {a b} {d a}} a
+} {a a}
+
+test lsearch-28.1 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 {5 3 7 8 9 2} 5
+} -result 0
+test lsearch-28.2 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 {5 3 7 8 9 2} 3
+} -result -1
+test lsearch-28.3 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 {5 3 7 8 9 2} 7
+} -result 2
+test lsearch-28.4 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 {5 3 7 8 9 2} 8
+} -result -1
+test lsearch-28.5 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 {5 3 7 8 9 2} 9
+} -result 4
+test lsearch-28.6 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 {5 3 7 8 9 2} 2
+} -result -1
+test lsearch-28.7 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 -index 0 -subindices {5 3 7 8 9 2} 9
+} -result 4
+test lsearch-28.8 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 -index 1 -subindices {3 5 8 7 2 9} 9
+} -result 5
+test lsearch-28.9 {lsearch -sorted with -stride} -body {
+ lsearch -sorted -stride 2 -index 1 -subindices -inline {3 5 8 7 2 9} 9
+} -result 9
+
# cleanup
catch {unset res}
diff --git a/tests/lsetComp.test b/tests/lsetComp.test
index 6846cbf..6330de4 100644
--- a/tests/lsetComp.test
+++ b/tests/lsetComp.test
@@ -22,7 +22,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
proc evalInProc { script } {
proc testProc {} $script
set status [catch {
- testProc
+ testProc
} result]
rename testProc {}
return [list $status $result]
@@ -60,69 +60,69 @@ test lsetComp-2.3 {lset, compiled, list of args, scalar, one-byte offset} {
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 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
@@ -145,69 +145,69 @@ test lsetComp-2.6 {lset, compiled, list of args, array, one-byte offset} {
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 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
@@ -253,69 +253,69 @@ test lsetComp-3.3 {lset, compiled, flat args, scalar, one-byte offset} {
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 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
@@ -338,69 +338,69 @@ test lsetComp-3.6 {lset, compiled, flat args, array, one-byte offset} {
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 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
diff --git a/tests/main.test b/tests/main.test
index b0edb84..5b43b43 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -16,7 +16,7 @@ namespace eval ::tcl::test::main {
# - tests use testing commands introduced in Tcltest 8.4
testConstraint Tcltest [expr {
[llength [package provide Tcltest]]
- && [package vsatisfies [package provide Tcltest] 8.4]}]
+ && [package vsatisfies [package provide Tcltest] 8.5-]}]
# Procedure to simulate interactive typing of commands, line by line
proc type {chan script} {
@@ -719,7 +719,7 @@ namespace eval ::tcl::test::main {
} -result "Exit MainLoop\nIn exit\neven 0\n"
test Tcl_Main-5.9 {
- Tcl_Main: interactive mode: delete interp
+ Tcl_Main: interactive mode: delete interp
-> main loop & exit handlers, but no [exit]
} -constraints {
exec Tcltest
diff --git a/tests/mathop.test b/tests/mathop.test
index f122b7b..a1a3f80 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -1206,6 +1206,8 @@ test mathop-25.5 { exp operator } {TestOp ** 1 5} 1
test mathop-25.6 { exp operator } {TestOp ** 5 1} 5
test mathop-25.7 { exp operator } {TestOp ** 4 3 2 1} 262144
test mathop-25.8 { exp operator } {TestOp ** 5.5 4} 915.0625
+test mathop-25.8a { exp operator } {TestOp ** 4.0 -1} 0.25
+test mathop-25.8b { exp operator } {TestOp ** 2.0 -2} 0.25
test mathop-25.9 { exp operator } {TestOp ** 16 3.5} 16384.0
test mathop-25.10 { exp operator } {TestOp ** 3.5 0} 1.0
test mathop-25.11 { exp operator } {TestOp ** 378 0} 1
@@ -1219,8 +1221,32 @@ test mathop-25.18 { exp operator } {TestOp ** -1 -2} 1
test mathop-25.19 { exp operator } {TestOp ** -1 3} -1
test mathop-25.20 { exp operator } {TestOp ** -1 4} 1
test mathop-25.21 { exp operator } {TestOp ** 2 63} 9223372036854775808
-test mathop-25.22 { exp operator } {TestOp ** 83756485763458746358734658473567847567473 2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729
-test mathop-25.23 { exp operator errors } {
+test mathop-25.22 { exp operator } {TestOp ** 2 256} 115792089237316195423570985008687907853269984665640564039457584007913129639936
+set big 83756485763458746358734658473567847567473
+test mathop-25.23 { exp operator } {TestOp ** $big 2} 7015148907444467657897585474493757781161998914521537835809623408157343003287605729
+test mathop-25.24 { exp operator } {TestOp ** $big 0} 1
+test mathop-25.25 { exp operator } {TestOp ** $big 1} $big
+test mathop-25.26 { exp operator } {TestOp ** $big -1} 0
+test mathop-25.27 { exp operator } {TestOp ** $big -2} 0
+test mathop-25.28 { exp operator } {TestOp ** $big -$big} 0
+test mathop-25.29 { exp operator } {expr {[set res [TestOp ** $big -1.0]] > 0 && $res < 1.2e-41}} 1
+test mathop-25.30 { exp operator } {expr {[set res [TestOp ** $big -1e-18]] > 0 && $res < 1}} 1
+test mathop-25.31 { exp operator } {expr {[set res [TestOp ** -$big -1.0]] > -1 && $res < 0}} 1
+test mathop-25.32 { exp operator } {expr {[set res [TestOp ** -$big -2.0]] > 0 && $res < 1}} 1
+test mathop-25.33 { exp operator } {expr {[set res [TestOp ** -$big -3.0]] > -1 && $res < 0}} 1
+test mathop-25.34 { exp operator } {TestOp ** $big -1e-30} 1.0
+test mathop-25.35 { exp operator } {TestOp ** $big -1e+30} 0.0
+test mathop-25.36 { exp operator } {TestOp ** 0 $big} 0
+test mathop-25.37 { exp operator } {TestOp ** 1 $big} 1
+test mathop-25.38 { exp operator } {TestOp ** -1 $big} -1
+test mathop-25.39 { exp operator } {TestOp ** -1 [expr {$big+1}]} 1
+test mathop-25.40 { exp operator (small exponent power helper and its boundaries) } {
+ set pwr 0
+ set res 1
+ while {[incr pwr] <= 17 && [set i [TestOp ** 15 $pwr]] == [set res [expr {$res * 15}]]} {}
+ list [incr pwr -1] $res
+} {17 98526125335693359375}
+test mathop-25.41 { exp operator errors } {
set res {}
set exp {}
diff --git a/tests/misc.test b/tests/misc.test
index d4ece74..db8b14a 100644
--- a/tests/misc.test
+++ b/tests/misc.test
@@ -25,7 +25,7 @@ testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]
test misc-1.1 {error in variable ref. in command in array reference} {
proc tstProc {} {
global a
-
+
set tst $a([winfo name $zz])
# this is a bogus comment
# this is a bogus comment
@@ -42,7 +42,7 @@ test misc-1.1 {error in variable ref. in command in array reference} {
test misc-1.2 {error in variable ref. in command in array reference} {
proc tstProc {} "
global a
-
+
set tst \$a(\[winfo name \$\{zz)
# this is a bogus comment
# this is a bogus comment
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 1c3ce58..4ab3622 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -55,8 +55,13 @@ namespace eval ::msgcat::test {
set result [string tolower [lindex $setVars 0]]
if {[string length $result] == 0} {
if {[info exists ::tcl::mac::locale]} {
+if {[package vsatisfies [package provide msgcat] 1.7]} {
+ set result [string tolower \
+ [msgcat::mcutil::ConvertLocale $::tcl::mac::locale]]
+} else {
set result [string tolower \
[msgcat::ConvertLocale $::tcl::mac::locale]]
+}
} else {
if {([info sharedlibextension] eq ".dll")
&& ![catch {package require registry}]} {
@@ -194,6 +199,28 @@ namespace eval ::msgcat::test {
mclocale looks/ok/../../../../but/is/path/to/evil/code
} -returnCodes error -match glob -result {invalid newLocale value *}
+ test msgcat-1.14 {mcpreferences, custom locale preferences} -setup {
+ variable locale [mclocale]
+ mclocale en
+ mcpreferences fr en {}
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcpreferences
+ } -result {fr en {}}
+
+ test msgcat-1.15 {mcpreferences, overwrite custom locale preferences}\
+ -setup {
+ variable locale [mclocale]
+ mcpreferences fr en {}
+ mclocale en
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ mcpreferences
+ } -result {en {}}
+
+
# Tests msgcat-2.*: [mcset], [mcmset], namespace partitioning
test msgcat-2.1 {mcset, global scope} {
@@ -666,18 +693,18 @@ namespace eval ::msgcat::test {
set msgdir3 [makeDirectory msgdir3]
makeFile "::msgcat::mcflset k2 v2 ; ::msgcat::mcload [list $msgdir3]"\
l2.msg $msgdir2
- makeFile {::msgcat::mcflset k3 v3} l2.msg $msgdir3
+ makeFile {::msgcat::mcflset k3 v3 ; ::msgcat::mcflmset {k4 v4 k5 v5}} l2.msg $msgdir3
# chained mcload
- test msgcat-8.2 {mcflset} -setup {
+ test msgcat-8.2 {mcflset/mcflmset} -setup {
variable locale [mclocale]
mclocale l2
mcload $msgdir2
} -cleanup {
mclocale $locale
} -body {
- return [mc k2][mc k3]
- } -result v2v3
+ return [mc k2][mc k3]--[mc k4][mc k5]
+ } -result v2v3--v4v5
removeFile l2.msg $msgdir2
removeDirectory msgdir2
@@ -688,7 +715,7 @@ namespace eval ::msgcat::test {
test msgcat-9.1 {mcexists no parameter} -body {
mcexists
} -returnCodes 1\
- -result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? src"}
+ -result {wrong # args: should be "mcexists ?-exactnamespace? ?-exactlocale? ?-namespace ns? src"}
test msgcat-9.2 {mcexists unknown option} -body {
mcexists -unknown src
@@ -724,12 +751,34 @@ namespace eval ::msgcat::test {
mcset foo k1 v1
} -cleanup {
mclocale $locale
+ namespace delete ::foo
} -body {
- namespace eval ::msgcat::test::sub {
+ namespace eval ::foo {
list [::msgcat::mcexists k1]\
- [::msgcat::mcexists -exactnamespace k1]
+ [::msgcat::mcexists -namespace ::msgcat::test k1]
}
- } -result {1 0}
+ } -result {0 1}
+
+ test msgcat-9.6 {mcexists -namespace ns parameter} -setup {
+ mcforgetpackage
+ variable locale [mclocale]
+ mclocale foo_bar
+ mcset foo k1 v1
+ } -cleanup {
+ mclocale $locale
+ namespace delete ::foo
+ } -body {
+ namespace eval ::foo {
+ list [::msgcat::mcexists k1]\
+ [::msgcat::mcexists -namespace ::msgcat::test k1]
+ }
+ } -result {0 1}
+
+ test msgcat-9.7 {mcexists -namespace - ns argument missing} -body {
+ mcexists -namespace src
+ } -returnCodes 1\
+ -result {Argument missing for switch "-namespace"}
+
# Tests msgcat-10.*: [mcloadedlocales]
@@ -811,13 +860,18 @@ namespace eval ::msgcat::test {
test msgcat-12.1 {mcpackagelocale no subcommand} -body {
mcpackagelocale
} -returnCodes 1\
- -result {wrong # args: should be "mcpackagelocale subcommand ?locale?"}
+ -result {wrong # args: should be "mcpackagelocale subcommand ?arg ...?"}
test msgcat-12.2 {mclpackagelocale wrong subcommand} -body {
mcpackagelocale junk
} -returnCodes 1\
-result {unknown subcommand "junk": must be clear, get, isset, loaded, present, set, or unset}
+ test msgcat-12.2.1 {mclpackagelocale set multiple args} -body {
+ mcpackagelocale set a b
+ } -returnCodes 1\
+ -result {wrong # args: should be "mcpackagelocale set ?locale?"}
+
test msgcat-12.3 {mcpackagelocale set} -setup {
variable locale [mclocale]
} -cleanup {
@@ -922,6 +976,30 @@ namespace eval ::msgcat::test {
list [mcpackagelocale present foo] [mcpackagelocale present bar]
} -result {0 1}
+ test msgcat-12.11 {mcpackagelocale custom preferences} -setup {
+ variable locale [mclocale]
+ } -cleanup {
+ mclocale $locale
+ mcforgetpackage
+ } -body {
+ mclocale foo
+ set res [list [mcpackagelocale preferences]]
+ mcpackagelocale preferences bar {}
+ lappend res [mcpackagelocale preferences]
+ } -result {{foo {}} {bar {}}}
+
+ test msgcat-12.12 {mcpackagelocale preferences -> no isset} -setup {
+ variable locale [mclocale]
+ } -cleanup {
+ mclocale $locale
+ mcforgetpackage
+ } -body {
+ mclocale foo
+ mcpackagelocale preferences
+ mcpackagelocale isset
+ } -result {0}
+
+
# Tests msgcat-13.*: [mcpackageconfig subcmds]
test msgcat-13.1 {mcpackageconfig no subcommand} -body {
@@ -1073,8 +1151,212 @@ namespace eval ::msgcat::test {
} -returnCodes 1\
-result {fail}
+
+ # Tests msgcat-15.*: tcloo coverage
+
+ # There are 4 use-cases, where 3 must be tested now:
+ # - namespace defined, in class definition, class defined oo, classless
+
+ test msgcat-15.1 {mc in class setup} -setup {
+ # full namespace is ::msgcat::test:bar
+ namespace eval bar {
+ ::msgcat::mcset foo_BAR con2 con2bar
+ oo::class create ClassCur
+ }
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ namespace eval bar {::msgcat::mcforgetpackage}
+ namespace delete bar
+ } -body {
+ oo::define bar::ClassCur msgcat::mc con2
+ } -result con2bar
+
+ test msgcat-15.2 {mc in class} -setup {
+ # full namespace is ::msgcat::test:bar
+ namespace eval bar {
+ ::msgcat::mcset foo_BAR con2 con2bar
+ oo::class create ClassCur
+ oo::define ClassCur method method1 {} {::msgcat::mc con2}
+ }
+ # full namespace is ::msgcat::test:baz
+ namespace eval baz {
+ set ObjCur [::msgcat::test::bar::ClassCur new]
+ }
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ namespace eval bar {::msgcat::mcforgetpackage}
+ namespace delete bar baz
+ } -body {
+ $baz::ObjCur method1
+ } -result con2bar
+
+ test msgcat-15.3 {mc in classless object} -setup {
+ # full namespace is ::msgcat::test:bar
+ namespace eval bar {
+ ::msgcat::mcset foo_BAR con2 con2bar
+ oo::object create ObjCur
+ oo::objdefine ObjCur method method1 {} {::msgcat::mc con2}
+ }
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ namespace eval bar {::msgcat::mcforgetpackage}
+ namespace delete bar
+ } -body {
+ bar::ObjCur method1
+ } -result con2bar
+
+ test msgcat-15.4 {mc in classless object with explicite namespace eval}\
+ -setup {
+ # full namespace is ::msgcat::test:bar
+ namespace eval bar {
+ ::msgcat::mcset foo_BAR con2 con2bar
+ oo::object create ObjCur
+ oo::objdefine ObjCur method method1 {} {
+ namespace eval ::msgcat::test::baz {
+ ::msgcat::mc con2
+ }
+ }
+ }
+ namespace eval baz {
+ ::msgcat::mcset foo_BAR con2 con2baz
+ }
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ namespace eval bar {::msgcat::mcforgetpackage}
+ namespace eval baz {::msgcat::mcforgetpackage}
+ namespace delete bar baz
+ } -body {
+ bar::ObjCur method1
+ } -result con2baz
+
+ # Test msgcat-16.*: command mcpackagenamespaceget
+
+ test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body {
+ namespace eval baz {msgcat::mcpackagenamespaceget}
+ } -result ::msgcat::test::baz
+
+ test msgcat-16.2 {mcpackagenamespaceget in class setup} -setup {
+ namespace eval bar {
+ oo::class create ClassCur
+ oo::define ClassCur variable a
+ }
+ } -cleanup {
+ namespace delete bar
+ } -body {
+ oo::define bar::ClassCur msgcat::mcpackagenamespaceget
+ } -result ::msgcat::test::bar
+
+ test msgcat-16.3 {mcpackagenamespaceget in class} -setup {
+ namespace eval bar {
+ oo::class create ClassCur
+ oo::define ClassCur method method1 {} {msgcat::mcpackagenamespaceget}
+ }
+ namespace eval baz {
+ set ObjCur [::msgcat::test::bar::ClassCur new]
+ }
+ } -cleanup {
+ namespace delete bar baz
+ } -body {
+ $baz::ObjCur method1
+ } -result ::msgcat::test::bar
+
+ test msgcat-16.4 {mcpackagenamespaceget in classless object} -setup {
+ namespace eval bar {
+ oo::object create ObjCur
+ oo::objdefine ObjCur method method1 {} {msgcat::mcpackagenamespaceget}
+ }
+ } -cleanup {
+ namespace delete bar
+ } -body {
+ bar::ObjCur method1
+ } -result ::msgcat::test::bar
+
+ test msgcat-16.5\
+ {mcpackagenamespaceget in classless object with explicite namespace eval}\
+ -setup {
+ namespace eval bar {
+ oo::object create ObjCur
+ oo::objdefine ObjCur method method1 {} {
+ namespace eval ::msgcat::test::baz {
+ msgcat::mcpackagenamespaceget
+ }
+ }
+ }
+ } -cleanup {
+ namespace delete bar baz
+ } -body {
+ bar::ObjCur method1
+ } -result ::msgcat::test::baz
+
+
+ # Test msgcat-17.*: mcn command
+
+ test msgcat-17.1 {mcn no parameters} -body {
+ mcn
+ } -returnCodes 1\
+ -result {wrong # args: should be "mcn ns src ?arg ...?"}
+
+ test msgcat-17.2 {mcn} -setup {
+ namespace eval bar {::msgcat::mcset foo_BAR con1 con1bar}
+ variable locale [mclocale]
+ mclocale foo_BAR
+ } -cleanup {
+ mclocale $locale
+ } -body {
+ ::msgcat::mcn [namespace current]::bar con1
+ } -result con1bar
+
+
interp bgerror {} $bgerrorsaved
+ # Tests msgcat-18.*: [mcutil]
+
+ test msgcat-18.1 {mcutil - no argument} -body {
+ mcutil
+ } -returnCodes 1\
+ -result {wrong # args: should be "mcutil subcommand ?arg ...?"}
+
+ test msgcat-18.2 {mcutil - wrong argument} -body {
+ mcutil junk
+ } -returnCodes 1\
+ -result {unknown subcommand "junk": must be getpreferences, or getsystemlocale}
+
+ test msgcat-18.3 {mcutil - partial argument} -body {
+ mcutil getsystem
+ } -returnCodes 1\
+ -result {unknown subcommand "getsystem": must be getpreferences, or getsystemlocale}
+
+ test msgcat-18.4 {mcutil getpreferences - no argument} -body {
+ mcutil getpreferences
+ } -returnCodes 1\
+ -result {wrong # args: should be "mcutil getpreferences locale"}
+
+ test msgcat-18.5 {mcutil getpreferences - DE_de} -body {
+ mcutil getpreferences DE_de
+ } -result {de_de de {}}
+
+ test msgcat-18.6 {mcutil getsystemlocale - wrong argument} -body {
+ mcutil getsystemlocale DE_de
+ } -returnCodes 1\
+ -result {wrong # args: should be "mcutil getsystemlocale"}
+
+ # The result is system dependent
+ # So just test if it runs
+ # The environment variable version was test with test 0.x
+ test msgcat-18.7 {mcutil getsystemlocale} -body {
+ mcutil getsystemlocale
+ set ok ok
+ } -result {ok}
+
+
cleanupTests
}
namespace delete ::msgcat::test
diff --git a/tests/namespace.test b/tests/namespace.test
index 1d26512..606139f 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -56,7 +56,7 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} {
test namespace-3.1 {Tcl_GetGlobalNamespace} {
namespace eval test_ns_1 {namespace eval foo {namespace eval bar {} } }
- # namespace children uses Tcl_GetGlobalNamespace
+ # namespace children uses Tcl_GetGlobalNamespace
namespace eval test_ns_1 {namespace children foo b*}
} {::test_ns_1::foo::bar}
@@ -108,7 +108,7 @@ test namespace-6.2 {Tcl_CreateNamespace, odd number of :'s in name is okay} {
[namespace eval test_ns_2:::::foo {namespace current}]
} {::test_ns_1::foo ::test_ns_2::foo}
test namespace-6.3 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
- list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
+ list [catch {namespace eval test_ns_7::: {namespace current}} msg] $msg
} {0 ::test_ns_7}
test namespace-6.4 {Tcl_CreateNamespace, trailing ::s in ns name are ignored} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -205,7 +205,7 @@ test namespace-7.8 {Bug ba1419303b4c} -setup {
namespace delete ns1
}
} -body {
- # No segmentation fault given --enable-symbols=mem.
+ # No segmentation fault given --enable-symbols=mem.
namespace delete ns1
} -result {}
@@ -278,7 +278,7 @@ test namespace-8.5 {TclTeardownNamespace: preserve errorInfo; errorCode values}
invoked from within
"slave eval error foo bar baz"}
test namespace-8.6 {TclTeardownNamespace: preserve errorInfo; errorCode values} {
- interp create slave
+ interp create slave
slave eval {trace add variable errorCode write {namespace delete :: ;#}}
catch {slave eval error foo bar baz}
interp delete slave
@@ -1098,17 +1098,17 @@ test namespace-22.5 {NamespaceCodeCmd, in other namespace} {
namespace code 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-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-22.7 {NamespaceCodeCmd, Bug 3202171} {
namespace eval demo {
proc namespace args {puts $args}
@@ -1659,7 +1659,7 @@ test namespace-40.1 {Ignoring namespace proc "unknown"} -setup {
namespace eval ns {proc unknown args {return local}}
list [namespace eval ns aaa bbb] [namespace eval ns aaa]
} -cleanup {
- rename unknown {}
+ rename unknown {}
rename _unknown unknown
namespace delete ns
} -result {global global}
@@ -1670,7 +1670,7 @@ test namespace-41.1 {Shadowing byte-compiled commands, Bug: 231259} {
set res {}
proc test {} {
set ::g 0
- }
+ }
lappend ::res [test]
proc set {a b} {
::set a [incr b]
diff --git a/tests/nre.test b/tests/nre.test
index 09061d2..58f5511 100644
--- a/tests/nre.test
+++ b/tests/nre.test
@@ -29,9 +29,9 @@ if {[testConstraint testnrelevels]} {
namespace path ::tcl::mathop
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
- # cmdFrame level, callFrame level, tosPtr and callback depth
+ # cmdFrame level, callFrame level, tosPtr and callback depth
#
- variable last [testnrelevels]
+ variable last [testnrelevels]
proc depthDiff {} {
variable last
set depth [testnrelevels]
@@ -329,7 +329,7 @@ test nre-8.1 {nre and {*}} -body {
} -cleanup {
rename inner {}
rename outer {}
-} -result {1 1 1}
+} -result {1 1 1}
test nre-8.2 {nre and {*}, [Bug 2415422]} -body {
# force an expansion that grows the evaluation stack, check that nre
# adapts the bcFramePtr. This causes an NRE assertion to fail if it is not
diff --git a/tests/obj.test b/tests/obj.test
index 7273b40..87c8d08 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -20,18 +20,16 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testobj [llength [info commands testobj]]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
set r 1
foreach {t} {
- {array search}
bytearray
bytecode
cmdName
dict
- end-offset
regexp
string
} {
@@ -53,15 +51,6 @@ test obj-2.2 {Tcl_GetObjType and Tcl_ConvertToType} testobj {
lappend result [testobj refcount 1]
} {{} 12 12 bytearray 3}
-test obj-3.1 {Tcl_ConvertToType error} testobj {
- list [testdoubleobj set 1 12.34] \
- [catch {testobj convert 1 end-offset} msg] \
- $msg
-} {12.34 1 {bad index "12.34": must be end?[+-]integer?}}
-test obj-3.2 {Tcl_ConvertToType error, "empty string" object} testobj {
- list [testobj newobj 1] [catch {testobj convert 1 end-offset} msg] $msg
-} {{} 1 {bad index "": must be end?[+-]integer?}}
-
test obj-4.1 {Tcl_NewObj and AllocateFreeObjects} testobj {
set result ""
lappend result [testobj freeallvars]
@@ -82,7 +71,7 @@ test obj-6.1 {Tcl_DuplicateObj, object has internal rep} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testintobj set 1 47]
- lappend result [testobj duplicate 1 2]
+ lappend result [testobj duplicate 1 2]
lappend result [testintobj get 2]
lappend result [testobj refcount 1]
lappend result [testobj refcount 2]
@@ -91,7 +80,7 @@ test obj-6.2 {Tcl_DuplicateObj, "empty string" object} testobj {
set result ""
lappend result [testobj freeallvars]
lappend result [testobj newobj 1]
- lappend result [testobj duplicate 1 2]
+ lappend result [testobj duplicate 1 2]
lappend result [testintobj get 2]
lappend result [testobj refcount 1]
lappend result [testobj refcount 2]
@@ -551,44 +540,6 @@ test obj-30.1 {Ref counting and object deletion, simple types} testobj {
lappend result [testobj refcount 2]
} {{} 1024 1024 int 4 4 0 int 3 2}
-
-test obj-31.1 {regenerate string rep of "end"} testobj {
- 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 {
- 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 {
- 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 {
- 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 {
- 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"} {testobj longIs32bit} {
- testobj freeallvars
- teststringobj set 1 end--0x80000000
- testobj convert 1 end-offset
- testobj invalidateStringRep 1
-} end--2147483648
-
test obj-32.1 {freeing very large object trees} {
set x {}
for {set i 0} {$i<100000} {incr i} {
@@ -597,34 +548,34 @@ test obj-32.1 {freeing very large object trees} {
unset x
} {}
-test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} {
set x 0x8000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {1 2147483648}
-test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} {
set x 0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 4294967295}
test obj-33.3 {integer overflow on input} {
set x 0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
-} {0 4294967296}
-test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+} {1 4294967296}
+test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} {
set x -0x8000; append x 0000
list [string is integer $x] [expr { wide($x) }]
} {1 -2147483648}
-test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} {
set x -0x8000; append x 0001
list [string is integer $x] [expr { wide($x) }]
} {1 -2147483649}
-test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} {
set x -0xffff; append x ffff
list [string is integer $x] [expr { wide($x) }]
} {1 -4294967295}
test obj-33.7 {integer overflow on input} {
set x -0x10000; append x 0000
list [string is integer $x] [expr { wide($x) }]
-} {0 -4294967296}
+} {1 -4294967296}
test obj-34.1 {mp_iseven} testobj {
set result ""
diff --git a/tests/oo.test b/tests/oo.test
index db5c14f..0f8cd47 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -13,13 +13,11 @@ if {"::tcltest" in [namespace children]} {
namespace import -force ::tcltest::*
}
-
# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in
# this test suite, interp creation and interp deletion are often used in
# leaktests in order to leverage this sensitivity.
-
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
proc getbytes {} {
@@ -131,18 +129,18 @@ test oo-1.1 {basic test of OO functionality: no classes} {
} {::foo {} a b c 3 {} {}}
test oo-1.2 {basic test of OO functionality: no classes} -body {
oo::define oo::object method missingArgs
-} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name args body\""
+} -returnCodes 1 -result "wrong # args: should be \"oo::define oo::object method name ?option? args body\""
test oo-1.3 {basic test of OO functionality: no classes} {
catch {oo::define oo::object method missingArgs}
set errorInfo
-} "wrong # args: should be \"oo::define oo::object method name args body\"
+} "wrong # args: should be \"oo::define oo::object method name ?option? args body\"
while executing
\"oo::define oo::object method missingArgs\""
test oo-1.4 {basic test of OO functionality} -body {
oo::object create {}
} -returnCodes 1 -result {object name must not be empty}
test oo-1.4.1 {fully-qualified nested name} -body {
- oo::object create ::one::two::three
+ oo::object create ::one::two::three
} -result {::one::two::three}
test oo-1.4.2 {automatic command name has same name as namespace} -body {
set obj [oo::object new]
@@ -314,7 +312,7 @@ test oo-1.18.3 {Bug 21c144f0f5} -setup {
}
} -cleanup {
interp delete slave
-}
+}
test oo-1.19 {basic test of OO functionality: teardown order} -body {
oo::object create o
namespace delete [info object namespace o]
@@ -331,19 +329,20 @@ test oo-1.21 {basic test of OO functionality: default relations} -setup {
set fresh [interp create]
} -body {
lmap x [$fresh eval {
+ set initials {::oo::object ::oo::class ::oo::Slot}
foreach cmd {instances subclasses mixins superclass} {
- foreach initial {object class Slot} {
- lappend x [info class $cmd ::oo::$initial]
+ foreach initial $initials {
+ lappend x [info class $cmd $initial]
}
}
- foreach initial {object class Slot} {
- lappend x [info object class ::oo::$initial]
+ foreach initial $initials {
+ lappend x [info object class $initial]
}
return $x
- }] {lsort $x}
+ }] {lsort [lsearch -all -not -inline $x *::delegate]}
} -cleanup {
interp delete $fresh
-} -result {{} {::oo::Slot ::oo::class ::oo::object} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
+} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
test oo-2.1 {basic test of OO functionality: constructor} -setup {
# This is a bit complex because it needs to run in a sub-interp as
@@ -780,6 +779,76 @@ test oo-4.6 {export creates proper method entries} -setup {
} -cleanup {
testClass destroy
} -result ok
+test oo-4.7 {basic test of OO functionality: method -export flag} -setup {
+ set o [oo::object new]
+ unset -nocomplain result
+} -body {
+ oo::objdefine $o {
+ method Foo {} {
+ lappend ::result Foo
+ return foo
+ }
+ method Bar -export {} {
+ lappend ::result Bar
+ return bar
+ }
+ }
+ lappend result [catch {$o Foo} msg] $msg
+ lappend result [$o Bar]
+} -cleanup {
+ $o destroy
+} -result {1 {unknown method "Foo": must be Bar or destroy} Bar bar}
+test oo-4.8 {basic test of OO functionality: method -unexport flag} -setup {
+ set o [oo::object new]
+ unset -nocomplain result
+} -body {
+ oo::objdefine $o {
+ method foo {} {
+ lappend ::result foo
+ return Foo
+ }
+ method bar -unexport {} {
+ lappend ::result bar
+ return Bar
+ }
+ }
+ lappend result [$o foo]
+ lappend result [catch {$o bar} msg] $msg
+} -cleanup {
+ $o destroy
+} -result {foo Foo 1 {unknown method "bar": must be destroy or foo}}
+test oo-4.9 {basic test of OO functionality: method -private flag} -setup {
+ set o [oo::object new]
+ unset -nocomplain result
+} -body {
+ oo::objdefine $o {
+ method foo {} {
+ lappend ::result foo
+ return Foo
+ }
+ method bar -private {} {
+ lappend ::result bar
+ return Bar
+ }
+ export eval
+ method gorp {} {
+ my bar
+ }
+ }
+ lappend result [$o foo]
+ lappend result [catch {$o bar} msg] $msg
+ lappend result [catch {$o eval my bar} msg] $msg
+ lappend result [$o gorp]
+} -cleanup {
+ $o destroy
+} -result {foo Foo 1 {unknown method "bar": must be destroy, eval, foo or gorp} 1 {unknown method "bar": must be <cloned>, destroy, eval, foo, gorp, unknown, variable or varname} bar Bar}
+test oo-4.10 {basic test of OO functionality: method flag parsing} -setup {
+ set o [oo::object new]
+} -body {
+ oo::objdefine $o method foo -gorp xyz {return Foo}
+} -returnCodes error -cleanup {
+ $o destroy
+} -result {bad export flag "-gorp": must be -export, -private, or -unexport}
test oo-5.1 {OO: manipulation of classes as objects} -setup {
set obj [oo::object new]
@@ -1583,10 +1652,10 @@ test oo-11.6.4 {
instances
} -body {
oo::class create obj1
- ::oo::define obj1 {self mixin [uplevel 1 {namespace which obj1}]}
+ ::oo::define obj1 {self mixin [self]}
::oo::copy obj1 obj2
- ::oo::objdefine obj2 {mixin [uplevel 1 {namespace which obj2}]}
+ ::oo::objdefine obj2 {mixin [self]}
::oo::copy obj2 obj3
rename obj3 {}
@@ -2204,7 +2273,7 @@ test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
} -body {
set obj1 [FooClass new]
oo::objdefine $obj1 {
- variable var
+ variable var
method m {} {
set var foo
}
@@ -2253,7 +2322,7 @@ test oo-15.13.1 {
} -cleanup {
Cls destroy
Cls2 destroy
-} -result done
+} -result done
test oo-15.13.2 {OO: object cloning with target NS} -setup {
oo::class create Super
oo::class create Cls {superclass Super}
@@ -2281,7 +2350,7 @@ test oo-15.15 {method cloning must ensure that there is a string representation
} -body {
cls create foo
oo::objdefine foo {
- method m1 {} [string map {a b} {return hello}]
+ method m1 {} [string map {a b} {return hello}]
}
[oo::copy foo] m1
} -cleanup {
@@ -2302,7 +2371,7 @@ test oo-16.2 {OO: object introspection} -body {
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
test oo-16.3 {OO: object introspection} -body {
info object gorp oo::object
-} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
test oo-16.4 {OO: object introspection} -setup {
oo::class create meta { superclass oo::class }
[meta create instance1] create instance2
@@ -2432,6 +2501,73 @@ test oo-16.14 {OO: object introspection: TIP #436} -setup {
} -cleanup {
meta destroy
} -result {class {0 0} meta {0 0 0} type {0 0 0 0 0 0} mix {0 0 0 0 0 0}}
+test oo-16.15 {OO: object introspection: creationid #500} -setup {
+ oo::class create cls
+} -body {
+ info object creationid [cls new]
+} -cleanup {
+ cls destroy
+} -result {^\d+$} -match regexp
+test oo-16.16 {OO: object introspection: creationid #500} -setup {
+ oo::class create cls
+} -body {
+ set obj [cls new]
+ set id [info object creationid $obj]
+ rename $obj gorp
+ set id2 [info object creationid gorp]
+ list $id $id2
+} -cleanup {
+ cls destroy
+} -result {^(\d+) \1$} -match regexp
+test oo-16.17 {OO: object introspection: creationid #500} -body {
+ info object creationid nosuchobject
+} -returnCodes error -result {nosuchobject does not refer to an object}
+test oo-16.18 {OO: object introspection: creationid #500} -body {
+ info object creationid
+} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
+test oo-16.18 {OO: object introspection: creationid #500} -body {
+ info object creationid oo::object gorp
+} -returnCodes error -result {wrong # args: should be "info object creationid objName"}
+test oo-16.19 {OO: object introspection: creationid #500} -setup {
+ oo::class create cls
+} -body {
+ set id1 [info object creationid [set o1 [cls new]]]
+ set id2 [info object creationid [set o2 [cls new]]]
+ if {$id1 == $id2} {
+ format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
+ } else {
+ string cat not-equal
+ }
+} -cleanup {
+ cls destroy
+} -result not-equal
+test oo-16.20 {OO: object introspection: creationid #500} -setup {
+ oo::class create cls
+} -body {
+ set id1 [info object creationid [set o1 [cls new]]]
+ $o1 destroy
+ set id2 [info object creationid [set o2 [cls new]]]
+ if {$id1 == $id2} {
+ format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
+ } else {
+ string cat not-equal
+ }
+} -cleanup {
+ cls destroy
+} -result not-equal
+test oo-16.21 {OO: object introspection: creationid #500} -setup {
+ oo::class create cls
+} -body {
+ set id1 [info object creationid [set o1 [cls new]]]
+ set id2 [info object creationid [set o2 [oo::copy $o1]]]
+ if {$id1 == $id2} {
+ format "objects %s and %s have same creation id: %d" $o1 $o2 $id1
+ } else {
+ string cat not-equal
+ }
+} -cleanup {
+ cls destroy
+} -result not-equal
test oo-17.1 {OO: class introspection} -body {
info class
@@ -2454,7 +2590,7 @@ test oo-17.3 {OO: class introspection} -setup {
} -result {"foo" is not a class}
test oo-17.4 {OO: class introspection} -body {
info class gorp oo::object
-} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
test oo-17.5 {OO: class introspection} -setup {
oo::class create testClass
} -body {
@@ -2553,6 +2689,7 @@ test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup {
c destroy
} -result $stdmethods
+
test oo-18.1 {OO: define command support} {
list [catch {oo::define oo::object {error foo}} msg] $msg $errorInfo
} {1 foo {foo
@@ -2942,7 +3079,7 @@ test oo-20.10 {OO: variable and varname methods refer to same things} -setup {
test oo-20.11 {OO: variable mustn't crash when recursing} -body {
oo::class create A {
constructor {name} {
- my variable np_name
+ my variable np_name
set np_name $name
}
method copy {nm} {
@@ -2957,7 +3094,7 @@ test oo-20.11 {OO: variable mustn't crash when recursing} -body {
lappend objs [$ref copy {}]
}
$cpy prop $var $objs
- } else {
+ } else {
$cpy prop $var $val
}
}
@@ -3870,6 +4007,11 @@ proc SampleSlotSetup script {
lappend ops [info level] Set $lst
return
}
+ method Resolve {lst} {
+ variable ops
+ lappend ops [info level] Resolve $lst
+ return $lst
+ }
}
}
append script0 \n$script
@@ -3904,7 +4046,7 @@ test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
rename sampleSlot {}
-}] -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
+}] -result {0 {} {a b c g h i} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
SampleSlot create sampleSlot
}] -body {
@@ -3912,7 +4054,7 @@ test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
rename sampleSlot {}
-}] -result {0 {} {d e f} {1 Set {d e f}}}
+}] -result {0 {} {d e f} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
SampleSlot create sampleSlot
}] -body {
@@ -3920,7 +4062,23 @@ test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
[sampleSlot contents] [sampleSlot ops]
} -cleanup [SampleSlotCleanup {
rename sampleSlot {}
-}] -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
+}] -result {0 {} {} {d e f g h i} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f} 1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {d e f g h i}}}
+test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
+ SampleSlot create sampleSlot
+}] -body {
+ list [info level] [sampleSlot -prepend g h i] \
+ [sampleSlot contents] [sampleSlot ops]
+} -cleanup [SampleSlotCleanup {
+ rename sampleSlot {}
+}] -result {0 {} {g h i a b c} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {g h i a b c}}}
+test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
+ SampleSlot create sampleSlot
+}] -body {
+ list [info level] [sampleSlot -remove c a] \
+ [sampleSlot contents] [sampleSlot ops]
+} -cleanup [SampleSlotCleanup {
+ rename sampleSlot {}
+}] -result {0 {} b {1 Resolve c 1 Resolve a 1 Get 1 Set b}}
test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
set s [SampleSlot new]
@@ -3943,7 +4101,7 @@ test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup [SampleSlotCleanup {
rename $s {}
-}] -result {{} unknown {1 Set destroy 1 Set unknown}}
+}] -result {{} unknown {1 Resolve destroy 1 Set destroy 1 Resolve unknown 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
set s [SampleSlot new]
}] -body {
@@ -3952,7 +4110,7 @@ test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
} -returnCodes error -cleanup [SampleSlotCleanup {
rename $s {}
}] -result \
- {unknown method "-grill": must be -append, -clear, -set, contents or ops}
+ {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}
test oo-34.1 {TIP 380: slots - presence} -setup {
set obj [oo::object new]
@@ -3982,25 +4140,68 @@ proc getMethods obj {
}
test oo-34.3 {TIP 380: slots - presence} {
getMethods oo::define::filter
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
getMethods oo::define::mixin
-} {{-append -clear -set} {--default-operation Get Set}}
+} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.5 {TIP 380: slots - presence} {
getMethods oo::define::superclass
-} {{-append -clear -set} {--default-operation Get Set}}
+} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.6 {TIP 380: slots - presence} {
getMethods oo::define::variable
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
getMethods oo::objdefine::filter
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
getMethods oo::objdefine::mixin
-} {{-append -clear -set} {--default-operation Get Set}}
+} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
test oo-34.9 {TIP 380: slots - presence} {
getMethods oo::objdefine::variable
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
+test oo-34.10 {TIP 516: slots - resolution} -setup {
+ oo::class create parent
+ set result {}
+ oo::class create 516a { superclass parent }
+ oo::class create 516b { superclass parent }
+ oo::class create 516c { superclass parent }
+ namespace eval 516test {
+ oo::class create 516a { superclass parent }
+ oo::class create 516b { superclass parent }
+ oo::class create 516c { superclass parent }
+ }
+} -body {
+ # Must find the right classes when making the mixin
+ namespace eval 516test {
+ oo::define 516a {
+ mixin 516b 516c
+ }
+ }
+ lappend result [info class mixin 516test::516a]
+ # Must not remove class with just simple name match
+ oo::define 516test::516a {
+ mixin -remove 516b
+ }
+ lappend result [info class mixin 516test::516a]
+ # Must remove class with resolved name match
+ oo::define 516test::516a {
+ mixin -remove 516test::516c
+ }
+ lappend result [info class mixin 516test::516a]
+ # Must remove class with resolved name match even after renaming, but only
+ # with the renamed name; it is a slot of classes, not strings!
+ rename 516test::516b 516test::516d
+ oo::define 516test::516a {
+ mixin -remove 516test::516b
+ }
+ lappend result [info class mixin 516test::516a]
+ oo::define 516test::516a {
+ mixin -remove 516test::516d
+ }
+ lappend result [info class mixin 516test::516a]
+} -cleanup {
+ parent destroy
+} -result {{::516test::516b ::516test::516c} {::516test::516b ::516test::516c} ::516test::516b ::516test::516d {}}
test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
oo::class create fruit {
@@ -4072,8 +4273,6 @@ test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly}
} -cleanup {
base destroy
} -result {{c d e} {c d e}}
-
-
test oo-35.6 {
Bug : teardown of an object that is a class that is an instance of itself
} -setup {
@@ -4094,13 +4293,1112 @@ test oo-35.6 {
return done
} -cleanup {
rename obj {}
-} -result done
+} -result done
+
+test oo-36.1 {TIP #470: introspection within oo::define} {
+ oo::define oo::object self
+} ::oo::object
+test oo-36.2 {TIP #470: introspection within oo::define} -setup {
+ oo::class create Cls
+} -body {
+ oo::define Cls self
+} -cleanup {
+ Cls destroy
+} -result ::Cls
+test oo-36.3 {TIP #470: introspection within oo::define} -setup {
+ oo::class create Super
+ set result uncalled
+} -body {
+ oo::class create Sub {
+ superclass Super
+ ::set ::result [self]
+ }
+ return $result
+} -cleanup {
+ Super destroy
+} -result ::Sub
+test oo-36.4 {TIP #470: introspection within oo::define} -setup {
+ oo::class create Super
+ set result uncalled
+} -body {
+ oo::class create Sub {
+ superclass Super
+ ::set ::result [self {}]
+ }
+ return $result
+} -cleanup {
+ Super destroy
+} -result {}
+test oo-36.5 {TIP #470: introspection within oo::define} -setup {
+ oo::class create Super
+ set result uncalled
+} -body {
+ oo::class create Sub {
+ superclass Super
+ ::set ::result [self self]
+ }
+} -cleanup {
+ Super destroy
+} -result ::Sub
+test oo-36.6 {TIP #470: introspection within oo::objdefine} -setup {
+ oo::class create Cls
+ set result uncalled
+} -body {
+ Cls create obj
+ oo::objdefine obj {
+ ::set ::result [self]
+ }
+} -cleanup {
+ Cls destroy
+} -result ::obj
+test oo-36.7 {TIP #470: introspection within oo::objdefine} -setup {
+ oo::class create Cls
+} -body {
+ Cls create obj
+ oo::objdefine obj {
+ self
+ }
+} -cleanup {
+ Cls destroy
+} -result ::obj
+test oo-36.8 {TIP #470: introspection within oo::objdefine} -setup {
+ oo::class create Cls
+} -body {
+ Cls create obj
+ oo::objdefine obj {
+ self anything
+ }
+} -returnCodes error -cleanup {
+ Cls destroy
+} -result {wrong # args: should be "self"}
+test oo-36.9 {TIP #470: introspection within oo::define} -setup {
+ oo::class create Cls
+ set result uncalled
+} -body {
+ proc oo::define::testself {} {
+ global result
+ set result [list [catch {self} msg] $msg \
+ [catch {uplevel 1 self} msg] $msg]
+ return
+ }
+ list [oo::define Cls testself] $result
+} -cleanup {
+ Cls destroy
+ catch {rename oo::define::testself {}}
+} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::Cls}}
+test oo-36.10 {TIP #470: introspection within oo::define} -setup {
+ oo::class create Cls
+ set result uncalled
+} -body {
+ proc oo::objdefine::testself {} {
+ global result
+ set result [list [catch {self} msg] $msg \
+ [catch {uplevel 1 self} msg] $msg]
+ return
+ }
+ Cls create obj
+ list [oo::objdefine obj testself] $result
+} -cleanup {
+ Cls destroy
+ catch {rename oo::objdefine::testself {}}
+} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::obj}}
+test oo-37.1 {TIP 500: private command propagates errors} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {
+ private ::error "this is an error"
+ }
+} -cleanup {
+ cls destroy
+} -returnCodes error -result {this is an error}
+test oo-37.2 {TIP 500: private command propagates errors} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {
+ private {
+ ::error "this is an error"
+ }
+ }
+} -cleanup {
+ cls destroy
+} -returnCodes error -result {this is an error}
+test oo-37.3 {TIP 500: private command propagates errors} -setup {
+ oo::object create obj
+} -body {
+ oo::objdefine obj {
+ private ::error "this is an error"
+ }
+} -cleanup {
+ obj destroy
+} -returnCodes error -result {this is an error}
+test oo-37.4 {TIP 500: private command propagates errors} -setup {
+ oo::object create obj
+} -body {
+ oo::objdefine obj {
+ private {
+ ::error "this is an error"
+ }
+ }
+} -cleanup {
+ obj destroy
+} -returnCodes error -result {this is an error}
+test oo-37.5 {TIP 500: private command can't be used outside definitions} -body {
+ oo::define::private error "xyz"
+} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}
+test oo-37.6 {TIP 500: private command can't be used outside definitions} -body {
+ oo::objdefine::private error "xyz"
+} -returnCodes error -result {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command}
+test oo-38.1 {TIP 500: private variables don't cross-interfere with each other or normal ones} -setup {
+ oo::class create parent
+} -body {
+ oo::class create clsA {
+ superclass parent
+ private variable x
+ constructor {} {
+ set x 1
+ }
+ method getA {} {
+ return $x
+ }
+ }
+ oo::class create clsB {
+ superclass clsA
+ private {
+ variable x
+ }
+ constructor {} {
+ set x 2
+ next
+ }
+ method getB {} {
+ return $x
+ }
+ }
+ oo::class create clsC {
+ superclass clsB
+ variable x
+ constructor {} {
+ set x 3
+ next
+ }
+ method getC {} {
+ return $x
+ }
+ }
+ clsC create obj
+ oo::objdefine obj {
+ private {
+ variable x
+ }
+ method setup {} {
+ set x 4
+ }
+ method getO {} {
+ return $x
+ }
+ }
+ obj setup
+ list [obj getA] [obj getB] [obj getC] [obj getO] \
+ [lsort [string map [list [info object creationid clsA] CLASS-A \
+ [info object creationid clsB] CLASS-B \
+ [info object creationid obj] OBJ] \
+ [info object vars obj]]]
+} -cleanup {
+ parent destroy
+} -result {1 2 3 4 {{CLASS-A : x} {CLASS-B : x} {OBJ : x} x}}
+test oo-38.2 {TIP 500: private variables introspection} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ private {
+ variable x1
+ variable x2
+ }
+ variable y1 y2
+ }
+ cls create obj
+ oo::objdefine obj {
+ private variable a1 a2
+ variable b1 b2
+ }
+ list [lsort [info class variables cls]] \
+ [lsort [info class variables cls -private]] \
+ [lsort [info object variables obj]] \
+ [lsort [info object variables obj -private]]
+} -cleanup {
+ parent destroy
+} -result {{y1 y2} {x1 x2} {b1 b2} {a1 a2}}
+test oo-38.3 {TIP 500: private variables and oo::object·varname} -setup {
+ oo::class create parent
+} -body {
+ oo::class create clsA {
+ superclass parent
+ private {
+ variable x
+ }
+ method getx {} {
+ set x 1
+ my varname x
+ }
+ method readx {} {
+ return $x
+ }
+ }
+ oo::class create clsB {
+ superclass clsA
+ variable x
+ method gety {} {
+ set x 1
+ my varname x
+ }
+ method ready {} {
+ return $x
+ }
+ }
+ clsB create obj
+ set [obj getx] 2
+ set [obj gety] 3
+ list [obj readx] [obj ready]
+} -cleanup {
+ parent destroy
+} -result {2 3}
+test oo-38.4 {TIP 500: private variables introspection} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ private {
+ variable x1 x2
+ }
+ variable y1 y2
+ constructor {} {
+ variable z boo
+ set x1 a
+ set y1 c
+ }
+ method list {} {
+ variable z
+ set ok 1
+ list [info locals] [lsort [info vars]] [info exist x2]
+ }
+ }
+ cls create obj
+ oo::objdefine obj {
+ private variable a1 a2
+ variable b1 b2
+ method init {} {
+ # Because we don't have a constructor to do this setup for us
+ set a1 p
+ set b1 r
+ }
+ method list {} {
+ variable z
+ set yes 1
+ list {*}[next] [info locals] [lsort [info vars]] [info exist a2]
+ }
+ }
+ obj init
+ obj list
+} -cleanup {
+ parent destroy
+} -result {ok {ok x1 x2 y1 y2 z} 0 yes {a1 a2 b1 b2 yes z} 0}
+test oo-38.5 {TIP 500: private variables and oo::object·variable} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls1 {
+ superclass parent
+ private variable x
+ method abc val {
+ my variable x
+ set x $val
+ }
+ method def val {
+ my variable y
+ set y $val
+ }
+ method get1 {} {
+ my variable x y
+ return [list $x $y]
+ }
+ }
+ oo::class create cls2 {
+ superclass cls1
+ private variable x
+ method x-exists {} {
+ return [info exists x],[uplevel 1 {info exists x}]
+ }
+ method ghi x {
+ # Additional instrumentation to show that we're not using the
+ # resolved variable until we ask for it; the argument nixed that
+ # happening by default.
+ set val $x
+ set before [my x-exists]
+ unset x
+ set x $val
+ set mid [my x-exists]
+ unset x
+ set mid2 [my x-exists]
+ my variable x
+ set x $val
+ set after [my x-exists]
+ return "$before;$mid;$mid2;$after"
+ }
+ method jkl val {
+ my variable y
+ set y $val
+ }
+ method get2 {} {
+ my variable x y
+ return [list $x $y]
+ }
+ }
+ cls2 create a
+ a abc 123
+ a def 234
+ set tmp [a ghi 345]
+ a jkl 456
+ list $tmp [a get1] [a get2]
+} -cleanup {
+ parent destroy
+} -result {{0,1;0,1;0,0;1,1} {123 456} {345 456}}
+
+test oo-39.1 {TIP 500: private methods internal call; class private} -setup {
+ oo::class create parent
+} -body {
+ oo::class create clsA {
+ superclass parent
+ variable x
+ constructor {} {
+ set x 1
+ }
+ method act {} {
+ my step
+ my step
+ my step
+ return
+ }
+ private {
+ method step {} {
+ incr x 2
+ }
+ }
+ method x {} {
+ return $x
+ }
+ }
+ clsA create obj
+ obj act
+ list [obj x] [catch {obj step} msg] $msg
+} -cleanup {
+ parent destroy
+} -result {7 1 {unknown method "step": must be act, destroy or x}}
+test oo-39.2 {TIP 500: private methods internal call; class private} -setup {
+ oo::class create parent
+} -body {
+ oo::class create clsA {
+ superclass parent
+ variable x
+ constructor {} {
+ set x 1
+ }
+ method act {} {
+ my step
+ my step
+ my step
+ return
+ }
+ private {
+ method step {} {
+ incr x 2
+ }
+ }
+ method x {} {
+ return $x
+ }
+ }
+ oo::class create clsB {
+ superclass clsA
+ variable x
+ method step {} {
+ incr x 5
+ }
+ }
+ clsB create obj
+ obj act
+ list [obj x] [obj step]
+} -cleanup {
+ parent destroy
+} -result {7 12}
+test oo-39.3 {TIP 500: private methods internal call; class private} -setup {
+ oo::class create parent
+} -body {
+ oo::class create clsA {
+ superclass parent
+ variable x
+ constructor {} {
+ set x 1
+ }
+ method act {} {
+ my Step
+ my Step
+ my Step
+ return
+ }
+ method x {} {
+ return $x
+ }
+ }
+ oo::class create clsB {
+ superclass clsA
+ variable x
+ method Step {} {
+ incr x 5
+ }
+ }
+ clsB create obj
+ obj act
+ set result [obj x]
+ oo::define clsA {
+ private {
+ method Step {} {
+ incr x 2
+ }
+ }
+ }
+ obj act
+ lappend result [obj x]
+} -cleanup {
+ parent destroy
+} -result {16 22}
+test oo-39.4 {TIP 500: private methods internal call; instance private} -setup {
+ oo::class create parent
+} -body {
+ oo::class create clsA {
+ superclass parent
+ variable x
+ constructor {} {
+ set x 1
+ }
+ method act {} {
+ my step
+ return
+ }
+ method step {} {
+ incr x
+ }
+ method x {} {
+ return $x
+ }
+ }
+ clsA create obj
+ obj act
+ set result [obj x]
+ oo::objdefine obj {
+ variable x
+ private {
+ method step {} {
+ incr x 2
+ }
+ }
+ }
+ obj act
+ lappend result [obj x]
+ oo::objdefine obj {
+ method act {} {
+ my step
+ next
+ }
+ }
+ obj act
+ lappend result [obj x]
+} -cleanup {
+ parent destroy
+} -result {2 3 6}
+test oo-39.5 {TIP 500: private methods internal call; cross object} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ variable x
+ constructor {val} {
+ set x $val
+ }
+ private method x {} {
+ return $x
+ }
+ method equal {other} {
+ expr {$x == [$other x]}
+ }
+ }
+ cls create a 1
+ cls create b 2
+ cls create c 1
+ list [a equal b] [b equal c] [c equal a] [catch {a x} msg] $msg
+} -cleanup {
+ parent destroy
+} -result {0 0 1 1 {unknown method "x": must be destroy or equal}}
+test oo-39.6 {TIP 500: private methods internal call; error reporting} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ variable x
+ constructor {val} {
+ set x $val
+ }
+ private method x {} {
+ return $x
+ }
+ method equal {other} {
+ expr {$x == [$other y]}
+ }
+ }
+ cls create a 1
+ cls create b 2
+ a equal b
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {unknown method "y": must be destroy, equal or x}
+test oo-39.7 {TIP 500: private methods internal call; error reporting} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ variable x
+ constructor {val} {
+ set x $val
+ }
+ private method x {} {
+ return $x
+ }
+ method equal {other} {
+ expr {[[self] y] == [$other x]}
+ }
+ }
+ cls create a 1
+ cls create b 2
+ a equal b
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {unknown method "y": must be destroy, equal or x}
+test oo-39.8 {TIP 500: private methods internal call; error reporting} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ variable x
+ constructor {val} {
+ set x $val
+ }
+ private method x {} {
+ return $x
+ }
+ method equal {other} {
+ expr {[my y] == [$other x]}
+ }
+ }
+ cls create a 1
+ cls create b 2
+ a equal b
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable, varname or x}
+test oo-39.9 {TIP 500: private methods internal call; error reporting} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ variable x
+ constructor {val} {
+ set x $val
+ }
+ private method x {} {
+ return $x
+ }
+ }
+ oo::class create cls2 {
+ superclass cls
+ method equal {other} {
+ expr {[my y] == [$other x]}
+ }
+ }
+ cls2 create a 1
+ cls2 create b 2
+ a equal b
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {unknown method "y": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
+test oo-39.10 {TIP 500: private methods internal call; error reporting} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ variable x
+ constructor {val} {
+ set x $val
+ }
+ private method x {} {
+ return $x
+ }
+ }
+ oo::class create cls2 {
+ superclass cls
+ method equal {other} {
+ expr {[my x] == [$other x]}
+ }
+ }
+ cls2 create a 1
+ cls2 create b 2
+ a equal b
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {unknown method "x": must be <cloned>, destroy, equal, eval, unknown, variable or varname}
+test oo-39.11 {TIP 500: private methods; call chain caching and reporting} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ method chain {} {
+ return [self call]
+ }
+ }
+ oo::class create cls2 {
+ superclass cls
+ private method chain {} {
+ next
+ }
+ method chain2 {} {
+ my chain
+ }
+ method chain3 {} {
+ [self] chain
+ }
+ }
+ cls create a
+ cls2 create b
+ list [a chain] [b chain] [b chain2] [b chain3]
+} -cleanup {
+ parent destroy
+} -result {{{{method chain ::cls method}} 0} {{{method chain ::cls method}} 0} {{{private chain ::cls2 method} {method chain ::cls method}} 1} {{{private chain ::cls2 method} {method chain ::cls method}} 1}}
+test oo-39.12 {TIP 500: private methods; introspection} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ method chain {} {
+ return [self call]
+ }
+ private method abc {} {}
+ }
+ oo::class create cls2 {
+ superclass cls
+ method chain2 {} {
+ my chain
+ }
+ method chain3 {} {
+ [self] chain
+ }
+ private method def {} {}
+ unexport chain3
+ }
+ cls create a
+ cls2 create b
+ oo::objdefine b {
+ private method ghi {} {}
+ method ABC {} {}
+ method foo {} {}
+ }
+ set scopes {public unexported private}
+ list a: [lmap s $scopes {info object methods a -scope $s}] \
+ b: [lmap s $scopes {info object methods b -scope $s}] \
+ cls: [lmap s $scopes {info class methods cls -scope $s}] \
+ cls2: [lmap s $scopes {info class methods cls2 -scope $s}] \
+} -cleanup {
+ parent destroy
+} -result {a: {{} {} {}} b: {foo ABC ghi} cls: {chain {} abc} cls2: {chain2 chain3 def}}
+
+test oo-40.1 {TIP 500: private and self} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {
+ self {
+ private {
+ variable a
+ }
+ variable b
+ }
+ private {
+ self {
+ variable c
+ }
+ variable d
+ }
+ variable e
+ }
+ list \
+ [lsort [info class variables cls]] \
+ [lsort [info class variables cls -private]] \
+ [lsort [info object variables cls]] \
+ [lsort [info object variables cls -private]]
+} -cleanup {
+ cls destroy
+} -result {e d b {a c}}
+test oo-40.2 {TIP 500: private and export} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {
+ private method foo {} {}
+ }
+ set result [lmap s {public unexported private} {
+ info class methods cls -scope $s}]
+ oo::define cls {
+ export foo
+ }
+ lappend result {*}[lmap s {public unexported private} {
+ info class methods cls -scope $s}]
+} -cleanup {
+ cls destroy
+} -result {{} {} foo foo {} {}}
+test oo-40.3 {TIP 500: private and unexport} -setup {
+ oo::class create cls
+} -body {
+ oo::define cls {
+ private method foo {} {}
+ }
+ set result [lmap s {public unexported private} {
+ info class methods cls -scope $s}]
+ oo::define cls {
+ unexport foo
+ }
+ lappend result {*}[lmap s {public unexported private} {
+ info class methods cls -scope $s}]
+} -cleanup {
+ cls destroy
+} -result {{} {} foo {} foo {}}
+
+test oo-41.1 {TIP 478: myclass command, including class morphing} -setup {
+ oo::class create parent
+ set result {}
+} -body {
+ oo::class create cls1 {
+ superclass parent
+ self method count {} {
+ my variable c
+ incr c
+ }
+ method act {} {
+ myclass count
+ }
+ }
+ cls1 create x
+ lappend result [x act] [x act]
+ cls1 create y
+ lappend result [y act] [y act] [x act]
+ oo::class create cls2 {
+ superclass cls1
+ self method count {} {
+ my variable d
+ expr {1.0 * [incr d]}
+ }
+ }
+ oo::objdefine x {class cls2}
+ lappend result [x act] [y act] [x act] [y act]
+} -cleanup {
+ parent destroy
+} -result {1 2 3 4 5 1.0 6 2.0 7}
+test oo-41.2 {TIP 478: myclass command cleanup} -setup {
+ oo::class create parent
+ set result {}
+} -body {
+ oo::class create cls1 {
+ superclass parent
+ self method hi {} {
+ return "this is [self]"
+ }
+ method hi {} {
+ return "this is [self]"
+ }
+ }
+ cls1 create x
+ rename [info object namespace x]::my foo
+ rename [info object namespace x]::myclass bar
+ lappend result [cls1 hi] [x hi] [foo hi] [bar hi]
+ x destroy
+ lappend result [catch {foo hi}] [catch {bar hi}]
+} -cleanup {
+ parent destroy
+} -result {{this is ::cls1} {this is ::x} {this is ::x} {this is ::cls1} 1 1}
+test oo-41.3 {TIP 478: myclass command calls unexported methods, via forward} -setup {
+ oo::class create parent
+ set result {}
+} -body {
+ oo::class create cls1 {
+ superclass parent
+ self method Hi {} {
+ return "this is [self]"
+ }
+ forward poke myclass Hi
+ }
+ cls1 create x
+ lappend result [catch {cls1 Hi}] [x poke]
+} -cleanup {
+ parent destroy
+} -result {1 {this is ::cls1}}
+
+test oo-42.1 {TIP 524: definition namespace control: introspection} {
+ info class definitionnamespace oo::object
+} {}
+test oo-42.2 {TIP 524: definition namespace control: introspection} {
+ info class definitionnamespace oo::object -class
+} {}
+test oo-42.3 {TIP 524: definition namespace control: introspection} {
+ info class definitionnamespace oo::object -instance
+} ::oo::objdefine
+test oo-42.4 {TIP 524: definition namespace control: introspection} -body {
+ info class definitionnamespace oo::object -gorp
+} -returnCodes error -result {bad kind "-gorp": must be -class or -instance}
+test oo-42.5 {TIP 524: definition namespace control: introspection} -body {
+ info class definitionnamespace oo::object -class x
+} -returnCodes error -result {wrong # args: should be "info class definitionnamespace className ?kind?"}
+test oo-42.6 {TIP 524: definition namespace control: introspection} {
+ info class definitionnamespace oo::class
+} ::oo::define
+test oo-42.7 {TIP 524: definition namespace control: introspection} {
+ info class definitionnamespace oo::class -class
+} ::oo::define
+test oo-42.8 {TIP 524: definition namespace control: introspection} {
+ info class definitionnamespace oo::class -instance
+} {}
+
+test oo-43.1 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {
+ proc sparkle {} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace foodef
+ }
+ oo::class create foo {
+ superclass parent
+ self class foocls
+ }
+ oo::define foo {
+ sparkle
+ }
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result ok
+test oo-43.2 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+ unset -nocomplain ::result
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::define
+ proc sparkle {} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace foodef
+ }
+ foocls create foo {
+ superclass parent
+ lappend ::result [sparkle]
+ }
+ return $result
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result ok
+test oo-43.3 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+ unset -nocomplain ::result
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::define
+ proc sparkle {} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace -class foodef
+ }
+ foocls create foo {
+ superclass parent
+ lappend ::result [sparkle]
+ }
+ return $result
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result ok
+test oo-43.4 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::objdefine
+ proc sparkle {} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace -instance foodef
+ }
+ foocls create foo {
+ sparkle
+ }
+} -returnCodes error -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result {invalid command name "sparkle"}
+test oo-43.5 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::objdefine
+ proc sparkle {} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace foodef
+ }
+ namespace delete foodef
+ foocls create foo {
+ sparkle
+ }
+} -returnCodes error -cleanup {
+ parent destroy
+ catch {namespace delete foodef}
+} -result {invalid command name "sparkle"}
+test oo-43.6 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+ unset -nocomplain result
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::objdefine
+ proc sparkle {} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace foodef
+ }
+ foocls create foo
+ lappend result [catch {oo::define foo sparkle} msg] $msg
+ namespace delete foodef
+ lappend result [catch {oo::define foo sparkle} msg] $msg
+ namespace eval foodef {
+ namespace path ::oo::objdefine
+ proc sparkle {} {return ok}
+ }
+ lappend result [catch {oo::define foo sparkle} msg] $msg
+} -cleanup {
+ parent destroy
+ catch {namespace delete foodef}
+} -result {0 ok 1 {invalid command name "sparkle"} 0 ok}
+test oo-43.7 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::define
+ proc sparkle {x} {return ok}
+ }
+ oo::class create foocls {
+ superclass oo::class parent
+ definitionnamespace foodef
+ }
+ foocls create foo {
+ superclass parent
+ }
+ oo::define foo spar gorp
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result ok
+test oo-43.8 {TIP 524: definition namespace control: semantics} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {
+ namespace path ::oo::objdefine
+ proc sparkle {} {return ok}
+ }
+ oo::class create foo {
+ superclass parent
+ definitionnamespace -instance foodef
+ }
+ oo::objdefine [foo new] {
+ method x y z
+ sparkle
+ }
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result ok
+test oo-43.9 {TIP 524: definition namespace control: syntax} -body {
+ oo::class create foo {
+ definitionnamespace -gorp foodef
+ }
+} -returnCodes error -result {bad kind "-gorp": must be -class or -instance}
+test oo-43.10 {TIP 524: definition namespace control: syntax} -body {
+ oo::class create foo {
+ definitionnamespace -class foodef x
+ }
+} -returnCodes error -result {wrong # args: should be "definitionnamespace ?kind? namespace"}
+test oo-43.11 {TIP 524: definition namespace control: syntax} -setup {
+ catch {namespace delete ::no_such_ns}
+} -body {
+ oo::class create foo {
+ definitionnamespace -class ::no_such_ns
+ }
+} -returnCodes error -result {namespace "::no_such_ns" not found}
+test oo-43.12 {TIP 524: definition namespace control: user-level introspection} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {}
+ oo::class create foo {
+ superclass oo::class parent
+ }
+ list [info class definitionnamespace foo] \
+ [oo::define foo definitionnamespace foodef] \
+ [info class definitionnamespace foo] \
+ [oo::define foo definitionnamespace {}] \
+ [info class definitionnamespace foo]
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result {{} {} ::foodef {} {}}
+test oo-43.13 {TIP 524: definition namespace control: user-level introspection} -setup {
+ oo::class create parent
+ namespace eval foodef {}
+} -body {
+ namespace eval foodef {}
+ oo::class create foo {
+ superclass parent
+ }
+ list [info class definitionnamespace foo -instance] \
+ [oo::define foo definitionnamespace -instance foodef] \
+ [info class definitionnamespace foo -instance] \
+ [oo::define foo definitionnamespace -instance {}] \
+ [info class definitionnamespace foo -instance]
+} -cleanup {
+ parent destroy
+ namespace delete foodef
+} -result {{} {} ::foodef {} {}}
cleanupTests
return
# Local Variables:
-# MODE: Tcl
+# mode: tcl
# End:
diff --git a/tests/ooUtil.test b/tests/ooUtil.test
new file mode 100644
index 0000000..ff7093f
--- /dev/null
+++ b/tests/ooUtil.test
@@ -0,0 +1,563 @@
+# This file contains a collection of tests for functionality originally
+# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
+# the tests and generates output for errors. No output means no errors were
+# found.
+#
+# Copyright (c) 2014-2016 Andreas Kupries
+# Copyright (c) 2018 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require TclOO 1.0.3
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+ namespace import -force ::tcltest::*
+}
+
+test ooUtil-1.1 {TIP 478: classmethod} -setup {
+ oo::class create parent
+} -body {
+ oo::class create ActiveRecord {
+ superclass parent
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ }
+ Table find foo bar
+} -cleanup {
+ parent destroy
+} -result {::Table called with arguments: foo bar}
+test ooUtil-1.2 {TIP 478: classmethod in namespace} -setup {
+ namespace eval ::testns {}
+} -body {
+ namespace eval ::testns {
+ oo::class create ActiveRecord {
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ }
+ }
+ testns::Table find foo bar
+} -cleanup {
+ namespace delete ::testns
+} -result {::testns::Table called with arguments: foo bar}
+test ooUtil-1.3 {TIP 478: classmethod must not interfere with constructor signatures} -setup {
+ oo::class create parent
+} -body {
+ oo::class create TestClass {
+ superclass oo::class parent
+ self method create {name ignore body} {
+ next $name $body
+ }
+ }
+ TestClass create okay {} {}
+} -cleanup {
+ parent destroy
+} -result {::okay}
+test ooUtil-1.4 {TIP 478: classmethod with several inheritance levels} -setup {
+ oo::class create parent
+} -body {
+ oo::class create ActiveRecord {
+ superclass parent
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ }
+ oo::class create SubTable {
+ superclass Table
+ }
+ SubTable find foo bar
+} -cleanup {
+ parent destroy
+} -result {::SubTable called with arguments: foo bar}
+test ooUtil-1.5 {TIP 478: classmethod and instances} -setup {
+ oo::class create parent
+} -body {
+ oo::class create ActiveRecord {
+ superclass parent
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ }
+ set t [Table new]
+ $t find 1 2 3
+} -cleanup {
+ parent destroy
+} -result {::Table called with arguments: 1 2 3}
+test ooUtil-1.6 {TIP 478: classmethod and instances} -setup {
+ oo::class create parent
+} -body {
+ oo::class create ActiveRecord {
+ superclass parent
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ unexport find
+ }
+ set t [Table new]
+ $t find 1 2 3
+} -returnCodes error -cleanup {
+ parent destroy
+} -match glob -result {unknown method "find": must be *}
+test ooUtil-1.7 {} -setup {
+ oo::class create parent
+} -body {
+ oo::class create Foo {
+ superclass parent
+ classmethod bar {} {
+ puts "This is in the class; self is [self]"
+ my meee
+ }
+ classmethod meee {} {
+ puts "This is meee"
+ }
+ }
+ oo::class create Grill {
+ superclass Foo
+ classmethod meee {} {
+ puts "This is meee 2"
+ }
+ }
+ list [Foo bar] [Grill bar] [[Foo new] bar] [[Grill new] bar]
+} -cleanup {
+ parent destroy
+} -result {{} {} {} {}} -output "This is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\nThis is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\n"
+# Two tests to confirm that we correctly initialise the scripted part of TclOO
+# in child interpreters. This is slightly tricky at the implementation level
+# because we cannot count on either [source] or [open] being available.
+test ooUtil-1.8 {TIP 478: classmethod in child interp} -setup {
+ set childinterp [interp create]
+} -body {
+ $childinterp eval {
+ oo::class create ActiveRecord {
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ }
+ # This is confirming that this is not the master interpreter
+ list [Table find foo bar] [info globals childinterp]
+ }
+} -cleanup {
+ interp delete $childinterp
+} -result {{::Table called with arguments: foo bar} {}}
+test ooUtil-1.9 {TIP 478: classmethod in safe child interp} -setup {
+ set safeinterp [interp create -safe]
+} -body {
+ $safeinterp eval {
+ oo::class create ActiveRecord {
+ classmethod find args {
+ return "[self] called with arguments: $args"
+ }
+ }
+ oo::class create Table {
+ superclass ActiveRecord
+ }
+ # This is confirming that this is a (basic) safe interpreter
+ list [Table find foo bar] [info commands source]
+ }
+} -cleanup {
+ interp delete $safeinterp
+} -result {{::Table called with arguments: foo bar} {}}
+
+test ooUtil-2.1 {TIP 478: callback generation} -setup {
+ oo::class create parent
+} -body {
+ oo::class create c {
+ superclass parent
+ method CallMe {} { return ok,[self] }
+ method makeCall {} {
+ return [callback CallMe]
+ }
+ }
+ c create ::context
+ set cb [context makeCall]
+ {*}$cb
+} -cleanup {
+ parent destroy
+} -result {ok,::context}
+test ooUtil-2.2 {TIP 478: callback generation} -setup {
+ oo::class create parent
+} -body {
+ oo::class create c {
+ superclass parent
+ method CallMe {a b c} { return ok,[self],$a,$b,$c }
+ method makeCall {b} {
+ return [callback CallMe 123 $b]
+ }
+ }
+ c create ::context
+ set cb [context makeCall "a b c"]
+ {*}$cb PQR
+} -cleanup {
+ parent destroy
+} -result {ok,::context,123,a b c,PQR}
+test ooUtil-2.3 {TIP 478: callback generation, alternate name} -setup {
+ oo::class create parent
+} -body {
+ oo::class create c {
+ superclass parent
+ method CallMe {} { return ok,[self] }
+ method makeCall {} {
+ return [mymethod CallMe]
+ }
+ }
+ c create ::context
+ set cb [context makeCall]
+ {*}$cb
+} -cleanup {
+ parent destroy
+} -result {ok,::context}
+test ooUtil-2.4 {TIP 478: callback generation, alternate name} -setup {
+ oo::class create parent
+} -body {
+ oo::class create c {
+ superclass parent
+ method CallMe {a b c} { return ok,[self],$a,$b,$c }
+ method makeCall {b} {
+ return [mymethod CallMe 123 $b]
+ }
+ }
+ c create ::context
+ set cb [context makeCall "a b c"]
+ {*}$cb PQR
+} -cleanup {
+ parent destroy
+} -result {ok,::context,123,a b c,PQR}
+test ooUtil-2.5 {TIP 478: callbacks and method lifetime} -setup {
+ oo::class create parent
+} -body {
+ oo::class create c {
+ superclass parent
+ method makeCall {b} {
+ return [callback CallMe 123 $b]
+ }
+ }
+ c create ::context
+ set cb [context makeCall "a b c"]
+ set result [list [catch {{*}$cb PQR} msg] $msg]
+ oo::objdefine context {
+ method CallMe {a b c} { return ok,[self],$a,$b,$c }
+ }
+ lappend result [{*}$cb PQR]
+} -cleanup {
+ parent destroy
+} -result {1 {unknown method "CallMe": must be <cloned>, destroy, eval, makeCall, unknown, variable or varname} {ok,::context,123,a b c,PQR}}
+test ooUtil-2.6 {TIP 478: callback use case} -setup {
+ oo::class create parent
+ unset -nocomplain x
+} -body {
+ oo::class create c {
+ superclass parent
+ variable count
+ constructor {var} {
+ set count 0
+ upvar 1 $var v
+ trace add variable v write [callback TraceCallback]
+ }
+ method count {} {return $count}
+ method TraceCallback {name1 name2 op} {
+ incr count
+ }
+ }
+ set o [c new x]
+ for {set x 0} {$x < 5} {incr x} {}
+ $o count
+} -cleanup {
+ unset -nocomplain x
+ parent destroy
+} -result 6
+
+test ooUtil-3.1 {TIP 478: class initialisation} -setup {
+ oo::class create parent
+ catch {rename ::foobar-3.1 {}}
+} -body {
+ oo::class create ::cls {
+ superclass parent
+ initialise {
+ proc foobar-3.1 {} {return ok}
+ }
+ method calls {} {
+ list [catch foobar-3.1 msg] $msg \
+ [namespace eval [info object namespace [self class]] foobar-3.1]
+ }
+ }
+ [cls new] calls
+} -cleanup {
+ parent destroy
+} -result {1 {invalid command name "foobar-3.1"} ok}
+test ooUtil-3.2 {TIP 478: class variables} -setup {
+ oo::class create parent
+ catch {rename ::foobar-3.1 {}}
+} -body {
+ oo::class create ::cls {
+ superclass parent
+ initialise {
+ variable x 123
+ }
+ method call {} {
+ classvariable x
+ incr x
+ }
+ }
+ cls create a
+ cls create b
+ cls create c
+ list [a call] [b call] [c call] [a call] [b call] [c call]
+} -cleanup {
+ parent destroy
+} -result {124 125 126 127 128 129}
+test ooUtil-3.3 {TIP 478: class initialisation} -setup {
+ oo::class create parent
+ catch {rename ::foobar-3.3 {}}
+} -body {
+ oo::class create ::cls {
+ superclass parent
+ initialize {
+ proc foobar-3.3 {} {return ok}
+ }
+ method calls {} {
+ list [catch foobar-3.3 msg] $msg \
+ [namespace eval [info object namespace [self class]] foobar-3.3]
+ }
+ }
+ [cls new] calls
+} -cleanup {
+ parent destroy
+} -result {1 {invalid command name "foobar-3.3"} ok}
+test ooUtil-3.4 {TIP 478: class initialisation} -setup {
+ oo::class create parent
+ catch {rename ::appendToResultVar {}}
+ proc ::appendToResultVar args {
+ lappend ::result {*}$args
+ }
+ set result {}
+} -body {
+ trace add execution oo::define::initialise enter appendToResultVar
+ oo::class create ::cls {
+ superclass parent
+ initialize {proc xyzzy {} {}}
+ }
+ return $result
+} -cleanup {
+ catch {
+ trace remove execution oo::define::initialise enter appendToResultVar
+ }
+ rename ::appendToResultVar {}
+ parent destroy
+} -result {{initialize {proc xyzzy {} {}}} enter}
+test ooUtil-3.5 {TIP 478: class initialisation} -body {
+ oo::define oo::object {
+ ::list [::namespace which initialise] [::namespace which initialize] \
+ [::namespace origin initialise] [::namespace origin initialize]
+ }
+} -result {::oo::define::initialise ::oo::define::initialize ::oo::define::initialise ::oo::define::initialise}
+
+test ooUtil-4.1 {TIP 478: singleton} -setup {
+ oo::class create parent
+} -body {
+ oo::singleton create xyz {
+ superclass parent
+ }
+ set x [xyz new]
+ set y [xyz new]
+ set z [xyz new]
+ set code [catch {$x destroy} msg]
+ set p [xyz new]
+ lappend code [catch {rename $x ""}]
+ set q [xyz new]
+ string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
+} -cleanup {
+ parent destroy
+} -result {1 0 ONE ONE ONE ONE TWO TWO}
+test ooUtil-4.2 {TIP 478: singleton errors} -setup {
+ oo::class create parent
+} -body {
+ oo::singleton create xyz {
+ superclass parent
+ }
+ [xyz new] destroy
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {may not destroy a singleton object}
+test ooUtil-4.3 {TIP 478: singleton errors} -setup {
+ oo::class create parent
+} -body {
+ oo::singleton create xyz {
+ superclass parent
+ }
+ oo::copy [xyz new]
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {may not clone a singleton object}
+
+
+test ooUtil-5.1 {TIP 478: abstract} -setup {
+ oo::class create parent
+} -body {
+ oo::abstract create xyz {
+ superclass parent
+ method foo {} {return 123}
+ }
+ oo::class create pqr {
+ superclass xyz
+ method bar {} {return 456}
+ }
+ set codes [list [catch {xyz new}] [catch {xyz create x}] [catch {xyz createWithNamespace x y}]]
+ set x [pqr new]
+ set y [pqr create ::y]
+ lappend codes [$x foo] [$x bar] $y
+} -cleanup {
+ parent destroy
+} -result {1 1 1 123 456 ::y}
+
+test ooUtil-6.1 {TIP 478: classvarable} -setup {
+ oo::class create parent
+} -body {
+ oo::class create xyz {
+ superclass parent
+ initialise {
+ variable x 1 y 2
+ }
+ method a {} {
+ classvariable x
+ incr x
+ }
+ method b {} {
+ classvariable y
+ incr y
+ }
+ method c {} {
+ classvariable x y
+ list $x $y
+ }
+ }
+ set p [xyz new]
+ set q [xyz new]
+ set result [list [$p c] [$q c]]
+ $p a
+ $q b
+ lappend result [[xyz new] c]
+} -cleanup {
+ parent destroy
+} -result {{1 2} {1 2} {2 3}}
+test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
+ oo::class create parent
+} -body {
+ oo::class create xyz {
+ superclass parent
+ method a {} {
+ classvariable x(1)
+ incr x(1)
+ }
+ }
+ set p [xyz new]
+ set q [xyz new]
+ list [$p a] [$q a]
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
+test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
+ oo::class create parent
+} -body {
+ oo::class create xyz {
+ superclass parent
+ method a {} {
+ classvariable ::x
+ incr x
+ }
+ }
+ set p [xyz new]
+ set q [xyz new]
+ list [$p a] [$q a]
+} -returnCodes error -cleanup {
+ parent destroy
+} -result {bad variable name "::x": can't create a local variable with a namespace separator in it}
+
+test ooUtil-7.1 {TIP 478: link calling pattern} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ method foo {} {return "in foo of [self]"}
+ method Bar {} {return "in bar of [self]"}
+ method Grill {} {return "in grill of [self]"}
+ export eval
+ constructor {} {
+ link foo
+ link {bar Bar} {grill Grill}
+ }
+ }
+ cls create o
+ o eval {list [foo] [bar] [grill]}
+} -cleanup {
+ parent destroy
+} -result {{in foo of ::o} {in bar of ::o} {in grill of ::o}}
+test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup {
+ oo::class create parent
+} -body {
+ oo::class create cls {
+ superclass parent
+ method foo {} {return "in foo of [self]"}
+ constructor {cmd} {
+ link [list ::$cmd foo]
+ }
+ }
+ cls create o pqr
+ list [o foo] [pqr] [rename [info object namespace o]::my {}] [catch pqr msg] $msg
+} -cleanup {
+ parent destroy
+} -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}
+
+# Tests that verify issues detected with the tcllib version of the code
+test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
+ oo::class create animal {}
+ namespace eval ::ooutiltest {
+ oo::class create pet { superclass animal }
+ }
+} -body {
+ namespace eval ::ooutiltest {
+ oo::class create dog { superclass pet }
+ }
+} -cleanup {
+ namespace delete ooutiltest
+ rename animal {}
+} -result {::ooutiltest::dog}
+test ooUtil-tcllib-ticket-fe7a0e0a3a {classmethod must not interfere with constructor signatures} -setup {
+ oo::class create TestClass {
+ superclass oo::class
+ self method create {name ignore body} {
+ next $name $body
+ }
+ }
+} -body {
+ TestClass create okay {} {}
+} -cleanup {
+ rename TestClass {}
+} -result {::okay}
+
+cleanupTests
+return
+
+# Local Variables:
+# fill-column: 78
+# mode: tcl
+# End:
diff --git a/tests/package.test b/tests/package.test
index bc73003..2dca06b 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -17,16 +17,22 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+
# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
+catch [list load {} Tcltest $i]
interp eval $i {
namespace import -force ::tcltest::*
-package forget {*}[package names]
+#package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""
+
+testConstraint testpreferstable [llength [info commands testpreferstable]]
test package-1.1 {pkg::create gives error on insufficient args} -body {
::pkg::create
@@ -134,7 +140,7 @@ test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {3.4}
test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -144,7 +150,7 @@ test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {3.5}
test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -154,7 +160,7 @@ test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t 2.2
- return $x
+ set x
} -result {2.3}
test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -164,7 +170,7 @@ test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require -exact t 2.3
- return $x
+ set x
} -result {2.3}
test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -174,7 +180,7 @@ test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t 2.1
- return $x
+ set x
} -result {2.4}
test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
package forget t
@@ -233,7 +239,7 @@ test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
} -body {
package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
package require t 1.2
- return $x
+ set x
} -result {1.2}
test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
package forget t
@@ -251,7 +257,7 @@ test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
}
package unknown pkgUnknown
package require -exact t 1.5
- return $x
+ set x
} -cleanup {
package unknown {}
} -result {t 1.5-1.5}
@@ -278,7 +284,7 @@ test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
package provide [lindex $args 0] 2.0
}
package require {a b}
- return $x
+ set x
} -cleanup {
package unknown {}
} -result {{a b} 0-}
@@ -569,15 +575,24 @@ test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
} -returnCodes error -cleanup {
package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
-test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup {
+test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
+ interp create child
+ load {} Tcltest child
+ child eval {
+ testpreferstable
package forget t
set x xxx
+ }
} -body {
+ child eval {
foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
+ }
+} -cleanup {
+ interp delete child
} -result {3.4}
test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
package forget t
@@ -587,7 +602,7 @@ test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {1.3}
test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
package forget t
@@ -597,56 +612,81 @@ test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {1.3}
-test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} {
+test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
+ testpreferstable
package forget t
+ set x xxx
+} -body {
foreach i {1.2b1 1.1} {
package ifneeded t $i "set x $i; package provide t $i"
}
- set x xxx
package require t
set x
-} {1.1}
+} -result {1.1}
test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup {
package forget t
} -body {
coroutine coro1 apply {{} {
package ifneeded t 2.1 {
- yield
+ yield
package provide t 2.1
}
package require t 2.1
}}
list [catch {coro1} msg] $msg
-} -match glob -result {0 2.1}
+} -match glob -result {0 2.1}
test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
package
} -result {wrong # args: should be "package option ?arg ...?"}
-test package-4.2 {Tcl_PackageCmd procedure, "forget" option} {
+test package-4.2 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
package names
-} {}
-test package-4.3 {Tcl_PackageCmd procedure, "forget" option} {
+ }
+} -cleanup {
+ interp delete child
+} -result {}
+test package-4.3 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
package forget foo
-} {}
+ }
+} -cleanup {
+ interp delete child
+} -result {}
test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+ child eval {
package forget {*}[package names]
set result {}
+ }
} -body {
+ child eval {
package ifneeded t 1.1 {first script}
package ifneeded t 2.3 {second script}
package ifneeded x 1.4 {x's script}
lappend result [lsort [package names]] [package versions t]
package forget t
lappend result [lsort [package names]] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {{t x} {1.1 2.3} x {}}
test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+ child eval {
package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded a 1.1 {first script}
package ifneeded b 2.3 {second script}
package ifneeded c 1.4 {third script}
@@ -654,6 +694,9 @@ test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
set result [list [lsort [package names]]]
package forget a c
lappend result [lsort [package names]]
+ }
+} -cleanup {
+ interp delete child
} -result {{a b c} b}
test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
# Test for Bug 415273
@@ -672,28 +715,55 @@ test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
package ifneeded t xyz
} -returnCodes error -result {expected version number but got "xyz"}
-test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
+test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
list [package ifneeded foo 1.1] [package names]
-} {{} {}}
+ }
+} -cleanup {
+ interp delete child
+} -result {{} {}}
test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
- package forget t
+ interp create child
+ child eval {
+ package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded t 1.4 "script for t 1.4"
list [package names] [package ifneeded t 1.4] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {t {script for t 1.4} 1.4}
test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
- package forget t
+ interp create child
+ child eval {
+ package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded t 1.4 "script for t 1.4"
list [package ifneeded t 1.5] [package names] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {{} t 1.4}
test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
- package forget t
+ interp create child
+ child eval {
+ package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded t 1.4 "script for t 1.4"
package ifneeded t 1.4 "second script for t 1.4"
list [package ifneeded t 1.4] [package names] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {{second script for t 1.4} t 1.4}
test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
package forget t
@@ -706,18 +776,31 @@ test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
package names a
} -returnCodes error -result {wrong # args: should be "package names"}
-test package-4.15 {Tcl_PackageCmd procedure, "names" option} {
+test package-4.15 {Tcl_PackageCmd procedure, "names" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
package names
-} {}
+ }
+} -cleanup {
+ interp delete child
+} -result {}
test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
+ interp create child
+ child eval {
package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded x 1.2 {dummy}
package provide x 1.3
package provide y 2.4
catch {package require z 47.16}
lsort [package names]
+ }
+} -cleanup {
+ interp delete child
} -result {x y}
test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
package provide
@@ -848,7 +931,7 @@ test package-4.52 {Tcl_PackageCmd procedure, "vsatisfies" option} {
} {0}
test package-4.53 {Tcl_PackageCmd procedure, "versions" option} -body {
package foo
-} -returnCodes error -result {bad option "foo": must be forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
+} -returnCodes error -result {bad option "foo": must be files, forget, ifneeded, names, prefer, present, provide, require, unknown, vcompare, versions, or vsatisfies}
test package-4.54 {Tcl_PackageCmd procedure, "vsatisfies" option} -body {
package vsatisfies 2.1 2.1-3.2-4.5
} -returnCodes error -result {expected versionMin-versionMax but got "2.1-3.2-4.5"}
@@ -1255,9 +1338,9 @@ proc prefer {args} {
}
}
-test package-13.0 {package prefer defaults} {
+test package-13.0 {package prefer defaults} -body {
prefer
-} stable
+} -result [expr {[string match {*[ab]*} [package provide Tcl]] ? "latest" : "stable"}]
test package-13.1 {package prefer defaults} -body {
set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant!
prefer
@@ -1272,15 +1355,27 @@ test package-14.1 {bogus argument} -returnCodes error -body {
package prefer foo
} -result {bad preference "foo": must be latest or stable}
-test package-15.0 {set, keep} {package prefer stable} stable
-test package-15.1 {set stable, keep} {prefer stable} {stable stable}
-test package-15.2 {set latest, change} {prefer latest} {stable latest}
-test package-15.3 {set latest, keep} {
- prefer latest latest
-} {stable latest latest}
-test package-15.4 {set stable, rejected} {
- prefer latest stable
-} {stable latest latest}
+test package-15.0 {set, keep} -constraints testpreferstable -setup {
+ testpreferstable
+} -body {package prefer} -result stable
+test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
+ testpreferstable
+} -body {package prefer stable} -result stable
+test package-15.2 {set latest, change} -constraints testpreferstable -setup {
+ testpreferstable
+} -body {package prefer latest} -result latest
+test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
+ testpreferstable
+} -body {
+ package prefer latest
+ package prefer latest
+} -result latest
+test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
+ testpreferstable
+} -body {
+ package prefer latest
+ package prefer stable
+} -result latest
rename prefer {}
diff --git a/tests/parse.test b/tests/parse.test
index d73c725..287c392 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -369,7 +369,7 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
variable ::aresult
variable ::acode
proc async1 {result code} {
- variable ::aresult
+ variable ::aresult
variable ::acode
set aresult $result
set acode $code
diff --git a/tests/parseExpr.test b/tests/parseExpr.test
index ef05454..47dbec5 100644
--- a/tests/parseExpr.test
+++ b/tests/parseExpr.test
@@ -768,11 +768,11 @@ test parseExpr-21.8 {error messages} -body {
expr {0o8x}
} -returnCodes error -match glob -result {*invalid octal number*}
test parseExpr-21.9 {error messages} -body {
- expr {"}
+ expr {"}
} -returnCodes error -result {missing "
in expression """}
test parseExpr-21.10 {error messages} -body {
- expr \{
+ expr \{
} -returnCodes error -result "missing close-brace
in expression \"\{\""
test parseExpr-21.11 {error messages} -body {
@@ -1044,9 +1044,8 @@ test parseExpr-22.13 {Bug 3401704} -constraints testexprparser -body {
} -result {- {} 0 subexpr naner() 1 operator naner 0 {}}
test parseExpr-22.14 {Bug 3401704} -constraints testexprparser -body {
- catch {testexprparser 08 -1} m o
- dict get $o -errorcode
-} -result {TCL PARSE EXPR BADNUMBER OCTAL}
+ testexprparser 07 -1
+} -result {- {} 0 subexpr 07 1 text 07 0 {}}
test parseExpr-22.15 {Bug 3401704} -constraints testexprparser -body {
catch {testexprparser 0o8 -1} m o
dict get $o -errorcode
diff --git a/tests/pkgIndex.tcl b/tests/pkgIndex.tcl
index 9d89277..96542f9 100644
--- a/tests/pkgIndex.tcl
+++ b/tests/pkgIndex.tcl
@@ -1,3 +1,3 @@
#! /usr/bin/env tclsh
-package ifneeded tcltests 0.1 [list source $dir/tcltests.tcl]
+package ifneeded tcltests 0.1 [list source $dir/tcltests.tcl] \ No newline at end of file
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index 84c82ce..8ff806c 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -231,7 +231,7 @@ proc pkgtest::runCreatedIndex {rv args} {
set result [list 0 [makePkgList [parseIndex $idxFile]]]
} err]} {
set result [list 1 $err]
- }
+ }
file delete $idxFile
} else {
set result $rv
diff --git a/tests/platform.test b/tests/platform.test
index e5a4c90..53d534e 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -10,7 +10,6 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
package require tcltest 2
-package require tcltests
namespace eval ::tcl::test::platform {
namespace import ::tcltest::testConstraint
@@ -23,8 +22,10 @@ namespace eval ::tcl::test::platform {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
testConstraint testCPUID [llength [info commands testcpuid]]
+testConstraint testlongsize [llength [info commands testlongsize]]
test platform-1.0 {tcl_platform(engine)} {
set tcl_platform(engine)
@@ -39,27 +40,20 @@ test platform-1.1 {TclpSetVariables: tcl_platform} {
set result
} {byteOrder engine machine os osVersion pathSeparator platform pointerSize 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 {int(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 ^ int($result - 1)}]
-} {1 -1}
+test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize {
+ expr {$tcl_platform(wordSize) == [testlongsize]}
+} {1}
# On Windows/UNIX, test that the CPU ID works
test platform-3.1 {CPU ID on Windows/UNIX} \
-constraints testCPUID \
- -body {
+ -body {
set cpudata [testcpuid 0]
binary format iii \
[lindex $cpudata 1] \
[lindex $cpudata 3] \
- [lindex $cpudata 2]
+ [lindex $cpudata 2]
} \
-match regexp \
-result {^(?:AuthenticAMD|CentaurHauls|CyrixInstead|GenuineIntel)$}
diff --git a/tests/proc.test b/tests/proc.test
index 8b25b0a..1893d0f 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -99,7 +99,7 @@ test proc-1.6 {Tcl_ProcObjCmd, namespace code ignores single ":"s in middle or e
test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array elements} -setup {
catch {rename p ""}
} -returnCodes error -body {
- proc p {a(1) a(2)} {
+ proc p {a(1) a(2)} {
set z [expr $a(1)+$a(2)]
puts "$z=z, $a(1)=$a(1)"
}
@@ -107,7 +107,7 @@ test proc-1.7 {Tcl_ProcObjCmd, check that formal parameter names are not array e
test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple names} -setup {
catch {rename p ""}
} -body {
- proc p {b:a b::a} {
+ proc p {b:a b::a} {
}
} -returnCodes error -result {formal parameter "b::a" is not a simple name}
test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
@@ -337,7 +337,7 @@ test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body
} -cleanup {
catch {rename p ""}
catch {rename t ""}
-} -result {aba}
+} -result {aba}
test proc-6.1 {ProcessProcResultCode: Bug 647307 (negative return code)} -body {
proc a {} {return -code -5}
diff --git a/tests/process.test b/tests/process.test
new file mode 100644
index 0000000..4c4bc99
--- /dev/null
+++ b/tests/process.test
@@ -0,0 +1,338 @@
+# process.test --
+#
+# This file contains a collection of tests for the tcl::process ensemble.
+# Sourcing this file into Tcl runs the tests and generates output for
+# errors. No output means no errors were found.
+#
+# Copyright (c) 2017 Frederic Bonnet
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
+
+# Utilities
+file delete [set path(test-signalfile) [makeFile {} test-signalfile]]
+set path(test-signalfile2) [makeFile {} test-signalfile2]
+# $path(sleep) time ?filename? -- sleep for time (in ms) and stop if it gets signaled (file gets deleted)
+set path(sleep) [makeFile {
+ after [expr {[lindex $argv 0]*1000}] {set stop 1}
+ if {[set fn [lindex $::argv 1]] ne ""} {
+ close [open $fn w]
+ proc check {} {
+ if {![file exists $::fn]} { # exit signaled
+ after 10 {set ::stop 2}
+ }
+ after 10 check
+ }
+ after 10 check
+ }
+ vwait stop
+ exit
+} sleep]
+
+proc wait_for_file {fn {timeout 10000}} {
+ if {![file exists $fn]} {
+ set toev [after $timeout {set found 0}]
+ proc check {fn} {
+ if {[file exists $fn]} {
+ set ::found 1
+ return
+ }
+ after 10 [list check $fn]
+ }
+ after 10 [list check $fn]
+ vwait ::found
+ after cancel $toev
+ unset ::found
+ }
+ file exists $fn
+}
+proc signal_exit {fn {wait 1}} {
+ # wait for until file created if expected:
+ if {!$wait || [wait_for_file $fn]} {
+ # delete file to signal exit for child-process:
+ while {1} {
+ if {![catch { file delete $fn } msg opt]
+ || [lrange [dict get $opt -errorcode] 0 1] ne {POSIX EACCES}
+ } break
+ }
+ }
+}
+
+set path(exit) [makeFile {
+ exit [lindex $argv 0]
+} exit]
+
+# Basic syntax checking
+test process-1.1 {tcl::process command basic syntax} -returnCodes error -body {
+ tcl::process
+} -result {wrong # args: should be "tcl::process subcommand ?arg ...?"}
+test process-1.2 {tcl::process subcommands} -returnCodes error -body {
+ tcl::process ?
+} -match glob -result {unknown or ambiguous subcommand "?": must be autopurge, list, purge, or status}
+
+# Autopurge flag
+# - Default state
+test process-2.1 {autopurge default} -body {
+ tcl::process autopurge
+} -result {1}
+# - Enabling autopurge
+test process-2.2 {enable autopurge} -body {
+ tcl::process autopurge true
+ tcl::process autopurge
+} -result {1}
+# - Disabling autopurge
+test process-2.3 {disable autopurge} -body {
+ tcl::process autopurge false
+ tcl::process autopurge
+} -result {0} -cleanup {tcl::process autopurge true}
+
+# Subprocess list & status
+test process-3.1 {empty subprocess list} -body {
+ llength [tcl::process list]
+} -result {0}
+test process-3.2 {empty subprocess status} -body {
+ dict size [tcl::process status]
+} -result {0}
+
+# Spawn subprocesses using [exec]
+# - One child
+test process-4.1 {exec one child} -body {
+ tcl::process autopurge 0
+ set pid [exec [interpreter] $path(exit) 0 &]
+ set list [tcl::process list]
+ set statuses [tcl::process status -wait]
+ set status [lindex [tcl::process status $pid] 1]
+ expr {
+ [llength $list] eq 1
+ && [lindex $list 0] eq $pid
+ && [dict size $statuses] eq 1
+ && [dict get $statuses $pid] eq $status
+ && $status eq 0
+ }
+} -result {1} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+# - Two children
+test process-4.2 {exec two children in parallel} -body {
+ tcl::process autopurge 0
+ set pid1 [exec [interpreter] $path(exit) 0 &]
+ set pid2 [exec [interpreter] $path(exit) 0 &]
+ set list [tcl::process list]
+ set statuses [tcl::process status -wait]
+ set status1 [lindex [tcl::process status $pid1] 1]
+ set status2 [lindex [tcl::process status $pid2] 1]
+ expr {
+ [llength $list] eq 2
+ && [lsearch $list $pid1] >= 0
+ && [lsearch $list $pid2] >= 0
+ && [dict size $statuses] eq 2
+ && [dict get $statuses $pid1] eq $status1
+ && [dict get $statuses $pid2] eq $status2
+ && $status1 eq 0
+ && $status2 eq 0
+ }
+} -result {1} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+# - 3-stage pipe
+test process-4.3 {exec 3-stage pipe} -body {
+ tcl::process autopurge 0
+ set pids [exec \
+ [interpreter] $path(exit) 0 \
+ | [interpreter] $path(exit) 0 \
+ | [interpreter] $path(exit) 0 \
+ &]
+ lassign $pids pid1 pid2 pid3
+ set list [tcl::process list]
+ set statuses [tcl::process status -wait]
+ set status1 [lindex [tcl::process status $pid1] 1]
+ set status2 [lindex [tcl::process status $pid2] 1]
+ set status3 [lindex [tcl::process status $pid3] 1]
+ expr {
+ [llength $pids] eq 3
+ && [llength $list] eq 3
+ && [lsearch $list $pid1] >= 0
+ && [lsearch $list $pid2] >= 0
+ && [lsearch $list $pid3] >= 0
+ && [dict size $statuses] eq 3
+ && [dict get $statuses $pid1] eq $status1
+ && [dict get $statuses $pid2] eq $status2
+ && [dict get $statuses $pid3] eq $status3
+ && $status1 eq 0
+ && $status2 eq 0
+ && $status3 eq 0
+ }
+} -result {1} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+
+# Spawn subprocesses using [open "|"]
+# - One child
+test process-5.1 {exec one child} -body {
+ tcl::process autopurge 0
+ set f [open "|\"[interpreter]\" \"$path(exit)\" 0"]
+ set pid [pid $f]
+ set list [tcl::process list]
+ set statuses [tcl::process status -wait]
+ set status [lindex [tcl::process status $pid] 1]
+ expr {
+ [llength $list] eq 1
+ && [lindex $list 0] eq $pid
+ && [dict size $statuses] eq 1
+ && [dict get $statuses $pid] eq $status
+ && $status eq 0
+ }
+} -result {1} -cleanup {
+ close $f
+ tcl::process purge
+ tcl::process autopurge 1
+}
+# - Two children
+test process-5.2 {exec two children in parallel} -body {
+ tcl::process autopurge 0
+ set f1 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
+ set f2 [open "|\"[interpreter]\" \"$path(exit)\" 0"]
+ set pid1 [pid $f1]
+ set pid2 [pid $f2]
+ set list [tcl::process list]
+ set statuses [tcl::process status -wait]
+ set status1 [lindex [tcl::process status $pid1] 1]
+ set status2 [lindex [tcl::process status $pid2] 1]
+ expr {
+ [llength $list] eq 2
+ && [lsearch $list $pid1] >= 0
+ && [lsearch $list $pid2] >= 0
+ && [dict size $statuses] eq 2
+ && [dict get $statuses $pid1] eq $status1
+ && [dict get $statuses $pid2] eq $status2
+ && $status1 eq 0
+ && $status2 eq 0
+ }
+} -result {1} -cleanup {
+ close $f1
+ close $f2
+ tcl::process purge
+ tcl::process autopurge 1
+}
+# - 3-stage pipe
+test process-5.3 {exec 3-stage pipe} -body {
+ tcl::process autopurge 0
+ set f [open "|
+ \"[interpreter]\" \"$path(exit)\" 0
+ | \"[interpreter]\" \"$path(exit)\" 0
+ | \"[interpreter]\" \"$path(exit)\" 0
+ "]
+ set pids [pid $f]
+ lassign $pids pid1 pid2 pid3
+ set list [tcl::process list]
+ set statuses [tcl::process status -wait]
+ set status1 [lindex [tcl::process status $pid1] 1]
+ set status2 [lindex [tcl::process status $pid2] 1]
+ set status3 [lindex [tcl::process status $pid3] 1]
+ expr {
+ [llength $pids] eq 3
+ && [llength $list] eq 3
+ && [lsearch $list $pid1] >= 0
+ && [lsearch $list $pid2] >= 0
+ && [lsearch $list $pid3] >= 0
+ && [dict size $statuses] eq 3
+ && [dict get $statuses $pid1] eq $status1
+ && [dict get $statuses $pid2] eq $status2
+ && [dict get $statuses $pid3] eq $status3
+ && $status1 eq 0
+ && $status2 eq 0
+ && $status3 eq 0
+ }
+} -result {1} -cleanup {
+ close $f
+ tcl::process purge
+ tcl::process autopurge 1
+}
+
+# Async child status
+test process-6.1 {async status} -setup {
+ signal_exit $path(test-signalfile) 0; # clean signal-file
+} -body {
+ tcl::process autopurge 0
+ set pid [exec [interpreter] $path(sleep) 1 $path(test-signalfile) &]
+ set status1 [lindex [tcl::process status $pid] 1]
+ signal_exit $path(test-signalfile); # signal exit (stop sleep)
+ set status2 [lindex [tcl::process status -wait $pid] 1]
+ expr {
+ $status1 eq {}
+ && $status2 eq 0
+ }
+} -result {1} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+test process-6.2 {selective wait} -setup {
+ signal_exit $path(test-signalfile) 0; # clean signal-files
+ signal_exit $path(test-signalfile2) 0;
+} -body {
+ tcl::process autopurge 0
+ # Child 1 sleeps 1s
+ set pid1 [exec [interpreter] $path(sleep) 1 $path(test-signalfile) &]
+ # Child 2 sleeps 1s
+ set pid2 [exec [interpreter] $path(sleep) 2 $path(test-signalfile2) &]
+ # Initial status
+ set status1_1 [lindex [tcl::process status $pid1] 1]
+ set status1_2 [lindex [tcl::process status $pid2] 1]
+ # Wait until child 1 termination
+ signal_exit $path(test-signalfile); # signal exit for pid1 (stop sleep)
+ set status2_1 [lindex [tcl::process status -wait $pid1] 1]
+ set status2_2 [lindex [tcl::process status $pid2] 1]
+ # Wait until child 2 termination
+ signal_exit $path(test-signalfile2); # signal exit for pid2 (stop sleep)
+ set status3_2 [lindex [tcl::process status -wait $pid2] 1]
+ set status3_1 [lindex [tcl::process status $pid1] 1]
+ expr {
+ $status1_1 eq {}
+ && $status1_2 eq {}
+ && $status2_1 eq 0
+ && $status2_2 eq {}
+ && $status3_1 eq 0
+ && $status3_2 eq 0
+ }
+} -result {1} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+
+# Error codes
+test process-7.1 {normal exit} -body {
+ tcl::process autopurge 0
+ set pid [exec [interpreter] $path(exit) 0 &]
+ lindex [tcl::process status -wait $pid] 1
+} -result {0} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+test process-7.2 {abnormal exit} -body {
+ tcl::process autopurge 0
+ set pid [exec [interpreter] $path(exit) 1 &]
+ lindex [tcl::process status -wait $pid] 1
+} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+test process-7.3 {child killed} -constraints {win} -body {
+ tcl::process autopurge 0
+ set pid [exec [interpreter] $path(exit) -1 &]
+ lindex [tcl::process status -wait $pid] 1
+} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup {
+ tcl::process purge
+ tcl::process autopurge 1
+}
+
+rename wait_for_file {}
+rename signal_exit {}
+::tcltest::cleanupTests
+return
diff --git a/tests/reg.test b/tests/reg.test
index d040632..b9dc538 100644
--- a/tests/reg.test
+++ b/tests/reg.test
@@ -49,9 +49,9 @@ catch [list package require -exact Tcltest [info patchlevel]]
# subexpressions, checking where empty substrings are located,
# etc. should be done using expectIndices and expectPartial.
-# The flag characters are complex and a bit eclectic. Generally speaking,
+# The flag characters are complex and a bit eclectic. Generally speaking,
# lowercase letters are compile options, uppercase are expected re_info
-# bits, and nonalphabetics are match options, controls for how the test is
+# bits, and nonalphabetics are match options, controls for how the test is
# run, or testing options. The one small surprise is that AREs are the
# default, and you must explicitly request lesser flavors of RE. The flags
# are as follows. It is admitted that some are not very mnemonic.
@@ -311,7 +311,7 @@ namespace eval RETest {
# match expected (full fanciness)
# expectIndices testno flags re target mat submat ...
proc expectIndices {args} {
- MatchExpected -indices {*}$args
+ MatchExpected -indices {*}$args
}
# partial match expected
diff --git a/tests/regexp.test b/tests/regexp.test
index 9fff262..7367af7 100644
--- a/tests/regexp.test
+++ b/tests/regexp.test
@@ -19,6 +19,20 @@ if {"::tcltest" ni [namespace children]} {
unset -nocomplain foo
testConstraint exec [llength [info commands exec]]
+
+# Used for constraining memory leak tests
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc memtest script {
+ set end [lindex [split [memory info] \n] 3 3]
+ for {set i 0} {$i < 5} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [lindex [split [memory info] \n] 3 3]
+ }
+ expr {$end - $tmp}
+ }
+}
test regexp-1.1 {basic regexp operation} {
regexp ab*c abbbc
@@ -453,7 +467,7 @@ test regexp-11.4 {regsub errors} {
} {1 {wrong # args: should be "regsub ?-option ...? exp string subSpec ?varName?"}}
test regexp-11.5 {regsub errors} {
list [catch {regsub -gorp a b c} msg] $msg
-} {1 {bad option "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
+} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexp-11.6 {regsub errors} {
list [catch {regsub -nocase a( b c d} msg] $msg
} {1 {couldn't compile regular expression pattern: parentheses () not balanced}}
@@ -480,7 +494,7 @@ test regexp-11.12 {regsub without final variable name returns value} {
} {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...
+# 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} {
@@ -742,10 +756,10 @@ test regexp-19.2 {regsub null replacement} {
test regexp-20.1 {regsub shared object shimmering} {
# Bug #461322
- set a abcdefghijklmnopqurstuvwxyz
- set b $a
- set c abcdefghijklmnopqurstuvwxyz0123456789
- regsub $a $c $b d
+ 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} {
@@ -1123,6 +1137,57 @@ test regexp-26.12 {regexp with -line option} {
test regexp-26.13 {regexp without -line option} {
regexp -all -inline -- {a*} "b\n"
} {{} {}}
+
+test regexp-27.1 {regsub -command} {
+ regsub -command {.x.} {abcxdef} {string length}
+} ab3ef
+test regexp-27.2 {regsub -command} {
+ regsub -command {.x.} {abcxdefxghi} {string length}
+} ab3efxghi
+test regexp-27.3 {regsub -command} {
+ set x 0
+ regsub -all -command {(?=.)} abcde {apply {args {incr ::x}}}
+} 1a2b3c4d5e
+test regexp-27.4 {regsub -command} -body {
+ regsub -command {.x.} {abcxdef} error
+} -returnCodes error -result cxd
+test regexp-27.5 {regsub -command} {
+ regsub -command {(.)(.)} {abcdef} {list ,}
+} {, ab a bcdef}
+test regexp-27.6 {regsub -command} {
+ regsub -command -all {(.)(.)} {abcdef} {list ,}
+} {, ab a b, cd c d, ef e f}
+test regexp-27.7 {regsub -command representation smash} {
+ set ::s {123=456 789}
+ regsub -command -all {\d+} $::s {apply {n {
+ expr {[llength $::s] + $n}
+ }}}
+} {125=458 791}
+test regexp-27.8 {regsub -command representation smash} {
+ set ::t {apply {n {
+ expr {[llength [lindex $::t 1 1 1]] + $n}
+ }}}
+ regsub -command -all {\d+} "123=456 789" $::t
+} {131=464 797}
+test regexp-27.9 {regsub -command memory leak testing} memory {
+ set ::s "123=456 789"
+ set ::t {apply {n {
+ expr {[llength [lindex $::t 1 1 1]] + [llength $::s] + $n}
+ }}}
+ memtest {
+ regsub -command -all {\d+} $::s $::t
+ }
+} 0
+test regexp-27.10 {regsub -command error cases} -returnCodes error -body {
+ regsub -command . abc "def \{ghi"
+} -result {unmatched open brace in list}
+test regexp-27.11 {regsub -command error cases} -returnCodes error -body {
+ regsub -command . abc {}
+} -result {command prefix must be a list of at least one element}
+test regexp-27.12 {regsub -command representation smash} {
+ set s {list (.+)}
+ regsub -command $s {list list} $s
+} {(.+) {list list} list}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/regexpComp.test b/tests/regexpComp.test
index 01ef06d..fbf8012 100644
--- a/tests/regexpComp.test
+++ b/tests/regexpComp.test
@@ -22,7 +22,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
proc evalInProc { script } {
proc testProc {} $script
set status [catch {
- testProc
+ testProc
} result]
rename testProc {}
return $result
@@ -587,7 +587,7 @@ test regexpComp-11.5 {regsub errors} {
evalInProc {
list [catch {regsub -gorp a b c} msg] $msg
}
-} {1 {bad option "-gorp": must be -all, -nocase, -expanded, -line, -linestop, -lineanchor, -start, or --}}
+} {1 {bad option "-gorp": must be -all, -command, -expanded, -line, -linestop, -lineanchor, -nocase, -start, or --}}
test regexpComp-11.6 {regsub errors} {
evalInProc {
list [catch {regsub -nocase a( b c d} msg] $msg
@@ -607,7 +607,7 @@ test regexpComp-11.8 {regsub errors, -start bad int check} {
} {1 {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}}
# This test crashes on the Mac unless you increase the Stack Space to about 1
-# Meg. This is probably bigger than most users want...
+# Meg. This is probably bigger than most users want...
# 8.2.3 regexp reduced stack space requirements, but this should be
# tested again
test regexpComp-12.1 {Tcl_RegExpExec: large number of subexpressions} {macCrash} {
@@ -794,10 +794,10 @@ test regexpComp-19.1 {regsub null replacement} {
test regexpComp-20.1 {regsub shared object shimmering} {
evalInProc {
# Bug #461322
- set a abcdefghijklmnopqurstuvwxyz
- set b $a
- set c abcdefghijklmnopqurstuvwxyz0123456789
- regsub $a $c $b d
+ 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]
diff --git a/tests/result.test b/tests/result.test
index 9e8a66b..859e546 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -31,7 +31,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} {
} {append result}
test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult dynamic {set x 42} 0
-} {dynamic result notCalled present}
+} {dynamic result presentOrFreed}
test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult object {set x 42} 0
} {object result same}
@@ -43,7 +43,7 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} {
} {42}
test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult dynamic {set x 42} 1
-} {42 called missing}
+} {42 presentOrFreed}
test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult object {set x 42} 1
} {42 different}
diff --git a/tests/safe.test b/tests/safe.test
index 11ad2a9..356e176 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -74,7 +74,7 @@ test safe-2.3 {creating safe interpreters, should have no unexpected aliases} -s
lsort [a aliases]
} -cleanup {
interp delete a
-} -result {::tcl::mathfunc::max ::tcl::mathfunc::min clock}
+} -result {clock}
test safe-3.1 {calling safe::interpInit is safe} -setup {
catch {safe::interpDelete a}
@@ -92,7 +92,7 @@ test safe-3.2 {calling safe::interpCreate on trusted interp} -setup {
lsort [a aliases]
} -cleanup {
safe::interpDelete a
-} -result {::tcl::file::atime ::tcl::file::attributes ::tcl::file::copy ::tcl::file::delete ::tcl::file::dirname ::tcl::file::executable ::tcl::file::exists ::tcl::file::extension ::tcl::file::isdirectory ::tcl::file::isfile ::tcl::file::link ::tcl::file::lstat ::tcl::file::mkdir ::tcl::file::mtime ::tcl::file::nativename ::tcl::file::normalize ::tcl::file::owned ::tcl::file::readable ::tcl::file::readlink ::tcl::file::rename ::tcl::file::rootname ::tcl::file::size ::tcl::file::stat ::tcl::file::tail ::tcl::file::tempfile ::tcl::file::type ::tcl::file::volumes ::tcl::file::writable ::tcl::info::nameofexecutable clock encoding exit glob load source}
+} -result {::tcl::encoding::system ::tcl::file::dirname ::tcl::file::extension ::tcl::file::rootname ::tcl::file::tail ::tcl::info::nameofexecutable clock encoding exit file glob load source}
test safe-3.3 {calling safe::interpCreate on trusted interp} -setup {
catch {safe::interpDelete a}
} -body {
@@ -464,14 +464,14 @@ test safe-11.1 {testing safe encoding} -setup {
interp eval $i encoding
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -result {wrong # args: should be "encoding option ?arg ...?"}
+} -result {wrong # args: should be "encoding subcommand ?arg ...?"}
test safe-11.1a {testing safe encoding} -setup {
set i [safe::interpCreate]
} -body {
interp eval $i encoding foobar
} -returnCodes error -cleanup {
safe::interpDelete $i
-} -match glob -result {bad option "foobar": must be *}
+} -match glob -result {unknown or ambiguous subcommand "foobar": must be *}
test safe-11.2 {testing safe encoding} -setup {
set i [safe::interpCreate]
} -body {
@@ -526,8 +526,6 @@ test safe-11.7.1 {testing safe encoding} -setup {
while executing
"encoding convertfrom"
invoked from within
-"::interp invokehidden interp* encoding convertfrom"
- invoked from within
"encoding convertfrom"
invoked from within
"interp eval $i encoding convertfrom"}
@@ -550,8 +548,6 @@ test safe-11.8.1 {testing safe encoding} -setup {
while executing
"encoding convertto"
invoked from within
-"::interp invokehidden interp* encoding convertto"
- invoked from within
"encoding convertto"
invoked from within
"interp eval $i encoding convertto"}
@@ -765,7 +761,7 @@ test safe-15.1 {safe file ensemble does not surprise code} -setup {
unset -nocomplain msg
interp delete $i
} -result {1 {a b c} 1 {a b c} 1 {invalid command name "file"} 1 0 {a b c} 1 {not allowed to invoke subcommand isdirectory of file}}
-test safe-15.1.1 {safe file ensemble does not surprise code} -setup {
+test safe-15.2 {safe file ensemble does not surprise code} -setup {
set i [interp create -safe]
} -body {
set result [expr {"file" in [interp hidden $i]}]
diff --git a/tests/scan.test b/tests/scan.test
index 98c581b..b488f68 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -19,11 +19,8 @@ if {"::tcltest" ni [namespace children]} {
# procedure that returns the range of integers
proc int_range {} {
- for { set MIN_INT 1 } { int($MIN_INT) > 0 } {} {
- set MIN_INT [expr { $MIN_INT << 1 }]
- }
- set MIN_INT [expr {int($MIN_INT)}]
- set MAX_INT [expr { ~ $MIN_INT }]
+ set MAX_INT [expr {[format %u -2]/2}]
+ set MIN_INT [expr { ~ $MAX_INT }]
return [list $MIN_INT $MAX_INT]
}
@@ -85,8 +82,7 @@ proc testIEEE {} {
}
testConstraint ieeeFloatingPoint [testIEEE]
-testConstraint wideIs64bit \
- [expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
test scan-1.1 {BuildCharSet, CharInSet} {
list [scan foo {%[^o]} x] $x
@@ -557,8 +553,8 @@ test scan-5.19 {bigint scanning invalid} -setup {
set a {};
} -body {
list [scan "207698809136909011942886895" \
- %llu a] $a
-} -returnCodes 1 -result {unsigned bignum scans are invalid}
+ %llu a] $a
+} -result {1 207698809136909011942886895}
test scan-6.1 {floating-point scanning} -setup {
set a {}; set b {}; set c {}; set d {}
diff --git a/tests/set-old.test b/tests/set-old.test
index 6138ed8..ea5155b 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -340,7 +340,7 @@ test set-old-8.6 {array command} {
catch {unset a}
set a(22) 3
list [catch {array gorp a} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, 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
@@ -700,7 +700,7 @@ test set-old-9.1 {ids for array enumeration} {
catch {unset a}
set a(a) 1
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]
+ [array done a s-2-a; array do 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} {
catch {unset a}
@@ -940,7 +940,7 @@ catch {rename foo {}}
# cleanup
::tcltest::cleanupTests
-return
+return
# Local Variables:
# mode: tcl
diff --git a/tests/set.test b/tests/set.test
index 374ff7a..3c87000 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -561,7 +561,7 @@ catch {unset i}
catch {unset x}
catch {unset z}
::tcltest::cleanupTests
-return
+return
# Local Variables:
# mode: tcl
diff --git a/tests/socket.test b/tests/socket.test
index dc3c04a..1d202f3 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -60,8 +60,13 @@
# listening at port 2048. If all fails, a message is printed and the tests
# using the remote server are not performed.
-package require tcltest 2
-namespace import -force ::tcltest::*
+if {[lsearch [namespace children] ::tcltest] == -1} {
+ package require tcltest
+ namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
if {[expr {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]} {
return
@@ -90,6 +95,14 @@ proc randport {} {
return $port
}
+# Check if testsocket testflags is available
+testConstraint testsocket_testflags [expr {![catch {
+ set h [socket -async localhost [randport]]
+ testsocket testflags $h 0
+ close $h
+ }]}]
+
+
# Test the latency of tcp connections over the loopback interface. Some OSes
# (e.g. NetBSD) seem to use the Nagle algorithm and delayed ACKs, so it takes
# up to 200ms for a packet sent to localhost to arrive. We're measuring this
@@ -276,9 +289,6 @@ proc getPort sock {
lindex [fconfigure $sock -sockname] 2
}
-# Some tests in this file are known to hang *occasionally* on OSX; stop the
-# worst offenders.
-testConstraint notOSX [expr {$::tcl_platform(os) ne "Darwin"}]
# ----------------------------------------------------------------------
@@ -287,13 +297,13 @@ test socket_$af-1.1 {arg parsing for socket command} -constraints [list socket s
} -returnCodes error -result {no argument given for -server option}
test socket_$af-1.2 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo
-} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.3 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myaddr
} -returnCodes error -result {no argument given for -myaddr option}
test socket_$af-1.4 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myaddr $localhost
-} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.5 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport
} -returnCodes error -result {no argument given for -myport option}
@@ -302,19 +312,19 @@ test socket_$af-1.6 {arg parsing for socket command} -constraints [list socket s
} -returnCodes error -result {expected integer but got "xxxx"}
test socket_$af-1.7 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -myport 2522
-} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.8 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -froboz
-} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, or -server}
+} -returnCodes error -result {bad option "-froboz": must be -async, -myaddr, -myport, -reuseaddr, -reuseport, or -server}
test socket_$af-1.9 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -myport 2521 3333
} -returnCodes error -result {option -myport is not valid for servers}
test socket_$af-1.10 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket host 2528 -junk
-} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.11 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server callback 2520 --
-} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-myaddr addr? port"}
+} -returnCodes error -result {wrong # args: should be "socket ?-myaddr addr? ?-myport myport? ?-async? host port" or "socket -server command ?-reuseaddr boolean? ?-reuseport boolean? ?-myaddr addr? port"}
test socket_$af-1.12 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket foo badport
} -returnCodes error -result {expected integer but got "badport"}
@@ -324,6 +334,24 @@ test socket_$af-1.13 {arg parsing for socket command} -constraints [list socket
test socket_$af-1.14 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
socket -server foo -async
} -returnCodes error -result {cannot set -async option for server sockets}
+test socket_$af-1.15 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -reuseaddr yes 4242
+} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
+test socket_$af-1.16 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -reuseaddr no 4242
+} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
+test socket_$af-1.17 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -reuseaddr
+} -returnCodes error -result {no argument given for -reuseaddr option}
+test socket_$af-1.18 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -reuseport yes 4242
+} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
+test socket_$af-1.19 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -reuseport no 4242
+} -returnCodes error -result {options -reuseaddr and -reuseport are only valid for servers}
+test socket_$af-1.20 {arg parsing for socket command} -constraints [list socket supported_$af] -body {
+ socket -reuseport
+} -returnCodes error -result {no argument given for -reuseport option}
set path(script) [makeFile {} script]
@@ -1830,522 +1858,575 @@ catch {close $commandSocket}
catch {close $remoteProcChan}
}
unset ::tcl::unsupported::socketAF
-test socket-14.0.0 {[socket -async] when server only listens on IPv4} -setup {
- proc accept {s a p} {
- global x
- puts $s bye
- close $s
- set x ok
- }
- set server [socket -server accept -myaddr 127.0.0.1 0]
- set port [lindex [fconfigure $server -sockname] 2]
-} -constraints {socket supported_inet localhost_v4} -body {
- set client [socket -async localhost $port]
- set after [after $latency {set x [fconfigure $client -error]}]
- vwait x
- set x
-} -cleanup {
- catch {after cancel $after}
- catch {close $server}
- catch {close $client}
- unset -nocomplain x
-} -result ok
-test socket-14.0.1 {[socket -async] when server only listens on IPv6} -setup {
- proc accept {s a p} {
- global x
- puts $s bye
- close $s
- set x ok
- }
- set server [socket -server accept -myaddr ::1 0]
- set port [lindex [fconfigure $server -sockname] 2]
-} -constraints {socket supported_inet6 localhost_v6} -body {
- set client [socket -async localhost $port]
- set after [after $latency {set x [fconfigure $client -error]}]
- vwait x
- set x
-} -cleanup {
- catch {after cancel $after}
- catch {close $server}
- catch {close $client}
- unset -nocomplain x
-} -result ok
-test socket-14.1 {[socket -async] fileevent while still connecting} -setup {
- proc accept {s a p} {
- global x
- puts $s bye
- close $s
- lappend x ok
- }
- set server [socket -server accept -myaddr localhost 0]
- set port [lindex [fconfigure $server -sockname] 2]
- set x ""
-} -constraints socket -body {
- set client [socket -async localhost $port]
- fileevent $client writable {
- lappend x [fconfigure $client -error]
- fileevent $client writable {}
- }
- set after [after $latency {lappend x timeout}]
- while {[llength $x] < 2 && "timeout" ni $x} {
- vwait x
- }
- lsort $x; # we only want to see both events, the order doesn't matter
-} -cleanup {
- catch {after cancel $after}
- catch {close $server}
- catch {close $client}
- unset -nocomplain x
-} -result {{} ok}
-test socket-14.2 {[socket -async] fileevent connection refused} -setup {
- set after [after $latency set x timeout]
-} -body {
- set client [socket -async localhost [randport]]
- fileevent $client writable {set x ok}
- vwait x
- lappend x [fconfigure $client -error]
-} -constraints socket -cleanup {
- catch {after cancel $after}
- catch {close $client}
- unset -nocomplain x after client
-} -result {ok {connection refused}}
-test socket-14.3 {[socket -async] when server only listens on IPv6} -setup {
- proc accept {s a p} {
- global x
- puts $s bye
- close $s
- set x ok
- }
- set server [socket -server accept -myaddr ::1 0]
- set port [lindex [fconfigure $server -sockname] 2]
-} -constraints {socket supported_inet6 localhost_v6} -body {
- set client [socket -async localhost $port]
- set after [after $latency {set x [fconfigure $client -error]}]
- vwait x
- set x
-} -cleanup {
- catch {after cancel $after}
- catch {close $server}
- catch {close $client}
- unset -nocomplain x
-} -result ok
-test socket-14.4 {[socket -async] and both, readdable and writable fileevents} -setup {
- proc accept {s a p} {
- puts $s bye
- close $s
- }
- set server [socket -server accept -myaddr localhost 0]
- set port [lindex [fconfigure $server -sockname] 2]
- set x ""
-} -constraints socket -body {
- set client [socket -async localhost $port]
- fileevent $client writable {
- lappend x [fconfigure $client -error]
- fileevent $client writable {}
- }
- fileevent $client readable {lappend x [gets $client]}
- set after [after $latency {lappend x timeout}]
- while {[llength $x] < 2 && "timeout" ni $x} {
- vwait x
- }
- lsort $x
-} -cleanup {
- catch {after cancel $after}
- catch {close $client}
- catch {close $server}
- unset -nocomplain x
-} -result {{} bye}
+test socket-14.0.0 {[socket -async] when server only listens on IPv4} \
+ -constraints {socket supported_inet localhost_v4} \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ } -body {
+ set client [socket -async localhost $port]
+ set after [after $latency {set x [fconfigure $client -error]}]
+ vwait x
+ set x
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result ok
+test socket-14.0.1 {[socket -async] when server only listens on IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr ::1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ } -body {
+ set client [socket -async localhost $port]
+ set after [after $latency {set x [fconfigure $client -error]}]
+ vwait x
+ set x
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result ok
+test socket-14.1 {[socket -async] fileevent while still connecting} \
+ -constraints {socket} \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ lappend x ok
+ }
+ set server [socket -server accept -myaddr localhost 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ set x ""
+ } -body {
+ set client [socket -async localhost $port]
+ fileevent $client writable {
+ lappend x [fconfigure $client -error]
+ fileevent $client writable {}
+ }
+ set after [after $latency {lappend x timeout}]
+ while {[llength $x] < 2 && "timeout" ni $x} {
+ vwait x
+ }
+ lsort $x; # we only want to see both events, the order doesn't matter
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result {{} ok}
+test socket-14.2 {[socket -async] fileevent connection refused} \
+ -constraints {socket} \
+ -body {
+ set client [socket -async localhost [randport]]
+ fileevent $client writable {set x ok}
+ set after [after $latency {set x timeout}]
+ vwait x
+ after cancel $after
+ lappend x [fconfigure $client -error]
+ } -cleanup {
+ after cancel $after
+ close $client
+ unset x after client
+ } -result {ok {connection refused}}
+test socket-14.3 {[socket -async] when server only listens on IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr ::1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ } -body {
+ set client [socket -async localhost $port]
+ set after [after $latency {set x [fconfigure $client -error]}]
+ vwait x
+ set x
+ } -cleanup {
+ after cancel $after
+ close $server
+ close $client
+ unset x
+ } -result ok
+test socket-14.4 {[socket -async] and both, readdable and writable fileevents} \
+ -constraints {socket} \
+ -setup {
+ proc accept {s a p} {
+ puts $s bye
+ close $s
+ }
+ set server [socket -server accept -myaddr localhost 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ set x ""
+ } -body {
+ set client [socket -async localhost $port]
+ fileevent $client writable {
+ lappend x [fconfigure $client -error]
+ fileevent $client writable {}
+ }
+ fileevent $client readable {lappend x [gets $client]}
+ set after [after $latency {lappend x timeout}]
+ while {[llength $x] < 2 && "timeout" ni $x} {
+ vwait x
+ }
+ lsort $x
+ } -cleanup {
+ after cancel $after
+ close $client
+ close $server
+ unset x
+ } -result {{} bye}
# FIXME: we should also have an IPv6 counterpart of this
-test socket-14.5 {[socket -async] which fails before any connect() can be made} -body {
- # address from rfc5737
- socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
-} -constraints {socket supported_inet notOSX} -returnCodes 1 \
+test socket-14.5 {[socket -async] which fails before any connect() can be made} \
+ -constraints {socket supported_inet} \
+ -body {
+ # address from rfc5737
+ socket -async -myaddr 192.0.2.42 127.0.0.1 [randport]
+ } \
+ -returnCodes 1 \
-result {couldn't open socket: cannot assign requested address}
-test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} -setup {
- proc accept {s a p} {
- global x
- puts $s bye
- close $s
- set x ok
- }
- set server [socket -server accept -myaddr 127.0.0.1 0]
- set port [lindex [fconfigure $server -sockname] 2]
- set x ""
-} -constraints {socket supported_inet localhost_v4} -body {
- set client [socket -async localhost $port]
- for {set i 0} {$i < 50} {incr i } {
- update
- if {$x ne ""} {
- lappend x [gets $client]
- break
- }
- after 100
- }
- set x
-} -cleanup {
- catch {close $server}
- catch {close $client}
- unset -nocomplain x
-} -result {ok bye}
-test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} -setup {
- proc accept {s a p} {
- global x
- puts $s bye
- close $s
- set x ok
- }
- set server [socket -server accept -myaddr ::1 0]
- set port [lindex [fconfigure $server -sockname] 2]
- set x ""
-} -constraints {socket supported_inet6 localhost_v6} -body {
- set client [socket -async localhost $port]
- for {set i 0} {$i < 50} {incr i } {
- update
- if {$x ne ""} {
- lappend x [gets $client]
- break
- }
- after 100
- }
- set x
-} -cleanup {
- catch {close $server}
- catch {close $client}
- unset -nocomplain x
-} -result {ok bye}
-test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} -setup {
- makeFile {
- fileevent stdin readable exit
- set server [socket -server accept -myaddr 127.0.0.1 0]
- proc accept {s h p} {puts $s ok; close $s; set ::x 1}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
-} -constraints {socket supported_inet localhost_v4 notOSX} -body {
- set sock [socket -async localhost $port]
- list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
-} -cleanup {
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {{} ok {}}
-test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} -setup {
- makeFile {
- fileevent stdin readable exit
- set server [socket -server accept -myaddr ::1 0]
- proc accept {s h p} {puts $s ok; close $s; set ::x 1}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
-} -constraints {socket supported_inet6 localhost_v6 notOSX} -body {
- set sock [socket -async localhost $port]
- list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
-} -cleanup {
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {{} ok {}}
-test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} -setup {
- set sock [socket -server error 0]
- set unusedPort [lindex [fconfigure $sock -sockname] 2]
- close $sock
-} -body {
- set sock [socket -async localhost $unusedPort]
- catch {gets $sock} x
- list $x [fconfigure $sock -error] [fconfigure $sock -error]
-} -constraints {socket notOSX} -cleanup {
- catch {close $sock}
-} -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
-test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} -setup {
- makeFile {
- fileevent stdin readable exit
- set server [socket -server accept -myaddr 127.0.0.1 0]
- proc accept {s h p} {puts $s ok; close $s; set ::x 1}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
-} -constraints {socket supported_inet localhost_v4} -body {
- set sock [socket -async localhost $port]
- fconfigure $sock -blocking 0
- for {set i 0} {$i < 50} {incr i } {
- if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
- after 200
- }
- set x
-} -cleanup {
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {ok}
-test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} -setup {
- makeFile {
- fileevent stdin readable exit
- set server [socket -server accept -myaddr ::1 0]
- proc accept {s h p} {puts $s ok; close $s; set ::x 1}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
-} -constraints {socket supported_inet6 localhost_v6} -body {
- set sock [socket -async localhost $port]
- fconfigure $sock -blocking 0
- for {set i 0} {$i < 50} {incr i } {
- if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
- after 200
- }
- set x
-} -cleanup {
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {ok}
-test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} -body {
- set sock [socket -async localhost [randport]]
- fconfigure $sock -blocking 0
- for {set i 0} {$i < 50} {incr i } {
- if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
- after 200
- }
- list $x [fconfigure $sock -error] [fconfigure $sock -error]
-} -constraints socket -cleanup {
- catch {close $sock}
-} -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
-test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} -setup {
- makeFile {
- fileevent stdin readable exit
- after 10000 exit
- set server [socket -server accept -myaddr 127.0.0.1 0]
- proc accept {s h p} {set ::x $s}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- puts [gets $x]
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
-} -constraints {socket supported_inet localhost_v4 notOSX} -body {
- set sock [socket -async localhost $port]
- puts $sock ok
- flush $sock
- list [fconfigure $sock -error] [gets $fd]
-} -cleanup {
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {{} ok}
-test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} -setup {
- makeFile {
- fileevent stdin readable exit
- after 10000 exit
- set server [socket -server accept -myaddr ::1 0]
- proc accept {s h p} {set ::x $s}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- puts [gets $x]
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
-} -constraints {socket supported_inet6 localhost_v6 notOSX} -body {
- set sock [socket -async localhost $port]
- puts $sock ok
- flush $sock
- list [fconfigure $sock -error] [gets $fd]
-} -cleanup {
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {{} ok}
-test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} -setup {
- makeFile {
- fileevent stdin readable exit
- set server [socket -server accept -myaddr 127.0.0.1 0]
- proc accept {s h p} {set ::x $s}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- puts [gets $x]
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
- set after [after $latency set x timeout]
-} -constraints {socket supported_inet localhost_v4} -body {
- set sock [socket -async localhost $port]
- fconfigure $sock -blocking 0
- puts $sock ok
- flush $sock
- fileevent $fd readable {set x 1}
- vwait x
- list [fconfigure $sock -error] [gets $fd]
-} -cleanup {
- after cancel $after
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {{} ok}
-test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} -setup {
- makeFile {
- fileevent stdin readable exit
- set server [socket -server accept -myaddr ::1 0]
- proc accept {s h p} {set ::x $s}
- puts [lindex [fconfigure $server -sockname] 2]
- flush stdout
- vwait x
- puts [gets $x]
- } script
- set fd [open |[list [interpreter] script] RDWR]
- set port [gets $fd]
- set after [after $latency set x timeout]
-} -constraints {socket supported_inet6 localhost_v6} -body {
- set sock [socket -async localhost $port]
- fconfigure $sock -blocking 0
- puts $sock ok
- flush $sock
- fileevent $fd readable {set x 1}
- vwait x
- list [fconfigure $sock -error] [gets $fd]
-} -cleanup {
- after cancel $after
- catch {close $fd}
- catch {close $sock}
- removeFile script
-} -result {{} ok}
-test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} -setup {
- set after [after $latency set x timeout]
-} -body {
- set sock [socket -async localhost [randport]]
- fconfigure $sock -blocking 0
- puts $sock ok
- fileevent $sock writable {set x 1}
- vwait x
- close $sock
-} -constraints socket -cleanup {
- after cancel $after
- catch {close $sock}
- unset -nocomplain x
-} -result {socket is not connected} -returnCodes 1
-test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} -setup {
- set after [after $latency set x timeout]
-} -body {
- set sock [socket -async localhost [randport]]
- fconfigure $sock -blocking 0
- puts $sock ok
- flush $sock
- fileevent $sock writable {set x 1}
- vwait x
- close $sock
-} -constraints {socket nonPortable} -cleanup {
- after cancel $timeout
- catch {close $sock}
- unset -nocomplain x
-} -result {socket is not connected} -returnCodes 1
-test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} -body {
- set s [socket -async localhost [randport]]
- for {set i 0} {$i < 50} {incr i} {
- set x [fconfigure $s -error]
- if {$x != ""} break
- after 200
- }
- set x
-} -constraints socket -cleanup {
- catch {close $s}
- unset -nocomplain x s
-} -result {connection refused}
-test socket-14.13 {testing writable event when quick failure} -body {
+test socket-14.6.0 {[socket -async] with no event loop and server listening on IPv4} \
+ -constraints {socket supported_inet localhost_v4} \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ set x ""
+ } \
+ -body {
+ set client [socket -async localhost $port]
+ for {set i 0} {$i < 50} {incr i } {
+ update
+ if {$x ne ""} {
+ lappend x [gets $client]
+ break
+ }
+ after 100
+ }
+ set x
+ } \
+ -cleanup {
+ close $server
+ close $client
+ unset x
+ } \
+ -result {ok bye}
+test socket-14.6.1 {[socket -async] with no event loop and server listening on IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ proc accept {s a p} {
+ global x
+ puts $s bye
+ close $s
+ set x ok
+ }
+ set server [socket -server accept -myaddr ::1 0]
+ set port [lindex [fconfigure $server -sockname] 2]
+ set x ""
+ } \
+ -body {
+ set client [socket -async localhost $port]
+ for {set i 0} {$i < 50} {incr i } {
+ update
+ if {$x ne ""} {
+ lappend x [gets $client]
+ break
+ }
+ after 100
+ }
+ set x
+ } \
+ -cleanup {
+ close $server
+ close $client
+ unset x
+ } \
+ -result {ok bye}
+test socket-14.7.0 {pending [socket -async] and blocking [gets], server is IPv4} \
+ -constraints {socket supported_inet localhost_v4} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {{} ok {}}
+test socket-14.7.1 {pending [socket -async] and blocking [gets], server is IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr ::1 0]
+ proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ list [fconfigure $sock -error] [gets $sock] [fconfigure $sock -error]
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {{} ok {}}
+test socket-14.7.2 {pending [socket -async] and blocking [gets], no listener} \
+ -constraints {socket} \
+ -body {
+ set sock [socket -async localhost [randport]]
+ catch {gets $sock} x
+ list $x [fconfigure $sock -error] [fconfigure $sock -error]
+ } -cleanup {
+ close $sock
+ } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
+test socket-14.8.0 {pending [socket -async] and nonblocking [gets], server is IPv4} \
+ -constraints {socket supported_inet localhost_v4} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ fconfigure $sock -blocking 0
+ for {set i 0} {$i < 50} {incr i } {
+ if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+ after 200
+ }
+ set x
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {ok}
+test socket-14.8.1 {pending [socket -async] and nonblocking [gets], server is IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr ::1 0]
+ proc accept {s h p} {puts $s ok; close $s; set ::x 1}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ fconfigure $sock -blocking 0
+ for {set i 0} {$i < 50} {incr i } {
+ if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+ after 200
+ }
+ set x
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {ok}
+test socket-14.8.2 {pending [socket -async] and nonblocking [gets], no listener} \
+ -constraints {socket} \
+ -body {
+ set sock [socket -async localhost [randport]]
+ fconfigure $sock -blocking 0
+ for {set i 0} {$i < 50} {incr i } {
+ if {[catch {gets $sock} x] || $x ne "" || ![fblocked $sock]} break
+ after 200
+ }
+ list $x [fconfigure $sock -error] [fconfigure $sock -error]
+ } -cleanup {
+ close $sock
+ } -match glob -result {{error reading "sock*": socket is not connected} {connection refused} {}}
+test socket-14.9.0 {pending [socket -async] and blocking [puts], server is IPv4} \
+ -constraints {socket supported_inet localhost_v4} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ proc accept {s h p} {set ::x $s}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ puts [gets $x]
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ puts $sock ok
+ flush $sock
+ list [fconfigure $sock -error] [gets $fd]
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {{} ok}
+test socket-14.9.1 {pending [socket -async] and blocking [puts], server is IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr ::1 0]
+ proc accept {s h p} {set ::x $s}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ puts [gets $x]
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ puts $sock ok
+ flush $sock
+ list [fconfigure $sock -error] [gets $fd]
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {{} ok}
+test socket-14.10.0 {pending [socket -async] and nonblocking [puts], server is IPv4} \
+ -constraints {socket supported_inet localhost_v4} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr 127.0.0.1 0]
+ proc accept {s h p} {set ::x $s}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ puts [gets $x]
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ fconfigure $sock -blocking 0
+ puts $sock ok
+ flush $sock
+ fileevent $fd readable {set x 1}
+ vwait x
+ list [fconfigure $sock -error] [gets $fd]
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {{} ok}
+test socket-14.10.1 {pending [socket -async] and nonblocking [puts], server is IPv6} \
+ -constraints {socket supported_inet6 localhost_v6} \
+ -setup {
+ makeFile {
+ fileevent stdin readable exit
+ set server [socket -server accept -myaddr ::1 0]
+ proc accept {s h p} {set ::x $s}
+ puts [lindex [fconfigure $server -sockname] 2]
+ flush stdout
+ vwait x
+ puts [gets $x]
+ } script
+ set fd [open |[list [interpreter] script] RDWR]
+ set port [gets $fd]
+ } -body {
+ set sock [socket -async localhost $port]
+ fconfigure $sock -blocking 0
+ puts $sock ok
+ flush $sock
+ fileevent $fd readable {set x 1}
+ vwait x
+ list [fconfigure $sock -error] [gets $fd]
+ } -cleanup {
+ close $fd
+ close $sock
+ removeFile script
+ } -result {{} ok}
+test socket-14.11.0 {pending [socket -async] and nonblocking [puts], no listener, no flush} \
+ -constraints {socket} \
+ -body {
+ set sock [socket -async localhost [randport]]
+ fconfigure $sock -blocking 0
+ puts $sock ok
+ fileevent $sock writable {set x 1}
+ vwait x
+ close $sock
+ } -cleanup {
+ catch {close $sock}
+ unset x
+ } -result {socket is not connected} -returnCodes 1
+test socket-14.11.1 {pending [socket -async] and nonblocking [puts], no listener, flush} \
+ -constraints {socket testsocket_testflags} \
+ -body {
+ set sock [socket -async localhost [randport]]
+ # Set the socket in async test mode.
+ # The async connect will not be continued on the following fconfigure
+ # and puts/flush. Thus, the connect will fail after them.
+ testsocket testflags $sock 1
+ fconfigure $sock -blocking 0
+ puts $sock ok
+ flush $sock
+ testsocket testflags $sock 0
+ fileevent $sock writable {set x 1}
+ vwait x
+ close $sock
+ } -cleanup {
+ catch {close $sock}
+ catch {unset x}
+ } -result {socket is not connected} -returnCodes 1
+test socket-14.12 {[socket -async] background progress triggered by [fconfigure -error]} \
+ -constraints {socket} \
+ -body {
+ set s [socket -async localhost [randport]]
+ for {set i 0} {$i < 50} {incr i} {
+ set x [fconfigure $s -error]
+ if {$x != ""} break
+ after 200
+ }
+ set x
+ } -cleanup {
+ close $s
+ unset x s
+ } -result {connection refused}
+
+test socket-14.13 {testing writable event when quick failure} \
+ -constraints {socket win supported_inet} \
+ -body {
# Test for bug 336441ed59 where a quick background fail was ignored
- #
+
# Test only for windows as socket -async 255.255.255.255 fails
# directly on unix
- #
+
# The following connect should fail very quickly
- set a1 [after $latency {set x timeout}]
+ set a1 [after 2000 {set x timeout}]
set s [socket -async 255.255.255.255 43434]
fileevent $s writable {set x writable}
vwait x
set x
-} -constraints {socket win supported_inet} -cleanup {
+} -cleanup {
catch {close $s}
after cancel $a1
} -result writable
-test socket-14.14 {testing fileevent readable on failed async socket connect} -body {
+
+test socket-14.14 {testing fileevent readable on failed async socket connect} \
+ -constraints {socket} -body {
# Test for bug 581937ab1e
- set a1 [after $latency {set x timeout}]
+
+ set a1 [after 5000 {set x timeout}]
# This connect should fail
set s [socket -async localhost [randport]]
fileevent $s readable {set x readable}
vwait x
set x
-} -constraints socket -cleanup {
+} -cleanup {
catch {close $s}
after cancel $a1
} -result readable
-test socket-14.15 {blocking read on async socket should not trigger event handlers} -setup {
- set subprocess [open "|[list [interpreter]]" r+]
- fconfigure $subprocess -blocking 0 -buffering none
-} -constraints socket -body {
- puts $subprocess {
- set s [socket -async localhost [randport]]
- set x ok
- fileevent $s writable {set x fail}
- catch {read $s}
+
+test socket-14.15 {blocking read on async socket should not trigger event handlers} \
+ -constraints socket -body {
+ set s [socket -async localhost [randport]]
+ set x ok
+ fileevent $s writable {set x fail}
+ catch {read $s}
close $s
- puts $x
- exit
- }
- set after [after $latency set x timeout]
- fileevent $subprocess readable [list gets $subprocess x]
- vwait x
- return $x
-} -cleanup {
- catch {after cancel $after}
- if {![testConstraint win]} {
- catch {exec kill [pid $subprocess]}
- }
- catch {close $subprocess}
- unset -nocomplain x
-} -result ok
+ set x
+ } -result ok
+
# v4 and v6 is required to prevent that the async connect does not terminate
# before the fconfigure command. There is always an additional ip to try.
-test socket-14.16 {empty -peername while [socket -async] connecting} -body {
- set client [socket -async localhost [randport]]
- fconfigure $client -peername
-} -constraints {socket localhost_v4 localhost_v6 notOSX} -cleanup {
- catch {close $client}
-} -result {}
+test socket-14.16 {empty -peername while [socket -async] connecting} \
+ -constraints {socket localhost_v4 localhost_v6} \
+ -body {
+ set client [socket -async localhost [randport]]
+ fconfigure $client -peername
+ } -cleanup {
+ catch {close $client}
+ } -result {}
+
# v4 and v6 is required to prevent that the async connect does not terminate
# before the fconfigure command. There is always an additional ip to try.
-test socket-14.17 {empty -sockname while [socket -async] connecting} -body {
- set client [socket -async localhost [randport]]
- fconfigure $client -sockname
-} -constraints {socket localhost_v4 localhost_v6 notOSX} -cleanup {
- catch {close $client}
-} -result {}
+test socket-14.17 {empty -sockname while [socket -async] connecting} \
+ -constraints {socket localhost_v4 localhost_v6} \
+ -body {
+ set client [socket -async localhost [randport]]
+ fconfigure $client -sockname
+ } -cleanup {
+ catch {close $client}
+ } -result {}
+
# test for bug c6ed4acfd8: running async socket connect with other connect
# established will block tcl as it goes in an infinite loop in vwait
-test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} -body {
- proc accept {channel address port} {}
- set port [randport]
- set ssock [socket -server accept $port]
- set csock1 [socket -async localhost [randport]]
- set csock2 [socket localhost $port]
- after 1000 {set done ok}
- vwait done
-} -constraints {socket notOSX} -cleanup {
- catch {close $ssock}
- catch {close $csock1}
- catch {close $csock2}
-} -result {}
+test socket-14.18 {bug c6ed4acfd8: running async socket connect made other connect block} \
+ -constraints {socket} \
+ -body {
+ proc accept {channel address port} {}
+ set port [randport]
+ set ssock [socket -server accept $port]
+ set csock1 [socket -async localhost [randport]]
+ set csock2 [socket localhost $port]
+ after 1000 {set done ok}
+ vwait done
+} -cleanup {
+ catch {close $ssock}
+ catch {close $csock1}
+ catch {close $csock2}
+ } -result {}
+
+test socket-14.19 {tip 456 -- introduce the -reuseport option} \
+ -constraints {socket} \
+ -body {
+ proc accept {channel address port} {}
+ set port [randport]
+ set ssock1 [socket -server accept -reuseport yes $port]
+ set ssock2 [socket -server accept -reuseport yes $port]
+ return ok
+} -cleanup {
+ catch {close $ssock1}
+ catch {close $ssock2}
+ } -result ok
set num 0
@@ -2357,7 +2438,8 @@ set resulterr {
}
foreach {servip sc} $x {
foreach {cliip cc} $x {
- set constraints [list socket $sc $cc]
+ set constraints socket
+ lappend constraints $sc $cc
set result $resulterr
switch -- [lsort -unique [list $servip $cliip]] {
localhost - 127.0.0.1 - ::1 {
@@ -2374,16 +2456,17 @@ foreach {servip sc} $x {
}
}
}
- test socket-15.1.$num "Connect to $servip from $cliip" -setup {
- set server [socket -server accept -myaddr $servip 0]
- proc accept {s h p} { close $s }
- set port [lindex [fconfigure $server -sockname] 2]
- } -constraints $constraints -body {
- set s [socket $cliip $port]
- } -cleanup {
- close $server
- catch {close $s}
- } {*}$result
+ test socket-15.1.$num "Connect to $servip from $cliip" \
+ -constraints $constraints -setup {
+ set server [socket -server accept -myaddr $servip 0]
+ proc accept {s h p} { close $s }
+ set port [lindex [fconfigure $server -sockname] 2]
+ } -body {
+ set s [socket $cliip $port]
+ } -cleanup {
+ close $server
+ catch {close $s}
+ } {*}$result
incr num
}
}
diff --git a/tests/source.test b/tests/source.test
index 0235bd1..8b146d3 100644
--- a/tests/source.test
+++ b/tests/source.test
@@ -12,8 +12,8 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-if {[catch {package require tcltest 2.1}]} {
- puts stderr "Skipping tests in [info script]. tcltest 2.1 required."
+if {[catch {package require tcltest 2.5}]} {
+ puts stderr "Skipping tests in [info script]. tcltest 2.5 required."
return
}
@@ -103,10 +103,9 @@ test source-2.6 {source error conditions} -setup {
set sourcefile [makeFile {} _non_existent_]
removeFile _non_existent_
} -body {
- list [catch {source $sourcefile} msg] $msg $::errorCode
-} -match listGlob -result [list 1 \
- {couldn't read file "*_non_existent_": no such file or directory} \
- {POSIX ENOENT {no such file or directory}}]
+ source $sourcefile
+} -match glob -result {couldn't read file "*_non_existent_": no such file or directory} \
+ -errorCode {POSIX ENOENT {no such file or directory}}
test source-2.7 {utf-8 with BOM} -setup {
set sourcefile [makeFile {} source.file]
} -body {
diff --git a/tests/split.test b/tests/split.test
index 18055b3..2d180e0 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -43,7 +43,7 @@ test split-1.8 {basic split commands} {
foreach f [split {]\n} {}] {
append x $f
}
- return $x
+ return $x
}
foo
} {]\n}
diff --git a/tests/stack.test b/tests/stack.test
index 13bc524..4c50f74 100644
--- a/tests/stack.test
+++ b/tests/stack.test
@@ -31,7 +31,7 @@ test stack-2.1 {maxNestingDepth reached on infinite recursion} -body {
puts $msg
}
} -result {too many nested evaluations (infinite loop?)}
-
+
# Make sure that there is enough stack to run regexp even if we're
# close to the recursion limit. [Bug 947070] [Patch 746378]
test stack-3.1 {enough room for regexp near recursion limit} -body {
diff --git a/tests/string.test b/tests/string.test
index a3590e5..c7df26d 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -20,297 +20,493 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
+# Helper commands to test various optimizations, code paths, and special cases.
+proc makeByteArray {s} {binary format a* $s}
+proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
+proc makeList {args} {return $args}
+proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}
+
# Some tests require the testobj command
-testConstraint testobj [expr {[info commands testobj] != {}}]
-testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
+testConstraint testobj [expr {[info commands testobj] ne {}}]
+testConstraint testindexobj [expr {[info commands testindexobj] ne {}}]
+testConstraint testevalex [expr {[info commands testevalex] ne {}}]
testConstraint tip389 [expr {[string length \U010000] == 2}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ return [lindex $lines 3 3]
+ }
+ proc leaktest {script {iterations 3}} {
+ set end [getbytes]
+ for {set i 0} {$i < $iterations} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [getbytes]
+ }
+ return [expr {$end - $tmp}]
+ }
+}
+
+proc representationpoke s {
+ set r [::tcl::unsupported::representation $s]
+ list [lindex $r 3] [string match {*, string representation "*"} $r]
+}
-test string-1.1 {error conditions} {
- list [catch {string gorp a b} msg] $msg
+foreach noComp {0 1} {
+
+if {$noComp} {
+ if {[info commands testevalex] eq {}} {
+ test string-0.1.$noComp "show testevalex availability" {testevalex} {list} {}
+ continue
+ }
+ interp alias {} run {} testevalex
+ set constraints testevalex
+} else {
+ interp alias {} run {} try
+ set constraints {}
+}
+
+
+test string-1.1.$noComp {error conditions} {
+ list [catch {run {string gorp a b}} msg] $msg
} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test string-1.2 {error conditions} {
- list [catch {string} msg] $msg
+test string-1.2.$noComp {error conditions} {
+ list [catch {run {string}} msg] $msg
} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
+test stringComp-1.3.$noComp {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} {
- list [catch {string compare a} msg] $msg
+test string-2.1.$noComp {string compare, too few args} {
+ list [catch {run {string compare a}} msg] $msg
} {1 {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"}}
-test string-2.2 {string compare, bad args} {
- list [catch {string compare a b c} msg] $msg
+test string-2.2.$noComp {string compare, bad args} {
+ list [catch {run {string compare a b c}} 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
+test string-2.3.$noComp {string compare, bad args} {
+ list [catch {run {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
+test string-2.4.$noComp {string compare, too many args} {
+ list [catch {run {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
+test string-2.5.$noComp {string compare with length unspecified} {
+ list [catch {run {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} {
- string compare abcde abdef
+test string-2.6.$noComp {string compare} {
+ run {string compare abcde abdef}
} -1
-test string-2.7 {string compare, shortest method name} {
- string co abcde ABCDE
+test string-2.7.$noComp {string compare, shortest method name} {
+ run {string co abcde ABCDE}
} 1
-test string-2.8 {string compare} {
- string compare abcde abcde
+test string-2.8.$noComp {string compare} {
+ run {string compare abcde abcde}
} 0
-test string-2.9 {string compare with length} {
- string compare -length 2 abcde abxyz
+test string-2.9.$noComp {string compare with length} {
+ run {string compare -length 2 abcde abxyz}
} 0
-test string-2.10 {string compare with special index} {
- list [catch {string compare -length end-3 abcde abxyz} msg] $msg
+test string-2.10.$noComp {string compare with special index} {
+ list [catch {run {string compare -length end-3 abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
-test string-2.11 {string compare, unicode} {
- string compare ab\u7266 ab\u7267
+test string-2.11.$noComp {string compare, unicode} {
+ run {string compare ab\u7266 ab\u7267}
+} -1
+test string-2.11.1.$noComp {string compare, unicode} {
+ run {string compare \334 \u00dc}
+} 0
+test string-2.11.2.$noComp {string compare, unicode} {
+ run {string compare \334 \u00fc}
} -1
-test string-2.12 {string compare, high bit} {
+test string-2.11.3.$noComp {string compare, unicode} {
+ run {string compare \334\334\334\374\374 \334\334\334\334\334}
+} 1
+test string-2.12.$noComp {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)
- string compare "\x80" "@"
+ run {string compare "\x80" "@"}
# 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} {
- string compare -nocase abcde abdef
+test string-2.13.$noComp {string compare -nocase} {
+ run {string compare -nocase abcde abdef}
} -1
-test string-2.14 {string compare -nocase} {
- string compare -nocase abcde ABCDE
+test string-2.13.1.$noComp {string compare -nocase} {
+ run {string compare -nocase abcde Abdef}
+} -1
+test string-2.14.$noComp {string compare -nocase} {
+ run {string compare -nocase abcde ABCDE}
+} 0
+test string-2.15.$noComp {string compare -nocase} {
+ run {string compare -nocase abcde abcde}
} 0
-test string-2.15 {string compare -nocase} {
- string compare -nocase abcde abcde
+test string-2.15.1.$noComp {string compare -nocase} {
+ run {string compare -nocase \334 \u00dc}
} 0
-test string-2.16 {string compare -nocase with length} {
- string compare -length 2 -nocase abcde Abxyz
+test string-2.15.2.$noComp {string compare -nocase} {
+ run {string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334}
} 0
-test string-2.17 {string compare -nocase with length} {
- string compare -nocase -length 3 abcde Abxyz
+test string-2.16.$noComp {string compare -nocase with length} {
+ run {string compare -length 2 -nocase abcde Abxyz}
+} 0
+test string-2.17.$noComp {string compare -nocase with length} {
+ run {string compare -nocase -length 3 abcde Abxyz}
} -1
-test string-2.18 {string compare -nocase with length <= 0} {
- string compare -nocase -length -1 abcde AbCdEf
+test string-2.18.$noComp {string compare -nocase with length <= 0} {
+ run {string compare -nocase -length -1 abcde AbCdEf}
} -1
-test string-2.19 {string compare -nocase with excessive length} {
- string compare -nocase -length 50 AbCdEf abcde
+test string-2.19.$noComp {string compare -nocase with excessive length} {
+ run {string compare -nocase -length 50 AbCdEf abcde}
} 1
-test string-2.20 {string compare -len unicode} {
+test string-2.20.$noComp {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
- string compare -len 5 \334\334\334 \334\334\374
+ run {string compare -len 5 \334\334\334 \334\334\374}
} -1
-test string-2.21 {string compare -nocase with special index} {
- list [catch {string compare -nocase -length end-3 Abcde abxyz} msg] $msg
+test string-2.21.$noComp {string compare -nocase with special index} {
+ list [catch {run {string compare -nocase -length end-3 Abcde abxyz}} msg] $msg
} {1 {expected integer but got "end-3"}}
-test string-2.22 {string compare, null strings} {
- string compare "" ""
+test string-2.22.$noComp {string compare, null strings} {
+ run {string compare "" ""}
} 0
-test string-2.23 {string compare, null strings} {
- string compare "" foo
+test string-2.23.$noComp {string compare, null strings} {
+ run {string compare "" foo}
} -1
-test string-2.24 {string compare, null strings} {
- string compare foo ""
+test string-2.24.$noComp {string compare, null strings} {
+ run {string compare foo ""}
} 1
-test string-2.25 {string compare -nocase, null strings} {
- string compare -nocase "" ""
+test string-2.25.$noComp {string compare -nocase, null strings} {
+ run {string compare -nocase "" ""}
} 0
-test string-2.26 {string compare -nocase, null strings} {
- string compare -nocase "" foo
+test string-2.26.$noComp {string compare -nocase, null strings} {
+ run {string compare -nocase "" foo}
} -1
-test string-2.27 {string compare -nocase, null strings} {
- string compare -nocase foo ""
+test string-2.27.$noComp {string compare -nocase, null strings} {
+ run {string compare -nocase foo ""}
} 1
-test string-2.28 {string compare with length, unequal strings} {
- string compare -length 2 abc abde
+test string-2.28.$noComp {string compare with length, unequal strings} {
+ run {string compare -length 2 abc abde}
} 0
-test string-2.29 {string compare with length, unequal strings} {
- string compare -length 2 ab abde
+test string-2.29.$noComp {string compare with length, unequal strings} {
+ run {string compare -length 2 ab abde}
} 0
-test string-2.30 {string compare with NUL character vs. other ASCII} {
+test string-2.30.$noComp {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
+ run {string compare \x00 \x01}
} -1
-test string-2.31 {string compare, high bit} {
- proc foo {} {string compare "a\x80" "a@"}
- foo
+test string-2.31.$noComp {string compare, high bit} {
+ run {string compare "a\x80" "a@"}
} 1
-test string-2.32 {string compare, high bit} {
- proc foo {} {string compare "a\x00" "a\x01"}
- foo
+test string-2.32.$noComp {string compare, high bit} {
+ run {string compare "a\x00" "a\x01"}
} -1
-test string-2.33 {string compare, high bit} {
- proc foo {} {string compare "\x00\x00" "\x00\x01"}
- foo
+test string-2.33.$noComp {string compare, high bit} {
+ run {string compare "\x00\x00" "\x00\x01"}
} -1
+test string-2.34.$noComp {string compare, binary equal} {
+ run {string compare [binary format a100 0] [binary format a100 0]}
+} 0
+test string-2.35.$noComp {string compare, binary neq} {
+ run {string compare [binary format a100a 0 1] [binary format a100a 0 0]}
+} 1
+test string-2.36.$noComp {string compare, binary neq unequal length} {
+ run {string compare [binary format a20a 0 1] [binary format a100a 0 0]}
+} 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} {
- string equal abcde abdef
+test string-3.1.$noComp {string equal} {
+ run {string equal abcde abdef}
} 0
-test string-3.2 {string equal} {
- string eq abcde ABCDE
+test string-3.2.$noComp {string equal} {
+ run {string e abcde ABCDE}
} 0
-test string-3.3 {string equal} {
- string equal abcde abcde
+test string-3.3.$noComp {string equal} {
+ run {string equal abcde abcde}
} 1
-test string-3.4 {string equal -nocase} {
- string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334
+test string-3.4.$noComp {string equal -nocase} {
+ run {string equal -nocase \334\334\334\334\374\374\374\374 \334\334\334\334\334\334\334\334}
} 1
-test string-3.5 {string equal -nocase} {
- string equal -nocase abcde abdef
+test string-3.5.$noComp {string equal -nocase} {
+ run {string equal -nocase abcde abdef}
} 0
-test string-3.6 {string equal -nocase} {
- string eq -nocase abcde ABCDE
+test string-3.6.$noComp {string equal -nocase} {
+ run {string eq -nocase abcde ABCDE}
} 1
-test string-3.7 {string equal -nocase} {
- string equal -nocase abcde abcde
+test string-3.7.$noComp {string equal -nocase} {
+ run {string equal -nocase abcde abcde}
+} 1
+test string-3.8.$noComp {string equal with length, unequal strings} {
+ run {string equal -length 2 abc abde}
+} 1
+test string-3.9.$noComp {string equal, too few args} {
+ list [catch {run {string equal a}} msg] $msg
+} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
+test string-3.10.$noComp {string equal, bad args} {
+ list [catch {run {string equal a b c}} msg] $msg
+} {1 {bad option "a": must be -nocase or -length}}
+test string-3.11.$noComp {string equal, bad args} {
+ list [catch {run {string equal -length -nocase str1 str2}} msg] $msg
+} {1 {expected integer but got "-nocase"}}
+test string-3.12.$noComp {string equal, too many args} {
+ list [catch {run {string equal -length 10 -nocase str1 str2 str3}} msg] $msg
+} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
+test string-3.13.$noComp {string equal with length unspecified} {
+ list [catch {run {string equal -length 10 10}} msg] $msg
+} {1 {wrong # args: should be "string equal ?-nocase? ?-length int? string1 string2"}}
+test string-3.14.$noComp {string equal with length} {
+ run {string equal -length 2 abcde abxyz}
+} 1
+test string-3.15.$noComp {string equal with special index} {
+ list [catch {run {string equal -length end-3 abcde abxyz}} msg] $msg
+} {1 {expected integer but got "end-3"}}
+
+test string-3.16.$noComp {string equal, unicode} {
+ run {string equal ab\u7266 ab\u7267}
+} 0
+test string-3.17.$noComp {string equal, unicode} {
+ run {string equal \334 \u00dc}
} 1
-test string-3.8 {string equal with length, unequal strings} {
- string equal -length 2 abc abde
+test string-3.18.$noComp {string equal, unicode} {
+ run {string equal \334 \u00fc}
+} 0
+test string-3.19.$noComp {string equal, unicode} {
+ run {string equal \334\334\334\374\374 \334\334\334\334\334}
+} 0
+test string-3.20.$noComp {string equal, 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)
+ run {string equal "\x80" "@"}
+ # 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.
+} 0
+test string-3.21.$noComp {string equal -nocase} {
+ run {string equal -nocase abcde Abdef}
+} 0
+test string-3.22.$noComp {string equal, -nocase unicode} {
+ run {string equal -nocase \334 \u00dc}
+} 1
+test string-3.23.$noComp {string equal, -nocase unicode} {
+ run {string equal -nocase \334\334\334\374\u00fc \334\334\334\334\334}
+} 1
+test string-3.24.$noComp {string equal -nocase with length} {
+ run {string equal -length 2 -nocase abcde Abxyz}
+} 1
+test string-3.25.$noComp {string equal -nocase with length} {
+ run {string equal -nocase -length 3 abcde Abxyz}
+} 0
+test string-3.26.$noComp {string equal -nocase with length <= 0} {
+ run {string equal -nocase -length -1 abcde AbCdEf}
+} 0
+test string-3.27.$noComp {string equal -nocase with excessive length} {
+ run {string equal -nocase -length 50 AbCdEf abcde}
+} 0
+test string-3.28.$noComp {string equal -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
+ run {string equal -len 5 \334\334\334 \334\334\374}
+} 0
+test string-3.29.$noComp {string equal -nocase with special index} {
+ list [catch {run {string equal -nocase -length end-3 Abcde abxyz}} msg] $msg
+} {1 {expected integer but got "end-3"}}
+test string-3.30.$noComp {string equal, null strings} {
+ run {string equal "" ""}
+} 1
+test string-3.31.$noComp {string equal, null strings} {
+ run {string equal "" foo}
+} 0
+test string-3.32.$noComp {string equal, null strings} {
+ run {string equal foo ""}
+} 0
+test string-3.33.$noComp {string equal -nocase, null strings} {
+ run {string equal -nocase "" ""}
+} 1
+test string-3.34.$noComp {string equal -nocase, null strings} {
+ run {string equal -nocase "" foo}
+} 0
+test string-3.35.$noComp {string equal -nocase, null strings} {
+ run {string equal -nocase foo ""}
+} 0
+test string-3.36.$noComp {string equal with NUL character vs. other ASCII} {
+ # Be careful here, since UTF-8 rep comparison with memcmp() of
+ # these puts chars in the wrong order
+ run {string equal \x00 \x01}
+} 0
+test string-3.37.$noComp {string equal, high bit} {
+ run {string equal "a\x80" "a@"}
+} 0
+test string-3.38.$noComp {string equal, high bit} {
+ run {string equal "a\x00" "a\x01"}
+} 0
+test string-3.39.$noComp {string equal, high bit} {
+ run {string equal "a\x00\x00" "a\x00\x01"}
+} 0
+test string-3.40.$noComp {string equal, binary equal} {
+ run {string equal [binary format a100 0] [binary format a100 0]}
} 1
+test string-3.41.$noComp {string equal, binary neq} {
+ run {string equal [binary format a100a 0 1] [binary format a100a 0 0]}
+} 0
+test string-3.42.$noComp {string equal, binary neq inequal length} {
+ run {string equal [binary format a20a 0 1] [binary format a100a 0 0]}
+} 0
+
-test string-4.1 {string first, too few args} {
- list [catch {string first a} msg] $msg
+test string-4.1.$noComp {string first, too few args} {
+ list [catch {run {string first a}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test string-4.2 {string first, bad args} {
- list [catch {string first a b c} msg] $msg
+test string-4.2.$noComp {string first, bad args} {
+ list [catch {run {string first a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-4.3 {string first, too many args} {
- list [catch {string first a b 5 d} msg] $msg
+test string-4.3.$noComp {string first, too many args} {
+ list [catch {run {string first a b 5 d}} msg] $msg
} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test string-4.4 {string first} {
- string first bq abcdefgbcefgbqrs
+test string-4.4.$noComp {string first} {
+ run {string first bq abcdefgbcefgbqrs}
} 12
-test string-4.5 {string first} {
- string fir bcd abcdefgbcefgbqrs
+test string-4.5.$noComp {string first} {
+ run {string fir bcd abcdefgbcefgbqrs}
} 1
-test string-4.6 {string first} {
- string f b abcdefgbcefgbqrs
+test string-4.6.$noComp {string first} {
+ run {string f b abcdefgbcefgbqrs}
} 1
-test string-4.7 {string first} {
- string first xxx x123xx345xxx789xxx012
+test string-4.7.$noComp {string first} {
+ run {string first xxx x123xx345xxx789xxx012}
} 9
-test string-4.8 {string first} {
- string first "" x123xx345xxx789xxx012
+test string-4.8.$noComp {string first} {
+ run {string first "" x123xx345xxx789xxx012}
} -1
-test string-4.9 {string first, unicode} {
- string first x abc\u7266x
+test string-4.9.$noComp {string first, unicode} {
+ run {string first x abc\u7266x}
} 4
-test string-4.10 {string first, unicode} {
- string first \u7266 abc\u7266x
+test string-4.10.$noComp {string first, unicode} {
+ run {string first \u7266 abc\u7266x}
} 3
-test string-4.11 {string first, start index} {
- string first \u7266 abc\u7266x 3
+test string-4.11.$noComp {string first, start index} {
+ run {string first \u7266 abc\u7266x 3}
} 3
-test string-4.12 {string first, start index} {
- string first \u7266 abc\u7266x 4
+test string-4.12.$noComp {string first, start index} {
+ run {string first \u7266 abc\u7266x 4}
} -1
-test string-4.13 {string first, start index} {
- string first \u7266 abc\u7266x end-2
+test string-4.13.$noComp {string first, start index} {
+ run {string first \u7266 abc\u7266x end-2}
} 3
-test string-4.14 {string first, negative start index} {
- string first b abc -1
+test string-4.14.$noComp {string first, negative start index} {
+ run {string first b abc -1}
} 1
-test string-4.15 {string first, ability to two-byte encoded utf-8 chars} {
+test string-4.15.$noComp {string first, ability to two-byte encoded utf-8 chars} {
# Test for a bug in Tcl 8.3 where test for all-single-byte-encoded
# strings was incorrect, leading to an index returned by [string first]
# which pointed past the end of the string.
set uchar \u057e ;# character with two-byte encoding in utf-8
- string first % %#$uchar$uchar#$uchar$uchar#% 3
+ run {string first % %#$uchar$uchar#$uchar$uchar#% 3}
} 8
-test string-4.17 {string first, corner case} {
- string first a aaa 4294967295
-} {0}
-test string-4.18 {string first, corner case} {
- string first a aaa -1
+test string-4.16.$noComp {string first, normal string vs pure unicode string} {
+ set s hello
+ regexp ll $s m
+ # Representation checks are canaries
+ run {list [representationpoke $s] [representationpoke $m] \
+ [string first $m $s]}
+} {{string 1} {string 0} 2}
+test string-4.17.$noComp {string first, corner case} {
+ run {string first a aaa 4294967295}
+} {-1}
+test string-4.18.$noComp {string first, corner case} {
+ run {string first a aaa -1}
} {0}
-test string-4.19 {string first, corner case} {
- string first a aaa end-5
+test string-4.19.$noComp {string first, corner case} {
+ run {string first a aaa end-5}
} {0}
-test string-4.20 {string last, corner case} {
- string last a aaa 4294967295
+test string-4.20.$noComp {string last, corner case} {
+ run {string last a aaa 4294967295}
+} {2}
+test string-4.21.$noComp {string last, corner case} {
+ run {string last a aaa -1}
} {-1}
-test string-4.21 {string last, corner case} {
- string last a aaa -1
-} {-1}
-test string-4.22 {string last, corner case} {
- string last a aaa end-5
+test string-4.22.$noComp {string last, corner case} {
+ run {string last a aaa end-5}
} {-1}
-test string-5.1 {string index} {
- list [catch {string index} msg] $msg
+test string-5.1.$noComp {string index} {
+ list [catch {run {string index}} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
-test string-5.2 {string index} {
- list [catch {string index a b c} msg] $msg
+test string-5.2.$noComp {string index} {
+ list [catch {run {string index a b c}} msg] $msg
} {1 {wrong # args: should be "string index string charIndex"}}
-test string-5.3 {string index} {
- string index abcde 0
+test string-5.3.$noComp {string index} {
+ run {string index abcde 0}
} a
-test string-5.4 {string index} {
- string in abcde 4
+test string-5.4.$noComp {string index} {
+ run {string ind abcde 4}
} e
-test string-5.5 {string index} {
- string index abcde 5
+test string-5.5.$noComp {string index} {
+ run {string index abcde 5}
} {}
-test string-5.6 {string index} {
- list [catch {string index abcde -10} msg] $msg
+test string-5.6.$noComp {string index} {
+ list [catch {run {string index abcde -10}} msg] $msg
} {0 {}}
-test string-5.7 {string index} {
- list [catch {string index a xyz} msg] $msg
+test string-5.7.$noComp {string index} {
+ list [catch {run {string index a xyz}} msg] $msg
} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-5.8 {string index} {
- string index abc end
+test string-5.8.$noComp {string index} {
+ run {string index abc end}
} c
-test string-5.9 {string index} {
- string index abc end-1
+test string-5.9.$noComp {string index} {
+ run {string index abc end-1}
} b
-test string-5.10 {string index, unicode} {
- string index abc\u7266d 4
+test string-5.10.$noComp {string index, unicode} {
+ run {string index abc\u7266d 4}
} d
-test string-5.11 {string index, unicode} {
- string index abc\u7266d 3
+test string-5.11.$noComp {string index, unicode} {
+ run {string index abc\u7266d 3}
} \u7266
-test string-5.12 {string index, unicode over char length, under byte length} {
- string index \334\374\334\374 6
+test string-5.12.$noComp {string index, unicode over char length, under byte length} {
+ run {string index \334\374\334\374 6}
} {}
-test string-5.13 {string index, bytearray object} {
- string index [binary format a5 fuz] 0
+test string-5.13.$noComp {string index, bytearray object} {
+ run {string index [binary format a5 fuz] 0}
} f
-test string-5.14 {string index, bytearray object} {
- string index [binary format I* {0x50515253 0x52}] 3
+test string-5.14.$noComp {string index, bytearray object} {
+ run {string index [binary format I* {0x50515253 0x52}] 3}
} S
-test string-5.15 {string index, bytearray object} {
+test string-5.15.$noComp {string index, bytearray object} {
set b [binary format I* {0x50515253 0x52}]
- set i1 [string index $b end-6]
- set i2 [string index $b 1]
- string compare $i1 $i2
+ set i1 [run {string index $b end-6}]
+ set i2 [run {string index $b 1}]
+ run {string compare $i1 $i2}
} 0
-test string-5.16 {string index, bytearray object with string obj shimmering} {
+test string-5.16.$noComp {string index, bytearray object with string obj shimmering} {
set str "0123456789\x00 abcdedfghi"
binary scan $str H* dump
- string compare [string index $str 10] \x00
+ run {string compare [run {string index $str 10}] \x00}
} 0
-test string-5.17 {string index, bad integer} -body {
- list [catch {string index "abc" 0o8} msg] $msg
+test string-5.17.$noComp {string index, bad integer} -body {
+ list [catch {run {string index "abc" 0o8}} msg] $msg
} -match glob -result {1 {*invalid octal number*}}
-test string-5.18 {string index, bad integer} -body {
- list [catch {string index "abc" end-0o0289} msg] $msg
+test string-5.18.$noComp {string index, bad integer} -body {
+ list [catch {run {string index "abc" end-0o0289}} msg] $msg
} -match glob -result {1 {*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.19.$noComp {string index, bytearray object out of bounds} {
+ run {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
+test string-5.20.$noComp {string index, bytearray object out of bounds} {
+ run {string index [binary format I* {0x50515253 0x52}] 20}
} {}
-test string-5.21 {string index, surrogates, bug [11ae2be95dac9417]} tip389 {
- list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]
+test string-5.21.$noComp {string index, surrogates, bug [11ae2be95dac9417]} tip389 {
+ run {list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]}
} [list \U100000 {} b]
@@ -323,871 +519,871 @@ proc largest_int {} {
return [expr {$int-1}]
}
-test string-6.1 {string is, too few args} {
- list [catch {string is} msg] $msg
+test string-6.1.$noComp {string is, too few args} {
+ list [catch {run {string is}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
-test string-6.2 {string is, too few args} {
- list [catch {string is alpha} msg] $msg
+test string-6.2.$noComp {string is, too few args} {
+ list [catch {run {string is alpha}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
-test string-6.3 {string is, bad args} {
- list [catch {string is alpha -failin str} msg] $msg
+test string-6.3.$noComp {string is, bad args} {
+ list [catch {run {string is alpha -failin str}} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
-test string-6.4 {string is, too many args} {
- list [catch {string is alpha -failin var -strict str more} msg] $msg
+test string-6.4.$noComp {string is, too many args} {
+ list [catch {run {string is alpha -failin var -strict str more}} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
-test string-6.5 {string is, class check} {
- list [catch {string is bogus str} msg] $msg
-} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
-test string-6.6 {string is, ambiguous class} {
- list [catch {string is al str} msg] $msg
-} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
-test string-6.7 {string is alpha, all ok} {
- string is alpha -strict -failindex var abc
-} 1
-test string-6.8 {string is, error in var} {
- list [string is alpha -failindex var abc5def] $var
+test string-6.5.$noComp {string is, class check} {
+ list [catch {run {string is bogus str}} msg] $msg
+} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
+test string-6.6.$noComp {string is, ambiguous class} {
+ list [catch {run {string is al str}} msg] $msg
+} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, dict, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
+test string-6.7.$noComp {string is alpha, all ok} {
+ run {string is alpha -strict -failindex var abc}
+} 1
+test string-6.8.$noComp {string is, error in var} {
+ list [run {string is alpha -failindex var abc5def}] $var
} {0 3}
-test string-6.9 {string is, var shouldn't get set} {
+test string-6.9.$noComp {string is, var shouldn't get set} {
catch {unset var}
- list [catch {string is alpha -failindex var abc; set var} msg] $msg
+ list [catch {run {string is alpha -failindex var abc; set var}} msg] $msg
} {1 {can't read "var": no such variable}}
-test string-6.10 {string is, ok on empty} {
- string is alpha {}
+test string-6.10.$noComp {string is, ok on empty} {
+ run {string is alpha {}}
} 1
-test string-6.11 {string is, -strict check against empty} {
- string is alpha -strict {}
+test string-6.11.$noComp {string is, -strict check against empty} {
+ run {string is alpha -strict {}}
} 0
-test string-6.12 {string is alnum, true} {
- string is alnum abc123
+test string-6.12.$noComp {string is alnum, true} {
+ run {string is alnum abc123}
} 1
-test string-6.13 {string is alnum, false} {
- list [string is alnum -failindex var abc1.23] $var
+test string-6.13.$noComp {string is alnum, false} {
+ list [run {string is alnum -failindex var abc1.23}] $var
} {0 4}
-test string-6.14 {string is alnum, unicode} "string is alnum abc\xfc" 1
-test string-6.15 {string is alpha, true} {
- string is alpha abc
+test string-6.14.$noComp {string is alnum, unicode} "run {string is alnum abc\xfc}" 1
+test string-6.15.$noComp {string is alpha, true} {
+ run {string is alpha abc}
} 1
-test string-6.16 {string is alpha, false} {
- list [string is alpha -fail var a1bcde] $var
+test string-6.16.$noComp {string is alpha, false} {
+ list [run {string is alpha -fail var a1bcde}] $var
} {0 1}
-test string-6.17 {string is alpha, unicode} {
- string is alpha abc\374
+test string-6.17.$noComp {string is alpha, unicode} {
+ run {string is alpha abc\374}
} 1
-test string-6.18 {string is ascii, true} {
- string is ascii abc\u007Fend\u0000
+test string-6.18.$noComp {string is ascii, true} {
+ run {string is ascii abc\u007Fend\u0000}
} 1
-test string-6.19 {string is ascii, false} {
- list [string is ascii -fail var abc\u0000def\u0080more] $var
+test string-6.19.$noComp {string is ascii, false} {
+ list [run {string is ascii -fail var abc\u0000def\u0080more}] $var
} {0 7}
-test string-6.20 {string is boolean, true} {
- string is boolean true
+test string-6.20.$noComp {string is boolean, true} {
+ run {string is boolean true}
} 1
-test string-6.21 {string is boolean, true} {
- string is boolean f
+test string-6.21.$noComp {string is boolean, true} {
+ run {string is boolean f}
} 1
-test string-6.22 {string is boolean, true based on type} {
- string is bool [string compare a a]
+test string-6.22.$noComp {string is boolean, true based on type} {
+ run {string is bool [run {string compare a a}]}
} 1
-test string-6.23 {string is boolean, false} {
- list [string is bool -fail var yada] $var
+test string-6.23.$noComp {string is boolean, false} {
+ list [run {string is bool -fail var yada}] $var
} {0 0}
-test string-6.24 {string is digit, true} {
- string is digit 0123456789
+test string-6.24.$noComp {string is digit, true} {
+ run {string is digit 0123456789}
} 1
-test string-6.25 {string is digit, false} {
- list [string is digit -fail var 0123\u00dc567] $var
+test string-6.25.$noComp {string is digit, false} {
+ list [run {string is digit -fail var 0123\u00dc567}] $var
} {0 4}
-test string-6.26 {string is digit, false} {
- list [string is digit -fail var +123567] $var
+test string-6.26.$noComp {string is digit, false} {
+ list [run {string is digit -fail var +123567}] $var
} {0 0}
-test string-6.27 {string is double, true} {
- string is double 1
+test string-6.27.$noComp {string is double, true} {
+ run {string is double 1}
} 1
-test string-6.28 {string is double, true} {
- string is double [expr double(1)]
+test string-6.28.$noComp {string is double, true} {
+ run {string is double [expr double(1)]}
} 1
-test string-6.29 {string is double, true} {
- string is double 1.0
+test string-6.29.$noComp {string is double, true} {
+ run {string is double 1.0}
} 1
-test string-6.30 {string is double, true} {
- string is double [string compare a a]
+test string-6.30.$noComp {string is double, true} {
+ run {string is double [run {string compare a a}]}
} 1
-test string-6.31 {string is double, true} {
- string is double " +1.0e-1 "
+test string-6.31.$noComp {string is double, true} {
+ run {string is double " +1.0e-1 "}
} 1
-test string-6.32 {string is double, true} {
- string is double "\n1.0\v"
+test string-6.32.$noComp {string is double, true} {
+ run {string is double "\n1.0\v"}
} 1
-test string-6.33 {string is double, false} {
- list [string is double -fail var 1abc] $var
+test string-6.33.$noComp {string is double, false} {
+ list [run {string is double -fail var 1abc}] $var
} {0 1}
-test string-6.34 {string is double, false} {
- list [string is double -fail var abc] $var
+test string-6.34.$noComp {string is double, false} {
+ list [run {string is double -fail var abc}] $var
} {0 0}
-test string-6.35 {string is double, false} {
- list [string is double -fail var " 1.0e4e4 "] $var
+test string-6.35.$noComp {string is double, false} {
+ list [run {string is double -fail var " 1.0e4e4 "}] $var
} {0 8}
-test string-6.36 {string is double, false} {
- list [string is double -fail var "\n"] $var
+test string-6.36.$noComp {string is double, false} {
+ list [run {string is double -fail var "\n"}] $var
} {0 0}
-test string-6.37 {string is double, false on int overflow} -setup {
+test string-6.37.$noComp {string is double, false on int overflow} -setup {
set var priorValue
} -body {
# Make it the largest int recognizable, with one more digit for overflow
# Since bignums arrived in Tcl 8.5, the sense of this test changed.
# Now integer values that exceed native limits become bignums, and
# bignums can convert to doubles without error.
- list [string is double -fail var [largest_int]0] $var
+ list [run {string is double -fail var [largest_int]0}] $var
} -result {1 priorValue}
# string-6.38 removed, underflow on input is no longer an error.
-test string-6.39 {string is double, false} {
+test string-6.39.$noComp {string is double, false} {
# This test is non-portable because IRIX thinks
# that .e1 is a valid double - this is really a bug
# on IRIX as .e1 should NOT be a valid double
#
# Portable now. Tcl 8.5 does its own double parsing.
- list [string is double -fail var .e1] $var
+ list [run {string is double -fail var .e1}] $var
} {0 0}
-test string-6.40 {string is false, true} {
- string is false false
+test string-6.40.$noComp {string is false, true} {
+ run {string is false false}
} 1
-test string-6.41 {string is false, true} {
- string is false FaLsE
+test string-6.41.$noComp {string is false, true} {
+ run {string is false FaLsE}
} 1
-test string-6.42 {string is false, true} {
- string is false N
+test string-6.42.$noComp {string is false, true} {
+ run {string is false N}
} 1
-test string-6.43 {string is false, true} {
- string is false 0
+test string-6.43.$noComp {string is false, true} {
+ run {string is false 0}
} 1
-test string-6.44 {string is false, true} {
- string is false off
+test string-6.44.$noComp {string is false, true} {
+ run {string is false off}
} 1
-test string-6.45 {string is false, false} {
- list [string is false -fail var abc] $var
+test string-6.45.$noComp {string is false, false} {
+ list [run {string is false -fail var abc}] $var
} {0 0}
-test string-6.46 {string is false, false} {
+test string-6.46.$noComp {string is false, false} {
catch {unset var}
- list [string is false -fail var Y] $var
+ list [run {string is false -fail var Y}] $var
} {0 0}
-test string-6.47 {string is false, false} {
+test string-6.47.$noComp {string is false, false} {
catch {unset var}
- list [string is false -fail var offensive] $var
+ list [run {string is false -fail var offensive}] $var
} {0 0}
-test string-6.48 {string is integer, true} {
- string is integer +1234567890
+test string-6.48.$noComp {string is integer, true} {
+ run {string is integer +1234567890}
} 1
-test string-6.49 {string is integer, true on type} {
- string is integer [expr int(50.0)]
+test string-6.49.$noComp {string is integer, true on type} {
+ run {string is integer [expr int(50.0)]}
} 1
-test string-6.50 {string is integer, true} {
- string is integer [list -10]
+test string-6.50.$noComp {string is integer, true} {
+ run {string is integer [list -10]}
} 1
-test string-6.51 {string is integer, true as hex} {
- string is integer 0xabcdef
+test string-6.51.$noComp {string is integer, true as hex} {
+ run {string is integer 0xabcdef}
} 1
-test string-6.52 {string is integer, true as octal} {
- string is integer 012345
+test string-6.52.$noComp {string is integer, true as octal} {
+ run {string is integer 012345}
} 1
-test string-6.53 {string is integer, true with whitespace} {
- string is integer " \n1234\v"
+test string-6.53.$noComp {string is integer, true with whitespace} {
+ run {string is integer " \n1234\v"}
} 1
-test string-6.54 {string is integer, false} {
- list [string is integer -fail var 123abc] $var
+test string-6.54.$noComp {string is integer, false} {
+ list [run {string is integer -fail var 123abc}] $var
} {0 3}
-test string-6.55 {string is integer, false on overflow} {
- list [string is integer -fail var +[largest_int]0] $var
-} {0 -1}
-test string-6.56 {string is integer, false} {
- list [string is integer -fail var [expr double(1)]] $var
+test string-6.55.$noComp {string is integer, no overflow possible} {
+ run {string is integer +[largest_int]0}
+} 1
+test string-6.56.$noComp {string is integer, false} {
+ list [run {string is integer -fail var [expr double(1)]}] $var
} {0 1}
-test string-6.57 {string is integer, false} {
- list [string is integer -fail var " "] $var
+test string-6.57.$noComp {string is integer, false} {
+ list [run {string is integer -fail var " "}] $var
} {0 0}
-test string-6.58 {string is integer, false on bad octal} {
- list [string is integer -fail var 0o36963] $var
+test string-6.58.$noComp {string is integer, false on bad octal} {
+ list [run {string is integer -fail var 0o36963}] $var
} {0 4}
-test string-6.58.1 {string is integer, false on bad octal} {
- list [string is integer -fail var 0o36963] $var
+test string-6.58.1.$noComp {string is integer, false on bad octal} {
+ list [run {string is integer -fail var 0o36963}] $var
} {0 4}
-test string-6.59 {string is integer, false on bad hex} {
- list [string is integer -fail var 0X345XYZ] $var
+test string-6.59.$noComp {string is integer, false on bad hex} {
+ list [run {string is integer -fail var 0X345XYZ}] $var
} {0 5}
-test string-6.60 {string is lower, true} {
- string is lower abc
+test string-6.60.$noComp {string is lower, true} {
+ run {string is lower abc}
} 1
-test string-6.61 {string is lower, unicode true} {
- string is lower abc\u00fcue
+test string-6.61.$noComp {string is lower, unicode true} {
+ run {string is lower abc\u00fcue}
} 1
-test string-6.62 {string is lower, false} {
- list [string is lower -fail var aBc] $var
+test string-6.62.$noComp {string is lower, false} {
+ list [run {string is lower -fail var aBc}] $var
} {0 1}
-test string-6.63 {string is lower, false} {
- list [string is lower -fail var abc1] $var
+test string-6.63.$noComp {string is lower, false} {
+ list [run {string is lower -fail var abc1}] $var
} {0 3}
-test string-6.64 {string is lower, unicode false} {
- list [string is lower -fail var ab\u00dcUE] $var
+test string-6.64.$noComp {string is lower, unicode false} {
+ list [run {string is lower -fail var ab\u00dcUE}] $var
} {0 2}
-test string-6.65 {string is space, true} {
- string is space " \t\n\v\f"
+test string-6.65.$noComp {string is space, true} {
+ run {string is space " \t\n\v\f"}
} 1
-test string-6.66 {string is space, false} {
- list [string is space -fail var " \t\n\v1\f"] $var
+test string-6.66.$noComp {string is space, false} {
+ list [run {string is space -fail var " \t\n\v1\f"}] $var
} {0 4}
-test string-6.67 {string is true, true} {
- string is true true
+test string-6.67.$noComp {string is true, true} {
+ run {string is true true}
} 1
-test string-6.68 {string is true, true} {
- string is true TrU
+test string-6.68.$noComp {string is true, true} {
+ run {string is true TrU}
} 1
-test string-6.69 {string is true, true} {
- string is true ye
+test string-6.69.$noComp {string is true, true} {
+ run {string is true ye}
} 1
-test string-6.70 {string is true, true} {
- string is true 1
+test string-6.70.$noComp {string is true, true} {
+ run {string is true 1}
} 1
-test string-6.71 {string is true, true} {
- string is true on
+test string-6.71.$noComp {string is true, true} {
+ run {string is true on}
} 1
-test string-6.72 {string is true, false} {
- list [string is true -fail var onto] $var
+test string-6.72.$noComp {string is true, false} {
+ list [run {string is true -fail var onto}] $var
} {0 0}
-test string-6.73 {string is true, false} {
+test string-6.73.$noComp {string is true, false} {
catch {unset var}
- list [string is true -fail var 25] $var
+ list [run {string is true -fail var 25}] $var
} {0 0}
-test string-6.74 {string is true, false} {
+test string-6.74.$noComp {string is true, false} {
catch {unset var}
- list [string is true -fail var no] $var
+ list [run {string is true -fail var no}] $var
} {0 0}
-test string-6.75 {string is upper, true} {
- string is upper ABC
+test string-6.75.$noComp {string is upper, true} {
+ run {string is upper ABC}
} 1
-test string-6.76 {string is upper, unicode true} {
- string is upper ABC\u00dcUE
+test string-6.76.$noComp {string is upper, unicode true} {
+ run {string is upper ABC\u00dcUE}
} 1
-test string-6.77 {string is upper, false} {
- list [string is upper -fail var AbC] $var
+test string-6.77.$noComp {string is upper, false} {
+ list [run {string is upper -fail var AbC}] $var
} {0 1}
-test string-6.78 {string is upper, false} {
- list [string is upper -fail var AB2C] $var
+test string-6.78.$noComp {string is upper, false} {
+ list [run {string is upper -fail var AB2C}] $var
} {0 2}
-test string-6.79 {string is upper, unicode false} {
- list [string is upper -fail var ABC\u00fcue] $var
+test string-6.79.$noComp {string is upper, unicode false} {
+ list [run {string is upper -fail var ABC\u00fcue}] $var
} {0 3}
-test string-6.80 {string is wordchar, true} {
- string is wordchar abc_123
+test string-6.80.$noComp {string is wordchar, true} {
+ run {string is wordchar abc_123}
} 1
-test string-6.81 {string is wordchar, unicode true} {
- string is wordchar abc\u00fcab\u00dcAB\u5001
+test string-6.81.$noComp {string is wordchar, unicode true} {
+ run {string is wordchar abc\u00fcab\u00dcAB\u5001}
} 1
-test string-6.82 {string is wordchar, false} {
- list [string is wordchar -fail var abcd.ef] $var
+test string-6.82.$noComp {string is wordchar, false} {
+ list [run {string is wordchar -fail var abcd.ef}] $var
} {0 4}
-test string-6.83 {string is wordchar, unicode false} {
- list [string is wordchar -fail var abc\u0080def] $var
+test string-6.83.$noComp {string is wordchar, unicode false} {
+ list [run {string is wordchar -fail var abc\u0080def}] $var
} {0 3}
-test string-6.84 {string is control} {
+test string-6.84.$noComp {string is control} {
## Control chars are in the ranges
## 00..1F && 7F..9F
- list [string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60] $var
+ list [run {string is control -fail var \x00\x01\x10\x1F\x7F\x80\x9F\x60}] $var
} {0 7}
-test string-6.85 {string is control} {
- string is control \u0100
+test string-6.85.$noComp {string is control} {
+ run {string is control \u0100}
} 0
-test string-6.86 {string is graph} {
+test string-6.86.$noComp {string is graph} {
## graph is any print char, except space
- list [string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "] $var
+ list [run {string is gra -fail var "0123abc!@#\$\u0100\UE0100\UE01EF "}] $var
} {0 14}
-test string-6.87 {string is print} {
+test string-6.87.$noComp {string is print} {
## basically any printable char
- list [string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"] $var
+ list [run {string is print -fail var "0123abc!@#\$\u0100 \UE0100\UE01EF\u0010"}] $var
} {0 15}
-test string-6.88 {string is punct} {
+test string-6.88.$noComp {string is punct} {
## any graph char that isn't alnum
- list [string is punct -fail var "_!@#\u00beq0"] $var
+ list [run {string is punct -fail var "_!@#\u00beq0"}] $var
} {0 4}
-test string-6.89 {string is xdigit} {
- list [string is xdigit -fail var 0123456789\u0061bcdefABCDEFg] $var
+test string-6.89.$noComp {string is xdigit} {
+ list [run {string is xdigit -fail var 0123456789\u0061bcdefABCDEFg}] $var
} {0 22}
-test string-6.90 {string is integer, bad integers} {
+test string-6.90.$noComp {string is integer, bad integers} {
# SF bug #634856
set result ""
set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
foreach num $numbers {
- lappend result [string is int -strict $num]
+ lappend result [run {string is int -strict $num}]
}
return $result
} {1 1 0 0 0 1 0 0}
-test string-6.91 {string is double, bad doubles} {
+test string-6.91.$noComp {string is double, bad doubles} {
set result ""
set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
foreach num $numbers {
- lappend result [string is double -strict $num]
+ lappend result [run {string is double -strict $num}]
}
return $result
} {1 1 0 0 0 1 0 0}
-test string-6.92 {string is integer, 32-bit overflow} {
+test string-6.92.$noComp {string is integer, no 64-bit overflow} {
# Bug 718878
- set x 0x100000000
- list [string is integer -failindex var $x] $var
-} {0 -1}
-test string-6.93 {string is integer, 32-bit overflow} {
+ set x 0x10000000000000000
+ run {string is integer $x}
+} 1
+test string-6.93.$noComp {string is integer, no 64-bit overflow} {
# Bug 718878
- set x 0x100000000
+ set x 0x10000000000000000
append x ""
- list [string is integer -failindex var $x] $var
-} {0 -1}
-test string-6.94 {string is integer, 32-bit overflow} {
+ run {string is integer $x}
+} 1
+test string-6.94.$noComp {string is integer, no 64-bit overflow} {
# Bug 718878
- set x 0x100000000
- list [string is integer -failindex var [expr {$x}]] $var
-} {0 -1}
-test string-6.95 {string is wideinteger, true} {
- string is wideinteger +1234567890
+ set x 0x10000000000000000
+ run {string is integer [expr {$x}]}
+} 1
+test string-6.95.$noComp {string is wideinteger, true} {
+ run {string is wideinteger +1234567890}
} 1
-test string-6.96 {string is wideinteger, true on type} {
- string is wideinteger [expr wide(50.0)]
+test string-6.96.$noComp {string is wideinteger, true on type} {
+ run {string is wideinteger [expr wide(50.0)]}
} 1
-test string-6.97 {string is wideinteger, true} {
- string is wideinteger [list -10]
+test string-6.97.$noComp {string is wideinteger, true} {
+ run {string is wideinteger [list -10]}
} 1
-test string-6.98 {string is wideinteger, true as hex} {
- string is wideinteger 0xabcdef
+test string-6.98.$noComp {string is wideinteger, true as hex} {
+ run {string is wideinteger 0xabcdef}
} 1
-test string-6.99 {string is wideinteger, true as octal} {
- string is wideinteger 0123456
+test string-6.99.$noComp {string is wideinteger, true as octal} {
+ run {string is wideinteger 0123456}
} 1
-test string-6.100 {string is wideinteger, true with whitespace} {
- string is wideinteger " \n1234\v"
+test string-6.100.$noComp {string is wideinteger, true with whitespace} {
+ run {string is wideinteger " \n1234\v"}
} 1
-test string-6.101 {string is wideinteger, false} {
- list [string is wideinteger -fail var 123abc] $var
+test string-6.101.$noComp {string is wideinteger, false} {
+ list [run {string is wideinteger -fail var 123abc}] $var
} {0 3}
-test string-6.102 {string is wideinteger, false on overflow} {
- list [string is wideinteger -fail var +[largest_int]0] $var
+test string-6.102.$noComp {string is wideinteger, false on overflow} {
+ list [run {string is wideinteger -fail var +[largest_int]0}] $var
} {0 -1}
-test string-6.103 {string is wideinteger, false} {
- list [string is wideinteger -fail var [expr double(1)]] $var
+test string-6.103.$noComp {string is wideinteger, false} {
+ list [run {string is wideinteger -fail var [expr double(1)]}] $var
} {0 1}
-test string-6.104 {string is wideinteger, false} {
- list [string is wideinteger -fail var " "] $var
+test string-6.104.$noComp {string is wideinteger, false} {
+ list [run {string is wideinteger -fail var " "}] $var
} {0 0}
-test string-6.105 {string is wideinteger, false on bad octal} {
- list [string is wideinteger -fail var 0o36963] $var
+test string-6.105.$noComp {string is wideinteger, false on bad octal} {
+ list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
-test string-6.105.1 {string is wideinteger, false on bad octal} {
- list [string is wideinteger -fail var 0o36963] $var
+test string-6.105.1.$noComp {string is wideinteger, false on bad octal} {
+ list [run {string is wideinteger -fail var 0o36963}] $var
} {0 4}
-test string-6.106 {string is wideinteger, false on bad hex} {
- list [string is wideinteger -fail var 0X345XYZ] $var
+test string-6.106.$noComp {string is wideinteger, false on bad hex} {
+ list [run {string is wideinteger -fail var 0X345XYZ}] $var
} {0 5}
-test string-6.107 {string is integer, bad integers} {
+test string-6.107.$noComp {string is integer, bad integers} {
# SF bug #634856
set result ""
set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
foreach num $numbers {
- lappend result [string is wideinteger -strict $num]
+ lappend result [run {string is wideinteger -strict $num}]
}
return $result
} {1 1 0 0 0 1 0 0}
-test string-6.108 {string is double, Bug 1382287} {
+test string-6.108.$noComp {string is double, Bug 1382287} {
set x 2turtledoves
- string is double $x
- string is double $x
+ run {string is double $x}
+ run {string is double $x}
} 0
-test string-6.109 {string is double, Bug 1360532} {
- string is double 1\u00a0
+test string-6.109.$noComp {string is double, Bug 1360532} {
+ run {string is double 1\u00a0}
} 0
-test string-6.110 {string is entier, true} {
- string is entier +1234567890
+test string-6.110.$noComp {string is entier, true} {
+ run {string is entier +1234567890}
} 1
-test string-6.111 {string is entier, true on type} {
- string is entier [expr wide(50.0)]
+test string-6.111.$noComp {string is entier, true on type} {
+ run {string is entier [expr wide(50.0)]}
} 1
-test string-6.112 {string is entier, true} {
- string is entier [list -10]
+test string-6.112.$noComp {string is entier, true} {
+ run {string is entier [list -10]}
} 1
-test string-6.113 {string is entier, true as hex} {
- string is entier 0xabcdef
+test string-6.113.$noComp {string is entier, true as hex} {
+ run {string is entier 0xabcdef}
} 1
-test string-6.114 {string is entier, true as octal} {
- string is entier 0123456
+test string-6.114.$noComp {string is entier, true as octal} {
+ run {string is entier 0123456}
} 1
-test string-6.115 {string is entier, true with whitespace} {
- string is entier " \n1234\v"
+test string-6.115.$noComp {string is entier, true with whitespace} {
+ run {string is entier " \n1234\v"}
} 1
-test string-6.116 {string is entier, false} {
- list [string is entier -fail var 123abc] $var
+test string-6.116.$noComp {string is entier, false} {
+ list [run {string is entier -fail var 123abc}] $var
} {0 3}
-test string-6.117 {string is entier, false} {
- list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var
+test string-6.117.$noComp {string is entier, false} {
+ list [run {string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc}] $var
} {0 84}
-test string-6.118 {string is entier, false} {
- list [string is entier -fail var [expr double(1)]] $var
+test string-6.118.$noComp {string is entier, false} {
+ list [run {string is entier -fail var [expr double(1)]}] $var
} {0 1}
-test string-6.119 {string is entier, false} {
- list [string is entier -fail var " "] $var
+test string-6.119.$noComp {string is entier, false} {
+ list [run {string is entier -fail var " "}] $var
} {0 0}
-test string-6.120 {string is entier, false on bad octal} {
- list [string is entier -fail var 0o36963] $var
+test string-6.120.$noComp {string is entier, false on bad octal} {
+ list [run {string is entier -fail var 0o36963}] $var
} {0 4}
-test string-6.121.1 {string is entier, false on bad octal} {
- list [string is entier -fail var 0o36963] $var
+test string-6.121.1.$noComp {string is entier, false on bad octal} {
+ list [run {string is entier -fail var 0o36963}] $var
} {0 4}
-test string-6.122 {string is entier, false on bad hex} {
- list [string is entier -fail var 0X345XYZ] $var
+test string-6.122.$noComp {string is entier, false on bad hex} {
+ list [run {string is entier -fail var 0X345XYZ}] $var
} {0 5}
-test string-6.123 {string is entier, bad integers} {
+test string-6.123.$noComp {string is entier, bad integers} {
# SF bug #634856
set result ""
set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
foreach num $numbers {
- lappend result [string is entier -strict $num]
+ lappend result [run {string is entier -strict $num}]
}
return $result
} {1 1 0 0 0 1 0 0}
-test string-6.124 {string is entier, true} {
- string is entier +1234567890123456789012345678901234567890
+test string-6.124.$noComp {string is entier, true} {
+ run {string is entier +1234567890123456789012345678901234567890}
} 1
-test string-6.125 {string is entier, true} {
- string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]
+test string-6.125.$noComp {string is entier, true} {
+ run {string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]}
} 1
-test string-6.126 {string is entier, true as hex} {
- string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef
+test string-6.126.$noComp {string is entier, true as hex} {
+ run {string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef}
} 1
-test string-6.127 {string is entier, true as octal} {
- string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456
+test string-6.127.$noComp {string is entier, true as octal} {
+ run {string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456}
} 1
-test string-6.128 {string is entier, true with whitespace} {
- string is entier " \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"
+test string-6.128.$noComp {string is entier, true with whitespace} {
+ run {string is entier " \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"}
} 1
-test string-6.129 {string is entier, false on bad octal} {
- list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
+test string-6.129.$noComp {string is entier, false on bad octal} {
+ list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
-test string-6.130.1 {string is entier, false on bad octal} {
- list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
+test string-6.130.1.$noComp {string is entier, false on bad octal} {
+ list [run {string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963}] $var
} {0 87}
-test string-6.131 {string is entier, false on bad hex} {
- list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
+test string-6.131.$noComp {string is entier, false on bad hex} {
+ list [run {string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ}] $var
} {0 88}
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 needleString haystackString ?startIndex?"}}
-test string-7.2 {string last, bad args} {
- list [catch {string last a b c} msg] $msg
+test string-7.1.$noComp {string last, too few args} {
+ list [catch {run {string last a}} msg] $msg
+} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
+test string-7.2.$noComp {string last, bad args} {
+ list [catch {run {string last a b c}} msg] $msg
} {1 {bad index "c": must be integer?[+-]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 needleString haystackString ?startIndex?"}}
-test string-7.4 {string last} {
- string la xxx xxxx123xx345x678
-} 1
-test string-7.5 {string last} {
- string last xx xxxx123xx345x678
+test string-7.3.$noComp {string last, too many args} {
+ list [catch {run {string last a b c d}} msg] $msg
+} {1 {wrong # args: should be "string last needleString haystackString ?lastIndex?"}}
+test string-7.4.$noComp {string last} {
+ run {string la xxx xxxx123xx345x678}
+} 1
+test string-7.5.$noComp {string last} {
+ run {string last xx xxxx123xx345x678}
} 7
-test string-7.6 {string last} {
- string las x xxxx123xx345x678
+test string-7.6.$noComp {string last} {
+ run {string las x xxxx123xx345x678}
} 12
-test string-7.7 {string last, unicode} {
- string las x xxxx12\u7266xx345x678
+test string-7.7.$noComp {string last, unicode} {
+ run {string las x xxxx12\u7266xx345x678}
} 12
-test string-7.8 {string last, unicode} {
- string las \u7266 xxxx12\u7266xx345x678
+test string-7.8.$noComp {string last, unicode} {
+ run {string las \u7266 xxxx12\u7266xx345x678}
} 6
-test string-7.9 {string last, stop index} {
- string las \u7266 xxxx12\u7266xx345x678
+test string-7.9.$noComp {string last, stop index} {
+ run {string las \u7266 xxxx12\u7266xx345x678}
} 6
-test string-7.10 {string last, unicode} {
- string las \u7266 xxxx12\u7266xx345x678
+test string-7.10.$noComp {string last, unicode} {
+ run {string las \u7266 xxxx12\u7266xx345x678}
} 6
-test string-7.11 {string last, start index} {
- string last \u7266 abc\u7266x 3
+test string-7.11.$noComp {string last, start index} {
+ run {string last \u7266 abc\u7266x 3}
} 3
-test string-7.12 {string last, start index} {
- string last \u7266 abc\u7266x 2
+test string-7.12.$noComp {string last, start index} {
+ run {string last \u7266 abc\u7266x 2}
} -1
-test string-7.13 {string last, start index} {
+test string-7.13.$noComp {string last, start index} {
## Constrain to last 'a' should work
- string last ba badbad end-1
+ run {string last ba badbad end-1}
} 3
-test string-7.14 {string last, start index} {
+test string-7.14.$noComp {string last, start index} {
## Constrain to last 'b' should skip last 'ba'
- string last ba badbad end-2
+ run {string last ba badbad end-2}
} 0
-test string-7.15 {string last, start index} {
- string last \334a \334ad\334ad 0
+test string-7.15.$noComp {string last, start index} {
+ run {string last \334a \334ad\334ad 0}
} -1
-test string-7.16 {string last, start index} {
- string last \334a \334ad\334ad end-1
+test string-7.16.$noComp {string last, start index} {
+ run {string last \334a \334ad\334ad end-1}
} 3
-test string-8.1 {string bytelength} {
- list [catch {string bytelength} msg] $msg
+test string-8.1.$noComp {string bytelength} {
+ list [catch {run {string bytelength}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
-test string-8.2 {string bytelength} {
- list [catch {string bytelength a b} msg] $msg
+test string-8.2.$noComp {string bytelength} {
+ list [catch {run {string bytelength a b}} msg] $msg
} {1 {wrong # args: should be "string bytelength string"}}
-test string-8.3 {string bytelength} {
- string bytelength "\u00c7"
+test string-8.3.$noComp {string bytelength} {
+ run {string bytelength "\u00c7"}
} 2
-test string-8.4 {string bytelength} {
- string b ""
+test string-8.4.$noComp {string bytelength} {
+ run {string b ""}
} 0
-test string-9.1 {string length} {
- list [catch {string length} msg] $msg
+test string-9.1.$noComp {string length} {
+ list [catch {run {string length}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
-test string-9.2 {string length} {
- list [catch {string length a b} msg] $msg
+test string-9.2.$noComp {string length} {
+ list [catch {run {string length a b}} msg] $msg
} {1 {wrong # args: should be "string length string"}}
-test string-9.3 {string length} {
- string length "a little string"
+test string-9.3.$noComp {string length} {
+ run {string length "a little string"}
} 15
-test string-9.4 {string length} {
- string le ""
+test string-9.4.$noComp {string length} {
+ run {string le ""}
} 0
-test string-9.5 {string length, unicode} {
- string le "abcd\u7266"
+test string-9.5.$noComp {string length, unicode} {
+ run {string le "abcd\u7266"}
} 5
-test string-9.6 {string length, bytearray object} {
- string length [binary format a5 foo]
+test string-9.6.$noComp {string length, bytearray object} {
+ run {string length [binary format a5 foo]}
} 5
-test string-9.7 {string length, bytearray object} {
- string length [binary format I* {0x50515253 0x52}]
+test string-9.7.$noComp {string length, bytearray object} {
+ run {string length [binary format I* {0x50515253 0x52}]}
} 8
-test string-10.1 {string map, too few args} {
- list [catch {string map} msg] $msg
+test string-10.1.$noComp {string map, too few args} {
+ list [catch {run {string map}} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
-test string-10.2 {string map, bad args} {
- list [catch {string map {a b} abba oops} msg] $msg
+test string-10.2.$noComp {string map, bad args} {
+ list [catch {run {string map {a b} abba oops}} msg] $msg
} {1 {bad option "a b": must be -nocase}}
-test string-10.3 {string map, too many args} {
- list [catch {string map -nocase {a b} str1 str2} msg] $msg
+test string-10.3.$noComp {string map, too many args} {
+ list [catch {run {string map -nocase {a b} str1 str2}} msg] $msg
} {1 {wrong # args: should be "string map ?-nocase? charMap string"}}
-test string-10.4 {string map} {
- string map {a b} abba
+test string-10.4.$noComp {string map} {
+ run {string map {a b} abba}
} {bbbb}
-test string-10.5 {string map} {
- string map {a b} a
+test string-10.5.$noComp {string map} {
+ run {string map {a b} a}
} {b}
-test string-10.6 {string map -nocase} {
- string map -nocase {a b} Abba
+test string-10.6.$noComp {string map -nocase} {
+ run {string map -nocase {a b} Abba}
} {bbbb}
-test string-10.7 {string map} {
- string map {abc 321 ab * a A} aabcabaababcab
+test string-10.7.$noComp {string map} {
+ run {string map {abc 321 ab * a A} aabcabaababcab}
} {A321*A*321*}
-test string-10.8 {string map -nocase} {
- string map -nocase {aBc 321 Ab * a A} aabcabaababcab
+test string-10.8.$noComp {string map -nocase} {
+ run {string map -nocase {aBc 321 Ab * a A} aabcabaababcab}
} {A321*A*321*}
-test string-10.9 {string map -nocase} {
- string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb
+test string-10.9.$noComp {string map -nocase} {
+ run {string map -no {abc 321 Ab * a A} aAbCaBaAbAbcAb}
} {A321*A*321*}
-test string-10.10 {string map} {
- list [catch {string map {a b c} abba} msg] $msg
+test string-10.10.$noComp {string map} {
+ list [catch {run {string map {a b c} abba}} msg] $msg
} {1 {char map list unbalanced}}
-test string-10.11 {string map, nulls} {
- string map {\x00 NULL blah \x00nix} {qwerty}
+test string-10.11.$noComp {string map, nulls} {
+ run {string map {\x00 NULL blah \x00nix} {qwerty}}
} {qwerty}
-test string-10.12 {string map, unicode} {
- string map [list \374 ue UE \334] "a\374ueUE\000EU"
+test string-10.12.$noComp {string map, unicode} {
+ run {string map [list \374 ue UE \334] "a\374ueUE\000EU"}
} aueue\334\0EU
-test string-10.13 {string map, -nocase unicode} {
- string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"
+test string-10.13.$noComp {string map, -nocase unicode} {
+ run {string map -nocase [list \374 ue UE \334] "a\374ueUE\000EU"}
} aue\334\334\0EU
-test string-10.14 {string map, -nocase null arguments} {
- string map -nocase {{} abc} foo
+test string-10.14.$noComp {string map, -nocase null arguments} {
+ run {string map -nocase {{} abc} foo}
} foo
-test string-10.15 {string map, one pair case} {
- string map -nocase {abc 32} aAbCaBaAbAbcAb
+test string-10.15.$noComp {string map, one pair case} {
+ run {string map -nocase {abc 32} aAbCaBaAbAbcAb}
} {a32aBaAb32Ab}
-test string-10.16 {string map, one pair case} {
- string map -nocase {ab 4321} aAbCaBaAbAbcAb
+test string-10.16.$noComp {string map, one pair case} {
+ run {string map -nocase {ab 4321} aAbCaBaAbAbcAb}
} {a4321C4321a43214321c4321}
-test string-10.17 {string map, one pair case} {
- string map {Ab 4321} aAbCaBaAbAbcAb
+test string-10.17.$noComp {string map, one pair case} {
+ run {string map {Ab 4321} aAbCaBaAbAbcAb}
} {a4321CaBa43214321c4321}
-test string-10.18 {string map, empty argument} {
- string map -nocase {{} abc} foo
+test string-10.18.$noComp {string map, empty argument} {
+ run {string map -nocase {{} abc} foo}
} foo
-test string-10.19 {string map, empty arguments} {
- string map -nocase {{} abc f bar {} def} foo
+test string-10.19.$noComp {string map, empty arguments} {
+ run {string map -nocase {{} abc f bar {} def} foo}
} baroo
-test string-10.20 {string map, dictionaries don't alter map ordering} {
+test string-10.20.$noComp {string map, dictionaries don't alter map ordering} {
set map {aa X a Y}
- list [string map [dict create aa X a Y] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
+ list [run {string map [dict create aa X a Y] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}]
} {XY XY 2 XY}
-test string-10.20.1 {string map, dictionaries don't alter map ordering} {
+test string-10.20.1.$noComp {string map, dictionaries don't alter map ordering} {
set map {a X b Y a Z}
- list [string map [dict create a X b Y a Z] aaa] [string map $map aaa] [dict size $map] [string map $map aaa]
+ list [run {string map [dict create a X b Y a Z] aaa}] [run {string map $map aaa}] [dict size $map] [run {string map $map aaa}]
} {ZZZ XXX 2 XXX}
-test string-10.21 {string map, ABR checks} {
- string map {longstring foob} long
+test string-10.21.$noComp {string map, ABR checks} {
+ run {string map {longstring foob} long}
} long
-test string-10.22 {string map, ABR checks} {
- string map {long foob} long
+test string-10.22.$noComp {string map, ABR checks} {
+ run {string map {long foob} long}
} foob
-test string-10.23 {string map, ABR checks} {
- string map {lon foob} long
+test string-10.23.$noComp {string map, ABR checks} {
+ run {string map {lon foob} long}
} foobg
-test string-10.24 {string map, ABR checks} {
- string map {lon foob} longlo
+test string-10.24.$noComp {string map, ABR checks} {
+ run {string map {lon foob} longlo}
} foobglo
-test string-10.25 {string map, ABR checks} {
- string map {lon foob} longlon
+test string-10.25.$noComp {string map, ABR checks} {
+ run {string map {lon foob} longlon}
} foobgfoob
-test string-10.26 {string map, ABR checks} {
- string map {longstring foob longstring bar} long
+test string-10.26.$noComp {string map, ABR checks} {
+ run {string map {longstring foob longstring bar} long}
} long
-test string-10.27 {string map, ABR checks} {
- string map {long foob longstring bar} long
+test string-10.27.$noComp {string map, ABR checks} {
+ run {string map {long foob longstring bar} long}
} foob
-test string-10.28 {string map, ABR checks} {
- string map {lon foob longstring bar} long
+test string-10.28.$noComp {string map, ABR checks} {
+ run {string map {lon foob longstring bar} long}
} foobg
-test string-10.29 {string map, ABR checks} {
- string map {lon foob longstring bar} longlo
+test string-10.29.$noComp {string map, ABR checks} {
+ run {string map {lon foob longstring bar} longlo}
} foobglo
-test string-10.30 {string map, ABR checks} {
- string map {lon foob longstring bar} longlon
+test string-10.30.$noComp {string map, ABR checks} {
+ run {string map {lon foob longstring bar} longlon}
} foobgfoob
-test string-10.31 {string map, nasty sharing crash from [Bug 1018562]} {
+test string-10.31.$noComp {string map, nasty sharing crash from [Bug 1018562]} {
set a {a b}
- string map $a $a
+ run {string map $a $a}
} {b b}
-test string-11.1 {string match, too few args} {
- list [catch {string match a} msg] $msg
+test string-11.1.$noComp {string match, too few args} {
+ list [catch {run {string match a}} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
-test string-11.2 {string match, too many args} {
- list [catch {string match a b c d} msg] $msg
+test string-11.2.$noComp {string match, too many args} {
+ list [catch {run {string match a b c d}} msg] $msg
} {1 {wrong # args: should be "string match ?-nocase? pattern string"}}
-test string-11.3 {string match} {
- string match abc abc
+test string-11.3.$noComp {string match} {
+ run {string match abc abc}
} 1
-test string-11.4 {string match} {
- string mat abc abd
+test string-11.4.$noComp {string match} {
+ run {string mat abc abd}
} 0
-test string-11.5 {string match} {
- string match ab*c abc
+test string-11.5.$noComp {string match} {
+ run {string match ab*c abc}
} 1
-test string-11.6 {string match} {
- string match ab**c abc
+test string-11.6.$noComp {string match} {
+ run {string match ab**c abc}
} 1
-test string-11.7 {string match} {
- string match ab* abcdef
+test string-11.7.$noComp {string match} {
+ run {string match ab* abcdef}
} 1
-test string-11.8 {string match} {
- string match *c abc
+test string-11.8.$noComp {string match} {
+ run {string match *c abc}
} 1
-test string-11.9 {string match} {
- string match *3*6*9 0123456789
+test string-11.9.$noComp {string match} {
+ run {string match *3*6*9 0123456789}
} 1
-test string-11.9.1 {string match} {
- string match *3*6*89 0123456789
+test string-11.9.1.$noComp {string match} {
+ run {string match *3*6*89 0123456789}
} 1
-test string-11.9.2 {string match} {
- string match *3*456*89 0123456789
+test string-11.9.2.$noComp {string match} {
+ run {string match *3*456*89 0123456789}
} 1
-test string-11.9.3 {string match} {
- string match *3*6* 0123456789
+test string-11.9.3.$noComp {string match} {
+ run {string match *3*6* 0123456789}
} 1
-test string-11.9.4 {string match} {
- string match *3*56* 0123456789
+test string-11.9.4.$noComp {string match} {
+ run {string match *3*56* 0123456789}
} 1
-test string-11.9.5 {string match} {
- string match *3*456*** 0123456789
+test string-11.9.5.$noComp {string match} {
+ run {string match *3*456*** 0123456789}
} 1
-test string-11.9.6 {string match} {
- string match **3*456** 0123456789
+test string-11.9.6.$noComp {string match} {
+ run {string match **3*456** 0123456789}
} 1
-test string-11.9.7 {string match} {
- string match *3***456* 0123456789
+test string-11.9.7.$noComp {string match} {
+ run {string match *3***456* 0123456789}
} 1
-test string-11.9.8 {string match} {
- string match *3***\[456]* 0123456789
+test string-11.9.8.$noComp {string match} {
+ run {string match *3***\[456]* 0123456789}
} 1
-test string-11.9.9 {string match} {
- string match *3***\[4-6]* 0123456789
+test string-11.9.9.$noComp {string match} {
+ run {string match *3***\[4-6]* 0123456789}
} 1
-test string-11.9.10 {string match} {
- string match *3***\[4-6] 0123456789
+test string-11.9.10.$noComp {string match} {
+ run {string match *3***\[4-6] 0123456789}
} 0
-test string-11.9.11 {string match} {
- string match *3***\[4-6] 0123456
+test string-11.9.11.$noComp {string match} {
+ run {string match *3***\[4-6] 0123456}
} 1
-test string-11.10 {string match} {
- string match *3*6*9 01234567890
+test string-11.10.$noComp {string match} {
+ run {string match *3*6*9 01234567890}
} 0
-test string-11.10.1 {string match} {
- string match *3*6*89 01234567890
+test string-11.10.1.$noComp {string match} {
+ run {string match *3*6*89 01234567890}
} 0
-test string-11.10.2 {string match} {
- string match *3*456*89 01234567890
+test string-11.10.2.$noComp {string match} {
+ run {string match *3*456*89 01234567890}
} 0
-test string-11.10.3 {string match} {
- string match **3*456*89 01234567890
+test string-11.10.3.$noComp {string match} {
+ run {string match **3*456*89 01234567890}
} 0
-test string-11.10.4 {string match} {
- string match *3*456***89 01234567890
+test string-11.10.4.$noComp {string match} {
+ run {string match *3*456***89 01234567890}
} 0
-test string-11.11 {string match} {
- string match a?c abc
+test string-11.11.$noComp {string match} {
+ run {string match a?c abc}
} 1
-test string-11.12 {string match} {
- string match a??c abc
+test string-11.12.$noComp {string match} {
+ run {string match a??c abc}
} 0
-test string-11.13 {string match} {
- string match ?1??4???8? 0123456789
+test string-11.13.$noComp {string match} {
+ run {string match ?1??4???8? 0123456789}
} 1
-test string-11.14 {string match} {
- string match {[abc]bc} abc
+test string-11.14.$noComp {string match} {
+ run {string match {[abc]bc} abc}
} 1
-test string-11.15 {string match} {
- string match {a[abc]c} abc
+test string-11.15.$noComp {string match} {
+ run {string match {a[abc]c} abc}
} 1
-test string-11.16 {string match} {
- string match {a[xyz]c} abc
+test string-11.16.$noComp {string match} {
+ run {string match {a[xyz]c} abc}
} 0
-test string-11.17 {string match} {
- string match {12[2-7]45} 12345
+test string-11.17.$noComp {string match} {
+ run {string match {12[2-7]45} 12345}
} 1
-test string-11.18 {string match} {
- string match {12[ab2-4cd]45} 12345
+test string-11.18.$noComp {string match} {
+ run {string match {12[ab2-4cd]45} 12345}
} 1
-test string-11.19 {string match} {
- string match {12[ab2-4cd]45} 12b45
+test string-11.19.$noComp {string match} {
+ run {string match {12[ab2-4cd]45} 12b45}
} 1
-test string-11.20 {string match} {
- string match {12[ab2-4cd]45} 12d45
+test string-11.20.$noComp {string match} {
+ run {string match {12[ab2-4cd]45} 12d45}
} 1
-test string-11.21 {string match} {
- string match {12[ab2-4cd]45} 12145
+test string-11.21.$noComp {string match} {
+ run {string match {12[ab2-4cd]45} 12145}
} 0
-test string-11.22 {string match} {
- string match {12[ab2-4cd]45} 12545
+test string-11.22.$noComp {string match} {
+ run {string match {12[ab2-4cd]45} 12545}
} 0
-test string-11.23 {string match} {
- string match {a\*b} a*b
+test string-11.23.$noComp {string match} {
+ run {string match {a\*b} a*b}
} 1
-test string-11.24 {string match} {
- string match {a\*b} ab
+test string-11.24.$noComp {string match} {
+ run {string match {a\*b} ab}
} 0
-test string-11.25 {string match} {
- string match {a\*\?\[\]\\\x} "a*?\[\]\\x"
+test string-11.25.$noComp {string match} {
+ run {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
} 1
-test string-11.26 {string match} {
- string match ** ""
+test string-11.26.$noComp {string match} {
+ run {string match ** ""}
} 1
-test string-11.27 {string match} {
- string match *. ""
+test string-11.27.$noComp {string match} {
+ run {string match *. ""}
} 0
-test string-11.28 {string match} {
- string match "" ""
+test string-11.28.$noComp {string match} {
+ run {string match "" ""}
} 1
-test string-11.29 {string match} {
- string match \[a a
+test string-11.29.$noComp {string match} {
+ run {string match \[a a}
} 1
-test string-11.30 {string match, bad args} {
- list [catch {string match - b c} msg] $msg
+test string-11.30.$noComp {string match, bad args} {
+ list [catch {run {string match - b c}} msg] $msg
} {1 {bad option "-": must be -nocase}}
-test string-11.31 {string match case} {
- string match a A
+test string-11.31.$noComp {string match case} {
+ run {string match a A}
} 0
-test string-11.32 {string match nocase} {
- string match -n a A
+test string-11.32.$noComp {string match nocase} {
+ run {string match -n a A}
} 1
-test string-11.33 {string match nocase} {
- string match -nocase a\334 A\374
+test string-11.33.$noComp {string match nocase} {
+ run {string match -nocase a\334 A\374}
} 1
-test string-11.34 {string match nocase} {
- string match -nocase a*f ABCDEf
+test string-11.34.$noComp {string match nocase} {
+ run {string match -nocase a*f ABCDEf}
} 1
-test string-11.35 {string match case, false hope} {
+test string-11.35.$noComp {string match case, false hope} {
# This is true because '_' lies between the A-Z and a-z ranges
- string match {[A-z]} _
+ run {string match {[A-z]} _}
} 1
-test string-11.36 {string match nocase range} {
+test string-11.36.$noComp {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.
- string match -nocase {[A-z]} _
+ run {string match -nocase {[A-z]} _}
} 0
-test string-11.37 {string match nocase} {
- string match -nocase {[A-fh-Z]} g
+test string-11.37.$noComp {string match nocase} {
+ run {string match -nocase {[A-fh-Z]} g}
} 0
-test string-11.38 {string match case, reverse range} {
- string match {[A-fh-Z]} g
+test string-11.38.$noComp {string match case, reverse range} {
+ run {string match {[A-fh-Z]} g}
} 1
-test string-11.39 {string match, *\ case} {
- string match {*\abc} abc
+test string-11.39.$noComp {string match, *\ case} {
+ run {string match {*\abc} abc}
} 1
-test string-11.39.1 {string match, *\ case} {
- string match {*ab\c} abc
+test string-11.39.1.$noComp {string match, *\ case} {
+ run {string match {*ab\c} abc}
} 1
-test string-11.39.2 {string match, *\ case} {
- string match {*ab\*} ab*
+test string-11.39.2.$noComp {string match, *\ case} {
+ run {string match {*ab\*} ab*}
} 1
-test string-11.39.3 {string match, *\ case} {
- string match {*ab\*} abc
+test string-11.39.3.$noComp {string match, *\ case} {
+ run {string match {*ab\*} abc}
} 0
-test string-11.39.4 {string match, *\ case} {
- string match {*ab\\*} {ab\c}
+test string-11.39.4.$noComp {string match, *\ case} {
+ run {string match {*ab\\*} {ab\c}}
} 1
-test string-11.39.5 {string match, *\ case} {
- string match {*ab\\*} {ab\*}
+test string-11.39.5.$noComp {string match, *\ case} {
+ run {string match {*ab\\*} {ab\*}}
} 1
-test string-11.40 {string match, *special case} {
- string match {*[ab]} abc
+test string-11.40.$noComp {string match, *special case} {
+ run {string match {*[ab]} abc}
} 0
-test string-11.41 {string match, *special case} {
- string match {*[ab]*} abc
+test string-11.41.$noComp {string match, *special case} {
+ run {string match {*[ab]*} abc}
} 1
-test string-11.42 {string match, *special case} {
- string match "*\\" "\\"
+test string-11.42.$noComp {string match, *special case} {
+ run {string match "*\\" "\\"}
} 0
-test string-11.43 {string match, *special case} {
- string match "*\\\\" "\\"
+test string-11.43.$noComp {string match, *special case} {
+ run {string match "*\\\\" "\\"}
} 1
-test string-11.44 {string match, *special case} {
- string match "*???" "12345"
+test string-11.44.$noComp {string match, *special case} {
+ run {string match "*???" "12345"}
} 1
-test string-11.45 {string match, *special case} {
- string match "*???" "12"
+test string-11.45.$noComp {string match, *special case} {
+ run {string match "*???" "12"}
} 0
-test string-11.46 {string match, *special case} {
- string match "*\\*" "abc*"
+test string-11.46.$noComp {string match, *special case} {
+ run {string match "*\\*" "abc*"}
} 1
-test string-11.47 {string match, *special case} {
- string match "*\\*" "*"
+test string-11.47.$noComp {string match, *special case} {
+ run {string match "*\\*" "*"}
} 1
-test string-11.48 {string match, *special case} {
- string match "*\\*" "*abc"
+test string-11.48.$noComp {string match, *special case} {
+ run {string match "*\\*" "*abc"}
} 0
-test string-11.49 {string match, *special case} {
- string match "?\\*" "a*"
+test string-11.49.$noComp {string match, *special case} {
+ run {string match "?\\*" "a*"}
} 1
-test string-11.50 {string match, *special case} {
- string match "\\" "\\"
+test string-11.50.$noComp {string match, *special case} {
+ run {string match "\\" "\\"}
} 0
-test string-11.51 {string match; *, -nocase and UTF-8} {
- string match -nocase [binary format I 717316707] \
- [binary format I 2028036707]
+test string-11.51.$noComp {string match; *, -nocase and UTF-8} {
+ run {string match -nocase [binary format I 717316707] \
+ [binary format I 2028036707]}
} 1
-test string-11.52 {string match, null char in string} {
+test string-11.52.$noComp {string match, null char in string} {
set out ""
set ptn "*abc*"
foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
- lappend out [string match $ptn $elem]
+ lappend out [run {string match $ptn $elem}]
}
set out
} {1 1 1 1}
-test string-11.53 {string match, null char in pattern} {
+test string-11.53.$noComp {string match, null char in pattern} {
set out ""
foreach {ptn elem} [list \
"*\u0000abc\u0000" "\u0000abc\u0000" \
@@ -1196,662 +1392,711 @@ test string-11.53 {string match, null char in pattern} {
"*\u0000abc\u0000" "@\u0000abc\u0000ef" \
"*\u0000abc\u0000*" "@\u0000abc\u0000ef" \
] {
- lappend out [string match $ptn $elem]
+ lappend out [run {string match $ptn $elem}]
}
set out
} {1 0 1 0 1}
-test string-11.54 {string match, failure} {
+test string-11.54.$noComp {string match, failure} {
set longString ""
for {set i 0} {$i < 10} {incr i} {
append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
}
- string first $longString 123
- list [string match *cba* $longString] \
- [string match *a*l*\u0000* $longString] \
- [string match *a*l*\u0000*123 $longString] \
- [string match *a*l*\u0000*123* $longString] \
- [string match *a*l*\u0000*cba* $longString] \
- [string match *===* $longString]
+ run {string first $longString 123}
+ list [run {string match *cba* $longString}] \
+ [run {string match *a*l*\u0000* $longString}] \
+ [run {string match *a*l*\u0000*123 $longString}] \
+ [run {string match *a*l*\u0000*123* $longString}] \
+ [run {string match *a*l*\u0000*cba* $longString}] \
+ [run {string match *===* $longString}]
} {0 1 1 1 0 0}
-test string-11.55 {string match, invalid binary optimization} {
+test string-11.55.$noComp {string match, invalid binary optimization} {
[format string] match \u0141 [binary format c 65]
} 0
-test string-12.1 {string range} {
- list [catch {string range} msg] $msg
+test stringComp-12.1.0.$noComp {Bug 3588366: end-offsets before start} {
+ apply {s {
+ string range $s 0 end-5
+ }} 12345
+} {}
+test string-12.1.$noComp {string range} {
+ list [catch {run {string range}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
-test string-12.2 {string range} {
- list [catch {string range a 1} msg] $msg
+test string-12.2.$noComp {string range} {
+ list [catch {run {string range a 1}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
-test string-12.3 {string range} {
- list [catch {string range a 1 2 3} msg] $msg
+test string-12.3.$noComp {string range} {
+ list [catch {run {string range a 1 2 3}} msg] $msg
} {1 {wrong # args: should be "string range string first last"}}
-test string-12.4 {string range} {
- string range abcdefghijklmnop 2 14
+test string-12.4.$noComp {string range} {
+ run {string range abcdefghijklmnop 2 14}
} {cdefghijklmno}
-test string-12.5 {string range, last > length} {
- string range abcdefghijklmnop 7 1000
+test string-12.5.$noComp {string range, last > length} {
+ run {string range abcdefghijklmnop 7 1000}
} {hijklmnop}
-test string-12.6 {string range} {
- string range abcdefghijklmnop 10 end
+test string-12.6.$noComp {string range} {
+ run {string range abcdefghijklmnop 10 end}
} {klmnop}
-test string-12.7 {string range, last < first} {
- string range abcdefghijklmnop 10 9
+test string-12.7.$noComp {string range, last < first} {
+ run {string range abcdefghijklmnop 10 9}
} {}
-test string-12.8 {string range, first < 0} {
- string range abcdefghijklmnop -3 2
+test string-12.8.$noComp {string range, first < 0} {
+ run {string range abcdefghijklmnop -3 2}
} {abc}
-test string-12.9 {string range} {
- string range abcdefghijklmnop -3 -2
+test string-12.9.$noComp {string range} {
+ run {string range abcdefghijklmnop -3 -2}
} {}
-test string-12.10 {string range} {
- string range abcdefghijklmnop 1000 1010
+test string-12.10.$noComp {string range} {
+ run {string range abcdefghijklmnop 1000 1010}
} {}
-test string-12.11 {string range} {
- string range abcdefghijklmnop -100 end
+test string-12.11.$noComp {string range} {
+ run {string range abcdefghijklmnop -100 end}
} {abcdefghijklmnop}
-test string-12.12 {string range} {
- list [catch {string range abc abc 1} msg] $msg
+test string-12.12.$noComp {string range} {
+ list [catch {run {string range abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-12.13 {string range} {
- list [catch {string range abc 1 eof} msg] $msg
+test string-12.13.$noComp {string range} {
+ list [catch {run {string range abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-12.14 {string range} {
- string range abcdefghijklmnop end-1 end
+test string-12.14.$noComp {string range} {
+ run {string range abcdefghijklmnop end-1 end}
} {op}
-test string-12.15 {string range} {
- string range abcdefghijklmnop end 1000
+test string-12.15.$noComp {string range} {
+ run {string range abcdefghijklmnop end 1000}
} {p}
-test string-12.16 {string range} {
- string range abcdefghijklmnop end end-1
+test string-12.16.$noComp {string range} {
+ run {string range abcdefghijklmnop end end-1}
} {}
-test string-12.17 {string range, unicode} {
- string range ab\u7266cdefghijklmnop 5 5
+test string-12.17.$noComp {string range, unicode} {
+ run {string range ab\u7266cdefghijklmnop 5 5}
} e
-test string-12.18 {string range, unicode} {
- string range ab\u7266cdefghijklmnop 2 3
+test string-12.18.$noComp {string range, unicode} {
+ run {string range ab\u7266cdefghijklmnop 2 3}
} \u7266c
-test string-12.19 {string range, bytearray object} {
+test string-12.19.$noComp {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 equal $r1 $r2
+ set r1 [run {string range $b 1 end-1}]
+ set r2 [run {string range $b 1 6}]
+ run {string equal $r1 $r2}
} 1
-test string-12.20 {string range, out of bounds indices} {
- string range \u00ff 0 1
+test string-12.20.$noComp {string range, out of bounds indices} {
+ run {string range \u00ff 0 1}
} \u00ff
# Bug 1410553
-test string-12.21 {string range, regenerates correct reps, bug 1410553} {
+test string-12.21.$noComp {string range, regenerates correct reps, bug 1410553} {
set bytes "\x00 \x03 \x41"
set rxBuffer {}
foreach ch $bytes {
append rxBuffer $ch
if {$ch eq "\x03"} {
- string length $rxBuffer
+ run {string length $rxBuffer}
}
}
- set rxCRC [string range $rxBuffer end-1 end]
+ set rxCRC [run {string range $rxBuffer end-1 end}]
binary scan [join $bytes {}] "H*" input_hex
binary scan $rxBuffer "H*" rxBuffer_hex
binary scan $rxCRC "H*" rxCRC_hex
list $input_hex $rxBuffer_hex $rxCRC_hex
} {000341 000341 0341}
-test string-12.22 {string range, shimmering binary/index} {
+test string-12.22.$noComp {string range, shimmering binary/index} {
set s 0000000001
binary scan $s a* x
- string range $s $s end
+ run {string range $s $s end}
} 000000001
-test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} tip389 {
- list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]
+test string-12.23.$noComp {string range, surrogates, bug [11ae2be95dac9417]} tip389 {
+ run {list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]}
} [list \U100000 {} b]
-test string-13.1 {string repeat} {
- list [catch {string repeat} msg] $msg
+test string-13.1.$noComp {string repeat} {
+ list [catch {run {string repeat}} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
-test string-13.2 {string repeat} {
- list [catch {string repeat abc 10 oops} msg] $msg
+test string-13.2.$noComp {string repeat} {
+ list [catch {run {string repeat abc 10 oops}} msg] $msg
} {1 {wrong # args: should be "string repeat string count"}}
-test string-13.3 {string repeat} {
- string repeat {} 100
+test string-13.3.$noComp {string repeat} {
+ run {string repeat {} 100}
} {}
-test string-13.4 {string repeat} {
- string repeat { } 5
+test string-13.4.$noComp {string repeat} {
+ run {string repeat { } 5}
} { }
-test string-13.5 {string repeat} {
- string repeat abc 3
+test string-13.5.$noComp {string repeat} {
+ run {string repeat abc 3}
} {abcabcabc}
-test string-13.6 {string repeat} {
- string repeat abc -1
+test string-13.6.$noComp {string repeat} {
+ run {string repeat abc -1}
} {}
-test string-13.7 {string repeat} {
- list [catch {string repeat abc end} msg] $msg
+test string-13.7.$noComp {string repeat} {
+ list [catch {run {string repeat abc end}} msg] $msg
} {1 {expected integer but got "end"}}
-test string-13.8 {string repeat} {
- string repeat {} -1000
+test string-13.8.$noComp {string repeat} {
+ run {string repeat {} -1000}
} {}
-test string-13.9 {string repeat} {
- string repeat {} 0
+test string-13.9.$noComp {string repeat} {
+ run {string repeat {} 0}
} {}
-test string-13.10 {string repeat} {
- string repeat def 0
+test string-13.10.$noComp {string repeat} {
+ run {string repeat def 0}
} {}
-test string-13.11 {string repeat} {
- string repeat def 1
+test string-13.11.$noComp {string repeat} {
+ run {string repeat def 1}
} def
-test string-13.12 {string repeat} {
- string repeat ab\u7266cd 3
+test string-13.12.$noComp {string repeat} {
+ run {string repeat ab\u7266cd 3}
} ab\u7266cdab\u7266cdab\u7266cd
-test string-13.13 {string repeat} {
- string repeat \x00 3
+test string-13.13.$noComp {string repeat} {
+ run {string repeat \x00 3}
} \x00\x00\x00
-test string-13.14 {string repeat} {
+test string-13.14.$noComp {string repeat} {
# The string range will ensure us that string repeat gets a unicode string
- string repeat [string range ab\u7266cd 2 3] 3
+ run {string repeat [run {string range ab\u7266cd 2 3}] 3}
} \u7266c\u7266c\u7266c
-test string-14.1 {string replace} {
- list [catch {string replace} msg] $msg
+test string-14.1.$noComp {string replace} {
+ list [catch {run {string replace}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
-test string-14.2 {string replace} {
- list [catch {string replace a 1} msg] $msg
+test string-14.2.$noComp {string replace} {
+ list [catch {run {string replace a 1}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
-test string-14.3 {string replace} {
- list [catch {string replace a 1 2 3 4} msg] $msg
+test string-14.3.$noComp {string replace} {
+ list [catch {run {string replace a 1 2 3 4}} msg] $msg
} {1 {wrong # args: should be "string replace string first last ?string?"}}
-test string-14.4 {string replace} {
+test string-14.4.$noComp {string replace} {
} {}
-test string-14.5 {string replace} {
- string replace abcdefghijklmnop 2 14
+test string-14.5.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 2 14}
} {abp}
-test string-14.6 {string replace} {
- string replace abcdefghijklmnop 7 1000
+test string-14.6.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 7 1000}
} {abcdefg}
-test string-14.7 {string replace} {
- string replace abcdefghijklmnop 10 end
+test string-14.7.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 10 end}
} {abcdefghij}
-test string-14.8 {string replace} {
- string replace abcdefghijklmnop 10 9
+test string-14.8.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 10 9}
} {abcdefghijklmnop}
-test string-14.9 {string replace} {
- string replace abcdefghijklmnop -3 2
+test string-14.9.$noComp {string replace} {
+ run {string replace abcdefghijklmnop -3 2}
} {defghijklmnop}
-test string-14.10 {string replace} {
- string replace abcdefghijklmnop -3 -2
+test string-14.10.$noComp {string replace} {
+ run {string replace abcdefghijklmnop -3 -2}
} {abcdefghijklmnop}
-test string-14.11 {string replace} {
- string replace abcdefghijklmnop 1000 1010
+test string-14.11.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 1000 1010}
} {abcdefghijklmnop}
-test string-14.12 {string replace} {
- string replace abcdefghijklmnop -100 end
+test string-14.12.$noComp {string replace} {
+ run {string replace abcdefghijklmnop -100 end}
} {}
-test string-14.13 {string replace} {
- list [catch {string replace abc abc 1} msg] $msg
+test string-14.13.$noComp {string replace} {
+ list [catch {run {string replace abc abc 1}} msg] $msg
} {1 {bad index "abc": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-14.14 {string replace} {
- list [catch {string replace abc 1 eof} msg] $msg
+test string-14.14.$noComp {string replace} {
+ list [catch {run {string replace abc 1 eof}} msg] $msg
} {1 {bad index "eof": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-14.15 {string replace} {
- string replace abcdefghijklmnop end-10 end-2 NEW
+test string-14.15.$noComp {string replace} {
+ run {string replace abcdefghijklmnop end-10 end-2 NEW}
} {abcdeNEWop}
-test string-14.16 {string replace} {
- string replace abcdefghijklmnop 0 end foo
+test string-14.16.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 0 end foo}
} {foo}
-test string-14.17 {string replace} {
- string replace abcdefghijklmnop end end-1
+test string-14.17.$noComp {string replace} {
+ run {string replace abcdefghijklmnop end end-1}
} {abcdefghijklmnop}
-test string-14.18 {string replace} {
- string replace abcdefghijklmnop 10 9 XXX
+test string-14.18.$noComp {string replace} {
+ run {string replace abcdefghijklmnop 10 9 XXX}
} {abcdefghijklmnop}
-test string-14.19 {string replace} {
- string replace {} -1 0 A
+test string-14.19.$noComp {string replace} {
+ run {string replace {} -1 0 A}
} A
+test string-14.20.$noComp {string replace} {
+ run {string replace [makeByteArray abcdefghijklmnop] end-10 end-2\
+ [makeByteArray NEW]}
+} {abcdeNEWop}
-test string-15.1 {string tolower too few args} {
- list [catch {string tolower} msg] $msg
+
+test stringComp-14.21.$noComp {Bug 82e7f67325} {
+ apply {x {
+ set a [join $x {}]
+ lappend b [string length [string replace ___! 0 2 $a]]
+ lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+ }} {a b}
+} {3 3}
+test stringComp-14.22.$noComp {Bug 82e7f67325} memory {
+ # As in stringComp-14.1, but make sure we don't retain too many refs
+ leaktest {
+ apply {x {
+ set a [join $x {}]
+ lappend b [string length [string replace ___! 0 2 $a]]
+ lappend b [string length [string replace ___! 0 2 $a[unset a]]]
+ }} {a b}
+ }
+} {0}
+test stringComp-14.23.$noComp {Bug 0dca3bfa8f} {
+ apply {arg {
+ set argCopy $arg
+ set arg [string replace $arg 1 2 aa]
+ # Crashes in comparison before fix
+ expr {$arg ne $argCopy}
+ }} abcde
+} 1
+test stringComp-14.24.$noComp {Bug 1af8de570511} {
+ apply {{x y} {
+ # Generate an unshared string value
+ set val ""
+ for { set i 0 } { $i < $x } { incr i } {
+ set val [format "0%s" $val]
+ }
+ string replace $val[unset val] 1 1 $y
+ }} 4 x
+} 0x00
+test stringComp-14.25.$noComp {} {
+ string length [string replace [string repeat a\u00fe 2] 3 end {}]
+} 3
+
+test string-15.1.$noComp {string tolower too few args} {
+ list [catch {run {string tolower}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
-test string-15.2 {string tolower bad args} {
- list [catch {string tolower a b} msg] $msg
+test string-15.2.$noComp {string tolower bad args} {
+ list [catch {run {string tolower a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-15.3 {string tolower too many args} {
- list [catch {string tolower ABC 1 end oops} msg] $msg
+test string-15.3.$noComp {string tolower too many args} {
+ list [catch {run {string tolower ABC 1 end oops}} msg] $msg
} {1 {wrong # args: should be "string tolower string ?first? ?last?"}}
-test string-15.4 {string tolower} {
- string tolower ABCDeF
+test string-15.4.$noComp {string tolower} {
+ run {string tolower ABCDeF}
} {abcdef}
-test string-15.5 {string tolower} {
- string tolower "ABC XyZ"
+test string-15.5.$noComp {string tolower} {
+ run {string tolower "ABC XyZ"}
} {abc xyz}
-test string-15.6 {string tolower} {
- string tolower {123#$&*()}
+test string-15.6.$noComp {string tolower} {
+ run {string tolower {123#$&*()}}
} {123#$&*()}
-test string-15.7 {string tolower} {
- string tolower ABC 1
+test string-15.7.$noComp {string tolower} {
+ run {string tolower ABC 1}
} AbC
-test string-15.8 {string tolower} {
- string tolower ABC 1 end
+test string-15.8.$noComp {string tolower} {
+ run {string tolower ABC 1 end}
} Abc
-test string-15.9 {string tolower} {
- string tolower ABC 0 end-1
+test string-15.9.$noComp {string tolower} {
+ run {string tolower ABC 0 end-1}
} abC
-test string-15.10 {string tolower, unicode} {
- string tolower ABCabc\xc7\xe7
+test string-15.10.$noComp {string tolower, unicode} {
+ run {string tolower ABCabc\xc7\xe7}
} "abcabc\xe7\xe7"
-test string-15.11 {string tolower, compiled} {
- lindex [string tolower [list A B [list C]]] 1
+test string-15.11.$noComp {string tolower, compiled} {
+ lindex [run {string tolower [list A B [list C]]}] 1
} b
-test string-16.1 {string toupper} {
- list [catch {string toupper} msg] $msg
+test string-16.1.$noComp {string toupper} {
+ list [catch {run {string toupper}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
-test string-16.2 {string toupper} {
- list [catch {string toupper a b} msg] $msg
+test string-16.2.$noComp {string toupper} {
+ list [catch {run {string toupper a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-16.3 {string toupper} {
- list [catch {string toupper a 1 end oops} msg] $msg
+test string-16.3.$noComp {string toupper} {
+ list [catch {run {string toupper a 1 end oops}} msg] $msg
} {1 {wrong # args: should be "string toupper string ?first? ?last?"}}
-test string-16.4 {string toupper} {
- string toupper abCDEf
+test string-16.4.$noComp {string toupper} {
+ run {string toupper abCDEf}
} {ABCDEF}
-test string-16.5 {string toupper} {
- string toupper "abc xYz"
+test string-16.5.$noComp {string toupper} {
+ run {string toupper "abc xYz"}
} {ABC XYZ}
-test string-16.6 {string toupper} {
- string toupper {123#$&*()}
+test string-16.6.$noComp {string toupper} {
+ run {string toupper {123#$&*()}}
} {123#$&*()}
-test string-16.7 {string toupper} {
- string toupper abc 1
+test string-16.7.$noComp {string toupper} {
+ run {string toupper abc 1}
} aBc
-test string-16.8 {string toupper} {
- string toupper abc 1 end
+test string-16.8.$noComp {string toupper} {
+ run {string toupper abc 1 end}
} aBC
-test string-16.9 {string toupper} {
- string toupper abc 0 end-1
+test string-16.9.$noComp {string toupper} {
+ run {string toupper abc 0 end-1}
} ABc
-test string-16.10 {string toupper, unicode} {
- string toupper ABCabc\xc7\xe7
+test string-16.10.$noComp {string toupper, unicode} {
+ run {string toupper ABCabc\xc7\xe7}
} "ABCABC\xc7\xc7"
-test string-16.11 {string toupper, compiled} {
- lindex [string toupper [list a b [list c]]] 1
+test string-16.11.$noComp {string toupper, compiled} {
+ lindex [run {string toupper [list a b [list c]]}] 1
} B
-test string-17.1 {string totitle} {
- list [catch {string totitle} msg] $msg
+test string-17.1.$noComp {string totitle} {
+ list [catch {run {string totitle}} msg] $msg
} {1 {wrong # args: should be "string totitle string ?first? ?last?"}}
-test string-17.2 {string totitle} {
- list [catch {string totitle a b} msg] $msg
+test string-17.2.$noComp {string totitle} {
+ list [catch {run {string totitle a b}} msg] $msg
} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-17.3 {string totitle} {
- string totitle abCDEf
+test string-17.3.$noComp {string totitle} {
+ run {string totitle abCDEf}
} {Abcdef}
-test string-17.4 {string totitle} {
- string totitle "abc xYz"
+test string-17.4.$noComp {string totitle} {
+ run {string totitle "abc xYz"}
} {Abc xyz}
-test string-17.5 {string totitle} {
- string totitle {123#$&*()}
+test string-17.5.$noComp {string totitle} {
+ run {string totitle {123#$&*()}}
} {123#$&*()}
-test string-17.6 {string totitle, unicode} {
- string totitle ABCabc\xc7\xe7
+test string-17.6.$noComp {string totitle, unicode} {
+ run {string totitle ABCabc\xc7\xe7}
} "Abcabc\xe7\xe7"
-test string-17.7 {string totitle, unicode} {
- string totitle \u01f3BCabc\xc7\xe7
+test string-17.7.$noComp {string totitle, unicode} {
+ run {string totitle \u01f3BCabc\xc7\xe7}
} "\u01f2bcabc\xe7\xe7"
-test string-17.8 {string totitle, compiled} {
- lindex [string totitle [list aa bb [list cc]]] 0
+test string-17.8.$noComp {string totitle, compiled} {
+ lindex [run {string totitle [list aa bb [list cc]]}] 0
} Aa
-test string-17.9 {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 {
- list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
- [string totitle a\U118c0c 3 3]
+test string-17.9.$noComp {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 {
+ run {list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
+ [string totitle a\U118c0c 3 3]}
} [list a\U118a0c a\U118c0C a\U118c0C]
-test string-18.1 {string trim} {
- list [catch {string trim} msg] $msg
+test string-18.1.$noComp {string trim} {
+ list [catch {run {string trim}} msg] $msg
} {1 {wrong # args: should be "string trim string ?chars?"}}
-test string-18.2 {string trim} {
- list [catch {string trim a b c} msg] $msg
+test string-18.2.$noComp {string trim} {
+ list [catch {run {string trim a b c}} msg] $msg
} {1 {wrong # args: should be "string trim string ?chars?"}}
-test string-18.3 {string trim} {
- string trim " XYZ "
+test string-18.3.$noComp {string trim} {
+ run {string trim " XYZ "}
} {XYZ}
-test string-18.4 {string trim} {
- string trim "\t\nXYZ\t\n\r\n"
+test string-18.4.$noComp {string trim} {
+ run {string trim "\t\nXYZ\t\n\r\n"}
} {XYZ}
-test string-18.5 {string trim} {
- string trim " A XYZ A "
+test string-18.5.$noComp {string trim} {
+ run {string trim " A XYZ A "}
} {A XYZ A}
-test string-18.6 {string trim} {
- string trim "XXYYZZABC XXYYZZ" ZYX
+test string-18.6.$noComp {string trim} {
+ run {string trim "XXYYZZABC XXYYZZ" ZYX}
} {ABC }
-test string-18.7 {string trim} {
- string trim " \t\r "
+test string-18.7.$noComp {string trim} {
+ run {string trim " \t\r "}
} {}
-test string-18.8 {string trim} {
- string trim {abcdefg} {}
+test string-18.8.$noComp {string trim} {
+ run {string trim {abcdefg} {}}
} {abcdefg}
-test string-18.9 {string trim} {
- string trim {}
+test string-18.9.$noComp {string trim} {
+ run {string trim {}}
} {}
-test string-18.10 {string trim} {
- string trim ABC DEF
+test string-18.10.$noComp {string trim} {
+ run {string trim ABC DEF}
} {ABC}
-test string-18.11 {string trim, unicode} {
- string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8
+test string-18.11.$noComp {string trim, unicode} {
+ run {string trim "\xe7\xe8 AB\xe7C \xe8\xe7" \xe7\xe8}
} " AB\xe7C "
-test string-18.12 {string trim, unicode default} {
- string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
+test string-18.12.$noComp {string trim, unicode default} {
+ run {string trim \ufeff\x00\u0085\u00a0\u1680\u180eABC\u1361\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000}
} ABC\u1361
-test string-19.1 {string trimleft} {
- list [catch {string trimleft} msg] $msg
+test string-19.1.$noComp {string trimleft} {
+ list [catch {run {string trimleft}} msg] $msg
} {1 {wrong # args: should be "string trimleft string ?chars?"}}
-test string-19.2 {string trimleft} {
- string trimleft " XYZ "
+test string-19.2.$noComp {string trimleft} {
+ run {string trimleft " XYZ "}
} {XYZ }
-test string-19.3 {string trimleft, unicode default} {
- string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC
+test string-19.3.$noComp {string trimleft, unicode default} {
+ run {string trimleft \ufeff\u0085\u00a0\x00\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000\u1361ABC}
} \u1361ABC
-test string-20.1 {string trimright errors} {
- list [catch {string trimright} msg] $msg
+test string-20.1.$noComp {string trimright errors} {
+ list [catch {run {string trimright}} msg] $msg
} {1 {wrong # args: should be "string trimright string ?chars?"}}
-test string-20.2 {string trimright errors} {
- list [catch {string trimg a} msg] $msg
+test string-20.2.$noComp {string trimright errors} {
+ list [catch {run {string trimg a}} msg] $msg
} {1 {unknown or ambiguous subcommand "trimg": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test string-20.3 {string trimright} {
- string trimright " XYZ "
+test string-20.3.$noComp {string trimright} {
+ run {string trimright " XYZ "}
} { XYZ}
-test string-20.4 {string trimright} {
- string trimright " "
+test string-20.4.$noComp {string trimright} {
+ run {string trimright " "}
} {}
-test string-20.5 {string trimright} {
- string trimright ""
+test string-20.5.$noComp {string trimright} {
+ run {string trimright ""}
} {}
-test string-20.6 {string trimright, unicode default} {
- string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000
+test string-20.6.$noComp {string trimright, unicode default} {
+ run {string trimright ABC\u1361\u0085\x00\u00a0\u1680\u180e\u2000\u2001\u2002\u2003\u2004\u2005\u2006\u2007\u2008\u2009\u200a\u200b\u2028\u2029\u202f\u205f\u3000}
} ABC\u1361
-test string-21.1 {string wordend} {
- list [catch {string wordend a} msg] $msg
+test string-21.1.$noComp {string wordend} {
+ list [catch {run {string wordend a}} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
-test string-21.2 {string wordend} {
- list [catch {string wordend a b c} msg] $msg
+test string-21.2.$noComp {string wordend} {
+ list [catch {run {string wordend a b c}} msg] $msg
} {1 {wrong # args: should be "string wordend string index"}}
-test string-21.3 {string wordend} {
- list [catch {string wordend a gorp} msg] $msg
+test string-21.3.$noComp {string wordend} {
+ list [catch {run {string wordend a gorp}} msg] $msg
} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-21.4 {string wordend} {
- string wordend abc. -1
+test string-21.4.$noComp {string wordend} {
+ run {string wordend abc. -1}
} 3
-test string-21.5 {string wordend} {
- string wordend abc. 100
+test string-21.5.$noComp {string wordend} {
+ run {string wordend abc. 100}
} 4
-test string-21.6 {string wordend} {
- string wordend "word_one two three" 2
+test string-21.6.$noComp {string wordend} {
+ run {string wordend "word_one two three" 2}
} 8
-test string-21.7 {string wordend} {
- string wordend "one .&# three" 5
+test string-21.7.$noComp {string wordend} {
+ run {string wordend "one .&# three" 5}
} 6
-test string-21.8 {string wordend} {
- string worde "x.y" 0
+test string-21.8.$noComp {string wordend} {
+ run {string worde "x.y" 0}
} 1
-test string-21.9 {string wordend} {
- string worde "x.y" end-1
+test string-21.9.$noComp {string wordend} {
+ run {string worde "x.y" end-1}
} 2
-test string-21.10 {string wordend, unicode} {
- string wordend "xyz\u00c7de fg" 0
+test string-21.10.$noComp {string wordend, unicode} {
+ run {string wordend "xyz\u00c7de fg" 0}
} 6
-test string-21.11 {string wordend, unicode} {
- string wordend "xyz\uc700de fg" 0
+test string-21.11.$noComp {string wordend, unicode} {
+ run {string wordend "xyz\uc700de fg" 0}
} 6
-test string-21.12 {string wordend, unicode} {
- string wordend "xyz\u203fde fg" 0
+test string-21.12.$noComp {string wordend, unicode} {
+ run {string wordend "xyz\u203fde fg" 0}
} 6
-test string-21.13 {string wordend, unicode} {
- string wordend "xyz\u2045de fg" 0
+test string-21.13.$noComp {string wordend, unicode} {
+ run {string wordend "xyz\u2045de fg" 0}
} 3
-test string-21.14 {string wordend, unicode} {
- string wordend "\uc700\uc700 abc" 8
+test string-21.14.$noComp {string wordend, unicode} {
+ run {string wordend "\uc700\uc700 abc" 8}
} 6
-test string-22.1 {string wordstart} {
- list [catch {string word a} msg] $msg
+test string-22.1.$noComp {string wordstart} {
+ list [catch {run {string word a}} msg] $msg
} {1 {unknown or ambiguous subcommand "word": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test string-22.2 {string wordstart} {
- list [catch {string wordstart a} msg] $msg
+test string-22.2.$noComp {string wordstart} {
+ list [catch {run {string wordstart a}} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
-test string-22.3 {string wordstart} {
- list [catch {string wordstart a b c} msg] $msg
+test string-22.3.$noComp {string wordstart} {
+ list [catch {run {string wordstart a b c}} msg] $msg
} {1 {wrong # args: should be "string wordstart string index"}}
-test string-22.4 {string wordstart} {
- list [catch {string wordstart a gorp} msg] $msg
+test string-22.4.$noComp {string wordstart} {
+ list [catch {run {string wordstart a gorp}} msg] $msg
} {1 {bad index "gorp": must be integer?[+-]integer? or end?[+-]integer?}}
-test string-22.5 {string wordstart} {
- string wordstart "one two three_words" 400
+test string-22.5.$noComp {string wordstart} {
+ run {string wordstart "one two three_words" 400}
} 8
-test string-22.6 {string wordstart} {
- string wordstart "one two three_words" 2
+test string-22.6.$noComp {string wordstart} {
+ run {string wordstart "one two three_words" 2}
} 0
-test string-22.7 {string wordstart} {
- string wordstart "one two three_words" -2
+test string-22.7.$noComp {string wordstart} {
+ run {string wordstart "one two three_words" -2}
} 0
-test string-22.8 {string wordstart} {
- string wordstart "one .*&^ three" 6
+test string-22.8.$noComp {string wordstart} {
+ run {string wordstart "one .*&^ three" 6}
} 6
-test string-22.9 {string wordstart} {
- string wordstart "one two three" 4
+test string-22.9.$noComp {string wordstart} {
+ run {string wordstart "one two three" 4}
} 4
-test string-22.10 {string wordstart} {
- string wordstart "one two three" end-5
+test string-22.10.$noComp {string wordstart} {
+ run {string wordstart "one two three" end-5}
} 7
-test string-22.11 {string wordstart, unicode} {
- string wordstart "one tw\u00c7o three" 7
+test string-22.11.$noComp {string wordstart, unicode} {
+ run {string wordstart "one tw\u00c7o three" 7}
} 4
-test string-22.12 {string wordstart, unicode} {
- string wordstart "ab\uc700\uc700 cdef ghi" 12
+test string-22.12.$noComp {string wordstart, unicode} {
+ run {string wordstart "ab\uc700\uc700 cdef ghi" 12}
} 10
-test string-22.13 {string wordstart, unicode} {
- string wordstart "\uc700\uc700 abc" 8
+test string-22.13.$noComp {string wordstart, unicode} {
+ run {string wordstart "\uc700\uc700 abc" 8}
} 3
-test string-23.0 {string is boolean, Bug 1187123} testindexobj {
+test string-23.0.$noComp {string is boolean, Bug 1187123} testindexobj {
set x 5
catch {testindexobj $x foo bar soom}
- string is boolean $x
+ run {string is boolean $x}
} 0
-test string-23.1 {string is command with empty string} {
+test string-23.1.$noComp {string is command with empty string} {
set s ""
list \
- [string is alnum $s] \
- [string is alpha $s] \
- [string is ascii $s] \
- [string is control $s] \
- [string is boolean $s] \
- [string is digit $s] \
- [string is double $s] \
- [string is false $s] \
- [string is graph $s] \
- [string is integer $s] \
- [string is lower $s] \
- [string is print $s] \
- [string is punct $s] \
- [string is space $s] \
- [string is true $s] \
- [string is upper $s] \
- [string is wordchar $s] \
- [string is xdigit $s] \
+ [run {string is alnum $s}] \
+ [run {string is alpha $s}] \
+ [run {string is ascii $s}] \
+ [run {string is control $s}] \
+ [run {string is boolean $s}] \
+ [run {string is digit $s}] \
+ [run {string is double $s}] \
+ [run {string is false $s}] \
+ [run {string is graph $s}] \
+ [run {string is integer $s}] \
+ [run {string is lower $s}] \
+ [run {string is print $s}] \
+ [run {string is punct $s}] \
+ [run {string is space $s}] \
+ [run {string is true $s}] \
+ [run {string is upper $s}] \
+ [run {string is wordchar $s}] \
+ [run {string is xdigit $s}] \
} {1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1}
-test string-23.2 {string is command with empty string} {
+test string-23.2.$noComp {string is command with empty string} {
set s ""
list \
- [string is alnum -strict $s] \
- [string is alpha -strict $s] \
- [string is ascii -strict $s] \
- [string is control -strict $s] \
- [string is boolean -strict $s] \
- [string is digit -strict $s] \
- [string is double -strict $s] \
- [string is false -strict $s] \
- [string is graph -strict $s] \
- [string is integer -strict $s] \
- [string is lower -strict $s] \
- [string is print -strict $s] \
- [string is punct -strict $s] \
- [string is space -strict $s] \
- [string is true -strict $s] \
- [string is upper -strict $s] \
- [string is wordchar -strict $s] \
- [string is xdigit -strict $s] \
+ [run {string is alnum -strict $s}] \
+ [run {string is alpha -strict $s}] \
+ [run {string is ascii -strict $s}] \
+ [run {string is control -strict $s}] \
+ [run {string is boolean -strict $s}] \
+ [run {string is digit -strict $s}] \
+ [run {string is double -strict $s}] \
+ [run {string is false -strict $s}] \
+ [run {string is graph -strict $s}] \
+ [run {string is integer -strict $s}] \
+ [run {string is lower -strict $s}] \
+ [run {string is print -strict $s}] \
+ [run {string is punct -strict $s}] \
+ [run {string is space -strict $s}] \
+ [run {string is true -strict $s}] \
+ [run {string is upper -strict $s}] \
+ [run {string is wordchar -strict $s}] \
+ [run {string is xdigit -strict $s}] \
} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0}
-test string-24.1 {string reverse command} -body {
- string reverse
+test string-24.1.$noComp {string reverse command} -body {
+ run {string reverse}
} -returnCodes error -result "wrong # args: should be \"string reverse string\""
-test string-24.2 {string reverse command} -body {
- string reverse a b
+test string-24.2.$noComp {string reverse command} -body {
+ run {string reverse a b}
} -returnCodes error -result "wrong # args: should be \"string reverse string\""
-test string-24.3 {string reverse command - shared string} {
+test string-24.3.$noComp {string reverse command - shared string} {
set x abcde
- string reverse $x
+ run {string reverse $x}
} edcba
-test string-24.4 {string reverse command - unshared string} {
+test string-24.4.$noComp {string reverse command - unshared string} {
set x abc
set y de
- string reverse $x$y
+ run {string reverse $x$y}
} edcba
-test string-24.5 {string reverse command - shared unicode string} {
+test string-24.5.$noComp {string reverse command - shared unicode string} {
set x abcde\ud0ad
- string reverse $x
+ run {string reverse $x}
} \ud0adedcba
-test string-24.6 {string reverse command - unshared string} {
+test string-24.6.$noComp {string reverse command - unshared string} {
set x abc
set y de\ud0ad
- string reverse $x$y
+ run {string reverse $x$y}
} \ud0adedcba
-test string-24.7 {string reverse command - simple case} {
- string reverse a
+test string-24.7.$noComp {string reverse command - simple case} {
+ run {string reverse a}
} a
-test string-24.8 {string reverse command - simple case} {
- string reverse \ud0ad
+test string-24.8.$noComp {string reverse command - simple case} {
+ run {string reverse \ud0ad}
} \ud0ad
-test string-24.9 {string reverse command - simple case} {
- string reverse {}
+test string-24.9.$noComp {string reverse command - simple case} {
+ run {string reverse {}}
} {}
-test string-24.10 {string reverse command - corner case} {
+test string-24.10.$noComp {string reverse command - corner case} {
set x \ubeef\ud0ad
- string reverse $x
+ run {string reverse $x}
} \ud0ad\ubeef
-test string-24.11 {string reverse command - corner case} {
+test string-24.11.$noComp {string reverse command - corner case} {
set x \ubeef
set y \ud0ad
- string reverse $x$y
+ run {string reverse $x$y}
} \ud0ad\ubeef
-test string-24.12 {string reverse command - corner case} {
+test string-24.12.$noComp {string reverse command - corner case} {
set x \ubeef
set y \ud0ad
- string is ascii [string reverse $x$y]
+ run {string is ascii [run {string reverse $x$y}]}
} 0
-test string-24.13 {string reverse command - pure Unicode string} {
- string reverse [string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5]
+test string-24.13.$noComp {string reverse command - pure Unicode string} {
+ run {string reverse [run {string range \ubeef\ud0ad\ubeef\ud0ad\ubeef\ud0ad 1 5}]}
} \ud0ad\ubeef\ud0ad\ubeef\ud0ad
-test string-24.14 {string reverse command - pure bytearray} {
- binary scan [string reverse [binary format H* 010203]] H* x
+test string-24.14.$noComp {string reverse command - pure bytearray} {
+ binary scan [run {string reverse [binary format H* 010203]}] H* x
set x
} 030201
-test string-24.15 {string reverse command - pure bytearray} {
- binary scan [tcl::string::reverse [binary format H* 010203]] H* x
+test string-24.15.$noComp {string reverse command - pure bytearray} {
+ binary scan [run {tcl::string::reverse [binary format H* 010203]}] H* x
set x
} 030201
-test string-25.1 {string is list} {
- string is list {a b c}
+test string-25.1.$noComp {string is list} {
+ run {string is list {a b c}}
} 1
-test string-25.2 {string is list} {
- string is list "a \{b c"
+test string-25.2.$noComp {string is list} {
+ run {string is list "a \{b c"}
} 0
-test string-25.3 {string is list} {
- string is list {a {b c}d e}
+test string-25.3.$noComp {string is list} {
+ run {string is list {a {b c}d e}}
} 0
-test string-25.4 {string is list} {
- string is list {}
+test string-25.4.$noComp {string is list} {
+ run {string is list {}}
} 1
-test string-25.5 {string is list} {
- string is list -strict {a b c}
+test string-25.5.$noComp {string is list} {
+ run {string is list -strict {a b c}}
} 1
-test string-25.6 {string is list} {
- string is list -strict "a \{b c"
+test string-25.6.$noComp {string is list} {
+ run {string is list -strict "a \{b c"}
} 0
-test string-25.7 {string is list} {
- string is list -strict {a {b c}d e}
+test string-25.7.$noComp {string is list} {
+ run {string is list -strict {a {b c}d e}}
} 0
-test string-25.8 {string is list} {
- string is list -strict {}
+test string-25.8.$noComp {string is list} {
+ run {string is list -strict {}}
} 1
-test string-25.9 {string is list} {
+test string-25.9.$noComp {string is list} {
set x {}
- list [string is list -failindex x {a b c}] $x
+ list [run {string is list -failindex x {a b c}}] $x
} {1 {}}
-test string-25.10 {string is list} {
+test string-25.10.$noComp {string is list} {
set x {}
- list [string is list -failindex x "a \{b c"] $x
+ list [run {string is list -failindex x "a \{b c"}] $x
} {0 2}
-test string-25.11 {string is list} {
+test string-25.11.$noComp {string is list} {
set x {}
- list [string is list -failindex x {a b {b c}d e}] $x
+ list [run {string is list -failindex x {a b {b c}d e}}] $x
} {0 4}
-test string-25.12 {string is list} {
+test string-25.12.$noComp {string is list} {
set x {}
- list [string is list -failindex x {}] $x
+ list [run {string is list -failindex x {}}] $x
} {1 {}}
-test string-25.13 {string is list} {
+test string-25.13.$noComp {string is list} {
set x {}
- list [string is list -failindex x { {b c}d e}] $x
+ list [run {string is list -failindex x { {b c}d e}}] $x
} {0 2}
-test string-25.14 {string is list} {
+test string-25.14.$noComp {string is list} {
set x {}
- list [string is list -failindex x "\uabcd {b c}d e"] $x
+ list [run {string is list -failindex x "\uabcd {b c}d e"}] $x
} {0 2}
-test string-26.1 {tcl::prefix, too few args} -body {
+test string-26.1.$noComp {tcl::prefix, too few args} -body {
tcl::prefix match a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix match ?options? table string"}
-test string-26.2 {tcl::prefix, bad args} -body {
+test string-26.2.$noComp {tcl::prefix, bad args} -body {
tcl::prefix match a b c
} -returnCodes 1 -result {bad option "a": must be -error, -exact, or -message}
-test string-26.2.1 {tcl::prefix, empty table} -body {
+test string-26.2.1.$noComp {tcl::prefix, empty table} -body {
tcl::prefix match {} foo
} -returnCodes 1 -result {bad option "foo": no valid options}
-test string-26.3 {tcl::prefix, bad args} -body {
+test string-26.3.$noComp {tcl::prefix, bad args} -body {
tcl::prefix match -error "{}x" -exact str1 str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
-test string-26.3.1 {tcl::prefix, bad args} -body {
+test string-26.3.1.$noComp {tcl::prefix, bad args} -body {
tcl::prefix match -error "x" -exact str1 str2
} -returnCodes 1 -result {error options must have an even number of elements}
-test string-26.3.2 {tcl::prefix, bad args} -body {
+test string-26.3.2.$noComp {tcl::prefix, bad args} -body {
tcl::prefix match -error str1 str2
} -returnCodes 1 -result {missing value for -error}
-test string-26.4 {tcl::prefix, bad args} -body {
+test string-26.4.$noComp {tcl::prefix, bad args} -body {
tcl::prefix match -message str1 str2
} -returnCodes 1 -result {missing value for -message}
-test string-26.5 {tcl::prefix} {
+test string-26.5.$noComp {tcl::prefix} {
tcl::prefix match {apa bepa cepa depa} cepa
} cepa
-test string-26.6 {tcl::prefix} {
+test string-26.6.$noComp {tcl::prefix} {
tcl::prefix match {apa bepa cepa depa} be
} bepa
-test string-26.7 {tcl::prefix} -body {
+test string-26.7.$noComp {tcl::prefix} -body {
tcl::prefix match -exact {apa bepa cepa depa} be
} -returnCodes 1 -result {bad option "be": must be apa, bepa, cepa, or depa}
-test string-26.8 {tcl::prefix} -body {
+test string-26.8.$noComp {tcl::prefix} -body {
tcl::prefix match -message wombat {apa bepa bear depa} be
} -returnCodes 1 -result {ambiguous wombat "be": must be apa, bepa, bear, or depa}
-test string-26.9 {tcl::prefix} -body {
+test string-26.9.$noComp {tcl::prefix} -body {
tcl::prefix match -error {} {apa bepa bear depa} be
} -returnCodes 0 -result {}
-test string-26.10 {tcl::prefix} -body {
+test string-26.10.$noComp {tcl::prefix} -body {
tcl::prefix match -error {-level 1} {apa bepa bear depa} be
} -returnCodes 2 -result {ambiguous option "be": must be apa, bepa, bear, or depa}
-test string-26.10.1 {tcl::prefix} -setup {
+test string-26.10.1.$noComp {tcl::prefix} -setup {
proc _testprefix {args} {
array set opts {-a x -b y -c y}
foreach {opt val} $args {
@@ -1887,7 +2132,7 @@ proc MemStress {args} {
return $res
}
-test string-26.11 {tcl::prefix: testing for leaks} -body {
+test string-26.11.$noComp {tcl::prefix: testing for leaks} -body {
# This test is made to stress object reference management
MemStress {
set table {hejj miff gurk}
@@ -1908,7 +2153,7 @@ test string-26.11 {tcl::prefix: testing for leaks} -body {
}
} -constraints memory -result {0 0 0}
-test string-26.12 {tcl::prefix: testing for leaks} -body {
+test string-26.12.$noComp {tcl::prefix: testing for leaks} -body {
# This is a memory leak test in a form that might actually happen
# in real code. The shared literal "miff" causes a connection
# between the item and the table.
@@ -1926,7 +2171,7 @@ test string-26.12 {tcl::prefix: testing for leaks} -body {
}
} -constraints memory -result 0
-test string-26.13 {tcl::prefix: testing for leaks} -body {
+test string-26.13.$noComp {tcl::prefix: testing for leaks} -body {
# This test is made to stress object reference management
MemStress {
set table [list hejj miff]
@@ -1939,110 +2184,234 @@ test string-26.13 {tcl::prefix: testing for leaks} -body {
}
} -constraints memory -result {0}
-test string-27.1 {tcl::prefix all, too few args} -body {
+test string-27.1.$noComp {tcl::prefix all, too few args} -body {
tcl::prefix all a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
-test string-27.2 {tcl::prefix all, bad args} -body {
+test string-27.2.$noComp {tcl::prefix all, bad args} -body {
tcl::prefix all a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix all table string"}
-test string-27.3 {tcl::prefix all, bad args} -body {
+test string-27.3.$noComp {tcl::prefix all, bad args} -body {
tcl::prefix all "{}x" str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
-test string-27.4 {tcl::prefix all} {
+test string-27.4.$noComp {tcl::prefix all} {
tcl::prefix all {apa bepa cepa depa} c
} cepa
-test string-27.5 {tcl::prefix all} {
+test string-27.5.$noComp {tcl::prefix all} {
tcl::prefix all {apa bepa cepa depa} cepa
} cepa
-test string-27.6 {tcl::prefix all} {
+test string-27.6.$noComp {tcl::prefix all} {
tcl::prefix all {apa bepa cepa depa} cepax
} {}
-test string-27.7 {tcl::prefix all} {
+test string-27.7.$noComp {tcl::prefix all} {
tcl::prefix all {apa aska appa} a
} {apa aska appa}
-test string-27.8 {tcl::prefix all} {
+test string-27.8.$noComp {tcl::prefix all} {
tcl::prefix all {apa aska appa} ap
} {apa appa}
-test string-27.9 {tcl::prefix all} {
+test string-27.9.$noComp {tcl::prefix all} {
tcl::prefix all {apa aska appa} p
} {}
-test string-27.10 {tcl::prefix all} {
+test string-27.10.$noComp {tcl::prefix all} {
tcl::prefix all {apa aska appa} {}
} {apa aska appa}
-test string-28.1 {tcl::prefix longest, too few args} -body {
+test string-28.1.$noComp {tcl::prefix longest, too few args} -body {
tcl::prefix longest a
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
-test string-28.2 {tcl::prefix longest, bad args} -body {
+test string-28.2.$noComp {tcl::prefix longest, bad args} -body {
tcl::prefix longest a b c
} -returnCodes 1 -result {wrong # args: should be "tcl::prefix longest table string"}
-test string-28.3 {tcl::prefix longest, bad args} -body {
+test string-28.3.$noComp {tcl::prefix longest, bad args} -body {
tcl::prefix longest "{}x" str2
} -returnCodes 1 -result {list element in braces followed by "x" instead of space}
-test string-28.4 {tcl::prefix longest} {
+test string-28.4.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa bepa cepa depa} c
} cepa
-test string-28.5 {tcl::prefix longest} {
+test string-28.5.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa bepa cepa depa} cepa
} cepa
-test string-28.6 {tcl::prefix longest} {
+test string-28.6.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa bepa cepa depa} cepax
} {}
-test string-28.7 {tcl::prefix longest} {
+test string-28.7.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa aska appa} a
} a
-test string-28.8 {tcl::prefix longest} {
+test string-28.8.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa aska appa} ap
} ap
-test string-28.9 {tcl::prefix longest} {
+test string-28.9.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa bska appa} a
} ap
-test string-28.10 {tcl::prefix longest} {
+test string-28.10.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa bska appa} {}
} {}
-test string-28.11 {tcl::prefix longest} {
+test string-28.11.$noComp {tcl::prefix longest} {
tcl::prefix longest {{} bska appa} {}
} {}
-test string-28.12 {tcl::prefix longest} {
+test string-28.12.$noComp {tcl::prefix longest} {
tcl::prefix longest {apa {} appa} {}
} {}
-test string-28.13 {tcl::prefix longest} {
+test string-28.13.$noComp {tcl::prefix longest} {
# Test UTF8 handling
tcl::prefix longest {ax\x90 bep ax\x91} a
} ax
-test string-29.1 {string cat, no arg} {
- string cat
+test string-29.1.$noComp {string cat, no arg} {
+ run {string cat}
} ""
-test string-29.2 {string cat, single arg} {
+test string-29.2.$noComp {string cat, single arg} {
set x FOO
- string compare $x [string cat $x]
+ run {string compare $x [run {string cat $x}]}
} 0
-test string-29.3 {string cat, two args} {
+test string-29.3.$noComp {string cat, two args} {
set x FOO
- string compare $x$x [string cat $x $x]
+ run {string compare $x$x [run {string cat $x $x}]}
} 0
-test string-29.4 {string cat, many args} {
+test string-29.4.$noComp {string cat, many args} {
set x FOO
set n 260
- set xx [string repeat $x $n]
- set vv [string repeat {$x} $n]
- set vvs [string repeat {$x } $n]
- set r1 [string compare $xx [subst $vv]]
- set r2 [string compare $xx [eval "string cat $vvs"]]
+ set xx [run {string repeat $x $n}]
+ set vv [run {string repeat {$x} $n}]
+ set vvs [run {string repeat {$x } $n}]
+ set r1 [run {string compare $xx [subst $vv]}]
+ set r2 [run {string compare $xx [eval "run {string cat $vvs}"]}]
list $r1 $r2
} {0 0}
+if {$noComp} {
+test string-29.5.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat [list x] [list]}]
+} -match glob -result {*no string representation}
+test string-29.6.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat [list] [list x]}]
+} -match glob -result {*no string representation}
+test string-29.7.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat [list x] [list] [list]}]
+} -match glob -result {*no string representation}
+test string-29.8.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat [list] [list x] [list]}]
+} -match glob -result {*no string representation}
+test string-29.9.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat [list] [list] [list x]}]
+} -match glob -result {*no string representation}
+test string-29.10.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat [list x] [list x]}]
+} -match glob -result {*, string representation "xx"}
+test string-29.11.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation \
+ [run {string cat [list x] [encoding convertto utf-8 {}]}]
+} -match glob -result {*no string representation}
+test string-29.12.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation \
+ [run {string cat [encoding convertto utf-8 {}] [list x]}]
+} -match glob -result {*, string representation "x"}
+test string-29.13.$noComp {string cat, efficiency} -body {
+ tcl::unsupported::representation [run {string cat \
+ [encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}]
+} -match glob -result {*, string representation "x"}
+test string-29.14.$noComp {string cat, efficiency} -setup {
+ set e [encoding convertto utf-8 {}]
+} -cleanup {
+ unset e
+} -body {
+ tcl::unsupported::representation [run {string cat $e $e [list x]}]
+} -match glob -result {*no string representation}
+test string-29.15.$noComp {string cat, efficiency} -setup {
+ set e [encoding convertto utf-8 {}]
+ set f [encoding convertto utf-8 {}]
+} -cleanup {
+ unset e f
+} -body {
+ tcl::unsupported::representation [run {string cat $e $f $e $f [list x]}]
+} -match glob -result {*no string representation}
+}
-test string-30.1.1 {[Bug ba921a8d98]: string cat} {
- string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]
+test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} {
+ run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]}
} hellohello
-test string-30.1.2 {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
- set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"
+test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
+ run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"}
} hellohello
+test string-31.1.$noComp {string is dict} {
+ string is dict {a b c d}
+} 1
+test string-31.1a.$noComp {string is dict} {
+ string is dict {a b c}
+} 0
+test string-31.2.$noComp {string is dict} {
+ string is dict "a \{b c"
+} 0
+test string-31.3.$noComp {string is dict} {
+ string is dict {a {b c}d e}
+} 0
+test string-31.4.$noComp {string is dict} {
+ string is dict {}
+} 1
+test string-31.5.$noComp {string is dict} {
+ string is dict -strict {a b c d}
+} 1
+test string-31.5a.$noComp {string is dict} {
+ string is dict -strict {a b c}
+} 0
+test string-31.6.$noComp {string is dict} {
+ string is dict -strict "a \{b c"
+} 0
+test string-31.7.$noComp {string is dict} {
+ string is dict -strict {a {b c}d e}
+} 0
+test string-31.8.$noComp {string is dict} {
+ string is dict -strict {}
+} 1
+test string-31.9.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x {a b c d}] $x
+} {1 {}}
+test string-31.9a.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x {a b c}] $x
+} {0 -1}
+test string-31.10.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x "a \{b c d"] $x
+} {0 2}
+test string-31.10a.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x "a \{b c"] $x
+} {0 2}
+test string-31.11.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x {a b {b c}d e}] $x
+} {0 4}
+test string-31.12.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x {}] $x
+} {1 {}}
+test string-31.13.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x { {b c}d e}] $x
+} {0 2}
+test string-31.14.$noComp {string is dict} {
+ set x {}
+ list [string is dict -failindex x "\uabcd {b c}d e"] $x
+} {0 2}
+test string-31.15.$noComp {string is dict, valid dict} {
+ string is dict {a b c d e f}
+} 1
+test string-31.16.$noComp {string is dict, invalid dict} {
+ string is dict a
+} 0
+test string-31.17.$noComp {string is dict, valid dict packed in invalid dict} {
+ string is dict {{a b c d e f g h}}
+} 0
+}; # foreach noComp {0 1}
+
# cleanup
rename MemStress {}
+rename makeByteArray {}
+rename makeUnicode {}
+rename makeList {}
+rename makeShared {}
catch {rename foo {}}
::tcltest::cleanupTests
return
diff --git a/tests/stringComp.test b/tests/stringComp.test
deleted file mode 100644
index 2aeb08e..0000000
--- a/tests/stringComp.test
+++ /dev/null
@@ -1,801 +0,0 @@
-# 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.
-
-if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
- namespace import -force ::tcltest::*
-}
-
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
-
-# Some tests require the testobj command
-
-testConstraint testobj [expr {[info commands testobj] != {}}]
-testConstraint memory [llength [info commands memory]]
-if {[testConstraint memory]} {
- proc getbytes {} {
- set lines [split [memory info] \n]
- return [lindex $lines 3 3]
- }
- proc leaktest {script {iterations 3}} {
- set end [getbytes]
- for {set i 0} {$i < $iterations} {incr i} {
- uplevel 1 $script
- set tmp $end
- set end [getbytes]
- }
- return [expr {$end - $tmp}]
- }
-}
-
-test stringComp-1.1 {error conditions} {
- proc foo {} {string gorp a b}
- list [catch {foo} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be bytelength, cat, compare, equal, first, index, is, last, length, map, match, range, repeat, replace, reverse, tolower, totitle, toupper, trim, trimleft, trimright, wordend, or wordstart}}
-test stringComp-1.2 {error conditions} {
- proc foo {} {string}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string subcommand ?arg ...?"}}
-test stringComp-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 compare|equal over equal constraints
-## Use result for string compare, and negate it for string equal
-## The body will be tested both in and outside a proc
-set i 0
-foreach {tname tbody tresult tcode} {
- {too few args} {
- string compare a
- } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
- {bad args} {
- string compare a b c
- } {bad option "a": must be -nocase or -length} {error}
- {bad args} {
- string compare -length -nocase str1 str2
- } {expected integer but got "-nocase"} {error}
- {too many args} {
- string compare -length 10 -nocase str1 str2 str3
- } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
- {compare with length unspecified} {
- string compare -length 10 10
- } {wrong # args: should be "string compare ?-nocase? ?-length int? string1 string2"} {error}
- {basic operation fail} {
- string compare abcde abdef
- } {-1} {}
- {basic operation success} {
- string compare abcde abcde
- } {0} {}
- {with length} {
- string compare -length 2 abcde abxyz
- } {0} {}
- {with special index} {
- string compare -length end-3 abcde abxyz
- } {expected integer but got "end-3"} {error}
- {unicode} {
- string compare ab\u7266 ab\u7267
- } {-1} {}
- {unicode} {string compare \334 \u00dc} 0 {}
- {unicode} {string compare \334 \u00fc} -1 {}
- {unicode} {string compare \334\334\334\374\374 \334\334\334\334\334} 1 {}
- {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)
- string compare "\x80" "@"
- # 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} {}
- {-nocase 1} {string compare -nocase abcde abdef} {-1} {}
- {-nocase 2} {string compare -nocase abcde Abdef} {-1} {}
- {-nocase 3} {string compare -nocase abcde ABCDE} {0} {}
- {-nocase 4} {string compare -nocase abcde abcde} {0} {}
- {-nocase unicode} {
- string compare -nocase \334 \u00dc
- } 0 {}
- {-nocase unicode} {
- string compare -nocase \334\334\334\374\u00fc \334\334\334\334\334
- } 0 {}
- {-nocase with length} {
- string compare -length 2 -nocase abcde Abxyz
- } {0} {}
- {-nocase with length} {
- string compare -nocase -length 3 abcde Abxyz
- } {-1} {}
- {-nocase with length <= 0} {
- string compare -nocase -length -1 abcde AbCdEf
- } {-1} {}
- {-nocase with excessive length} {
- string compare -nocase -length 50 AbCdEf abcde
- } {1} {}
- {-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
- string compare -len 5 \334\334\334 \334\334\374
- } -1 {}
- {-nocase with special index} {
- string compare -nocase -length end-3 Abcde abxyz
- } {expected integer but got "end-3"} error
- {null strings} {
- string compare "" ""
- } 0 {}
- {null strings} {
- string compare "" foo
- } -1 {}
- {null strings} {
- string compare foo ""
- } 1 {}
- {-nocase null strings} {
- string compare -nocase "" ""
- } 0 {}
- {-nocase null strings} {
- string compare -nocase "" foo
- } -1 {}
- {-nocase null strings} {
- string compare -nocase foo ""
- } 1 {}
- {with length, unequal strings} {
- string compare -length 2 abc abde
- } 0 {}
- {with length, unequal strings} {
- string compare -length 2 ab abde
- } 0 {}
- {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 {}
- {high bit} {
- string compare "a\x80" "a@"
- } 1 {}
- {high bit} {
- string compare "a\x00" "a\x01"
- } -1 {}
- {high bit} {
- string compare "\x00\x00" "\x00\x01"
- } -1 {}
- {binary equal} {
- string compare [binary format a100 0] [binary format a100 0]
- } 0 {}
- {binary neq} {
- string compare [binary format a100a 0 1] [binary format a100a 0 0]
- } 1 {}
- {binary neq inequal length} {
- string compare [binary format a20a 0 1] [binary format a100a 0 0]
- } 1 {}
-} {
- if {$tname eq ""} { continue }
- if {$tcode eq ""} { set tcode ok }
- test stringComp-2.[incr i] "string compare, $tname" \
- -body [list eval $tbody] \
- -returnCodes $tcode -result $tresult
- test stringComp-2.[incr i] "string compare bc, $tname" \
- -body "[list proc foo {} $tbody];foo" \
- -returnCodes $tcode -result $tresult
- if {"error" ni $tcode} {
- set tresult [expr {!$tresult}]
- } else {
- set tresult [string map {compare equal} $tresult]
- }
- set tbody [string map {compare equal} $tbody]
- test stringComp-2.[incr i] "string equal, $tname" \
- -body [list eval $tbody] \
- -returnCodes $tcode -result $tresult
- test stringComp-2.[incr i] "string equal bc, $tname" \
- -body "[list proc foo {} $tbody];foo" \
- -returnCodes $tcode -result $tresult
-}
-
-# need a few extra tests short abbr cmd
-test stringComp-3.1 {string compare, shortest method name} {
- proc foo {} {string co abcde ABCDE}
- foo
-} 1
-test stringComp-3.2 {string equal, shortest method name} {
- proc foo {} {string e abcde ABCDE}
- foo
-} 0
-test stringComp-3.3 {string equal -nocase} {
- proc foo {} {string eq -nocase abcde ABCDE}
- foo
-} 1
-
-test stringComp-4.1 {string first, too few args} {
- proc foo {} {string first a}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string first needleString haystackString ?startIndex?"}}
-test stringComp-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?[+-]integer? or end?[+-]integer?}}
-test stringComp-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 needleString haystackString ?startIndex?"}}
-test stringComp-4.4 {string first} {
- proc foo {} {string first bq abcdefgbcefgbqrs}
- foo
-} 12
-test stringComp-4.5 {string first} {
- proc foo {} {string fir bcd abcdefgbcefgbqrs}
- foo
-} 1
-test stringComp-4.6 {string first} {
- proc foo {} {string f b abcdefgbcefgbqrs}
- foo
-} 1
-test stringComp-4.7 {string first} {
- proc foo {} {string first xxx x123xx345xxx789xxx012}
- foo
-} 9
-test stringComp-4.8 {string first} {
- proc foo {} {string first "" x123xx345xxx789xxx012}
- foo
-} -1
-test stringComp-4.9 {string first, unicode} {
- proc foo {} {string first x abc\u7266x}
- foo
-} 4
-test stringComp-4.10 {string first, unicode} {
- proc foo {} {string first \u7266 abc\u7266x}
- foo
-} 3
-test stringComp-4.11 {string first, start index} {
- proc foo {} {string first \u7266 abc\u7266x 3}
- foo
-} 3
-test stringComp-4.12 {string first, start index} {
- proc foo {} {string first \u7266 abc\u7266x 4}
- foo
-} -1
-test stringComp-4.13 {string first, start index} {
- proc foo {} {string first \u7266 abc\u7266x end-2}
- foo
-} 3
-test stringComp-4.14 {string first, negative start index} {
- proc foo {} {string first b abc -1}
- foo
-} 1
-
-test stringComp-5.1 {string index} {
- proc foo {} {string index}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string index string charIndex"}}
-test stringComp-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 stringComp-5.3 {string index} {
- proc foo {} {string index abcde 0}
- foo
-} a
-test stringComp-5.4 {string index} {
- proc foo {} {string in abcde 4}
- foo
-} e
-test stringComp-5.5 {string index} {
- proc foo {} {string index abcde 5}
- foo
-} {}
-test stringComp-5.6 {string index} {
- proc foo {} {string index abcde -10}
- list [catch {foo} msg] $msg
-} {0 {}}
-test stringComp-5.7 {string index} {
- proc foo {} {string index a xyz}
- list [catch {foo} msg] $msg
-} {1 {bad index "xyz": must be integer?[+-]integer? or end?[+-]integer?}}
-test stringComp-5.8 {string index} {
- proc foo {} {string index abc end}
- foo
-} c
-test stringComp-5.9 {string index} {
- proc foo {} {string index abc end-1}
- foo
-} b
-test stringComp-5.10 {string index, unicode} {
- proc foo {} {string index abc\u7266d 4}
- foo
-} d
-test stringComp-5.11 {string index, unicode} {
- proc foo {} {string index abc\u7266d 3}
- foo
-} \u7266
-test stringComp-5.12 {string index, unicode over char length, under byte length} {
- proc foo {} {string index \334\374\334\374 6}
- foo
-} {}
-test stringComp-5.13 {string index, bytearray object} {
- proc foo {} {string index [binary format a5 fuz] 0}
- foo
-} f
-test stringComp-5.14 {string index, bytearray object} {
- proc foo {} {string index [binary format I* {0x50515253 0x52}] 3}
- foo
-} S
-test stringComp-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 stringComp-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 stringComp-5.17 {string index, bad integer} -body {
- proc foo {} {string index "abc" 0o8}
- list [catch {foo} msg] $msg
-} -match glob -result {1 {*invalid octal number*}}
-test stringComp-5.18 {string index, bad integer} -body {
- proc foo {} {string index "abc" end-0o0289}
- list [catch {foo} msg] $msg
-} -match glob -result {1 {*invalid octal number*}}
-test stringComp-5.19 {string index, bytearray object out of bounds} {
- proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
- foo
-} {}
-test stringComp-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 stringComp-8.1 {string bytelength} {
- proc foo {} {string bytelength}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string bytelength string"}}
-test stringComp-8.2 {string bytelength} {
- proc foo {} {string bytelength a b}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string bytelength string"}}
-test stringComp-8.3 {string bytelength} {
- proc foo {} {string bytelength "\u00c7"}
- foo
-} 2
-test stringComp-8.4 {string bytelength} {
- proc foo {} {string b ""}
- foo
-} 0
-
-## string length
-##
-test stringComp-9.1 {string length} {
- proc foo {} {string length}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string length string"}}
-test stringComp-9.2 {string length} {
- proc foo {} {string length a b}
- list [catch {foo} msg] $msg
-} {1 {wrong # args: should be "string length string"}}
-test stringComp-9.3 {string length} {
- proc foo {} {string length "a little string"}
- foo
-} 15
-test stringComp-9.4 {string length} {
- proc foo {} {string le ""}
- foo
-} 0
-test stringComp-9.5 {string length, unicode} {
- proc foo {} {string le "abcd\u7266"}
- foo
-} 5
-test stringComp-9.6 {string length, bytearray object} {
- proc foo {} {string length [binary format a5 foo]}
- foo
-} 5
-test stringComp-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 stringComp-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 stringComp-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 stringComp-11.3 {string match} {
- proc foo {} {string match abc abc}
- foo
-} 1
-test stringComp-11.4 {string match} {
- proc foo {} {string mat abc abd}
- foo
-} 0
-test stringComp-11.5 {string match} {
- proc foo {} {string match ab*c abc}
- foo
-} 1
-test stringComp-11.6 {string match} {
- proc foo {} {string match ab**c abc}
- foo
-} 1
-test stringComp-11.7 {string match} {
- proc foo {} {string match ab* abcdef}
- foo
-} 1
-test stringComp-11.8 {string match} {
- proc foo {} {string match *c abc}
- foo
-} 1
-test stringComp-11.9 {string match} {
- proc foo {} {string match *3*6*9 0123456789}
- foo
-} 1
-test stringComp-11.10 {string match} {
- proc foo {} {string match *3*6*9 01234567890}
- foo
-} 0
-test stringComp-11.11 {string match} {
- proc foo {} {string match a?c abc}
- foo
-} 1
-test stringComp-11.12 {string match} {
- proc foo {} {string match a??c abc}
- foo
-} 0
-test stringComp-11.13 {string match} {
- proc foo {} {string match ?1??4???8? 0123456789}
- foo
-} 1
-test stringComp-11.14 {string match} {
- proc foo {} {string match {[abc]bc} abc}
- foo
-} 1
-test stringComp-11.15 {string match} {
- proc foo {} {string match {a[abc]c} abc}
- foo
-} 1
-test stringComp-11.16 {string match} {
- proc foo {} {string match {a[xyz]c} abc}
- foo
-} 0
-test stringComp-11.17 {string match} {
- proc foo {} {string match {12[2-7]45} 12345}
- foo
-} 1
-test stringComp-11.18 {string match} {
- proc foo {} {string match {12[ab2-4cd]45} 12345}
- foo
-} 1
-test stringComp-11.19 {string match} {
- proc foo {} {string match {12[ab2-4cd]45} 12b45}
- foo
-} 1
-test stringComp-11.20 {string match} {
- proc foo {} {string match {12[ab2-4cd]45} 12d45}
- foo
-} 1
-test stringComp-11.21 {string match} {
- proc foo {} {string match {12[ab2-4cd]45} 12145}
- foo
-} 0
-test stringComp-11.22 {string match} {
- proc foo {} {string match {12[ab2-4cd]45} 12545}
- foo
-} 0
-test stringComp-11.23 {string match} {
- proc foo {} {string match {a\*b} a*b}
- foo
-} 1
-test stringComp-11.24 {string match} {
- proc foo {} {string match {a\*b} ab}
- foo
-} 0
-test stringComp-11.25 {string match} {
- proc foo {} {string match {a\*\?\[\]\\\x} "a*?\[\]\\x"}
- foo
-} 1
-test stringComp-11.26 {string match} {
- proc foo {} {string match ** ""}
- foo
-} 1
-test stringComp-11.27 {string match} {
- proc foo {} {string match *. ""}
- foo
-} 0
-test stringComp-11.28 {string match} {
- proc foo {} {string match "" ""}
- foo
-} 1
-test stringComp-11.29 {string match} {
- proc foo {} {string match \[a a}
- foo
-} 1
-test stringComp-11.30 {string match, bad args} {
- proc foo {} {string match - b c}
- list [catch {foo} msg] $msg
-} {1 {bad option "-": must be -nocase}}
-test stringComp-11.31 {string match case} {
- proc foo {} {string match a A}
- foo
-} 0
-test stringComp-11.32 {string match nocase} {
- proc foo {} {string match -n a A}
- foo
-} 1
-test stringComp-11.33 {string match nocase} {
- proc foo {} {string match -nocase a\334 A\374}
- foo
-} 1
-test stringComp-11.34 {string match nocase} {
- proc foo {} {string match -nocase a*f ABCDEf}
- foo
-} 1
-test stringComp-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 stringComp-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 stringComp-11.37 {string match nocase} {
- proc foo {} {string match -nocase {[A-fh-Z]} g}
- foo
-} 0
-test stringComp-11.38 {string match case, reverse range} {
- proc foo {} {string match {[A-fh-Z]} g}
- foo
-} 1
-test stringComp-11.39 {string match, *\ case} {
- proc foo {} {string match {*\abc} abc}
- foo
-} 1
-test stringComp-11.40 {string match, *special case} {
- proc foo {} {string match {*[ab]} abc}
- foo
-} 0
-test stringComp-11.41 {string match, *special case} {
- proc foo {} {string match {*[ab]*} abc}
- foo
-} 1
-test stringComp-11.42 {string match, *special case} {
- proc foo {} {string match "*\\" "\\"}
- foo
-} 0
-test stringComp-11.43 {string match, *special case} {
- proc foo {} {string match "*\\\\" "\\"}
- foo
-} 1
-test stringComp-11.44 {string match, *special case} {
- proc foo {} {string match "*???" "12345"}
- foo
-} 1
-test stringComp-11.45 {string match, *special case} {
- proc foo {} {string match "*???" "12"}
- foo
-} 0
-test stringComp-11.46 {string match, *special case} {
- proc foo {} {string match "*\\*" "abc*"}
- foo
-} 1
-test stringComp-11.47 {string match, *special case} {
- proc foo {} {string match "*\\*" "*"}
- foo
-} 1
-test stringComp-11.48 {string match, *special case} {
- proc foo {} {string match "*\\*" "*abc"}
- foo
-} 0
-test stringComp-11.49 {string match, *special case} {
- proc foo {} {string match "?\\*" "a*"}
- foo
-} 1
-test stringComp-11.50 {string match, *special case} {
- proc foo {} {string match "\\" "\\"}
- foo
-} 0
-test stringComp-11.51 {string match; *, -nocase and UTF-8} {
- proc foo {} {string match -nocase [binary format I 717316707] \
- [binary format I 2028036707]}
- foo
-} 1
-test stringComp-11.52 {string match, null char in string} {
- proc foo {} {
- set ptn "*abc*"
- foreach elem [list "\u0000@abc" "@abc" "\u0000@abc\u0000" "blahabcblah"] {
- lappend out [string match $ptn $elem]
- }
- set out
- }
- foo
-} {1 1 1 1}
-test stringComp-11.53 {string match, null char in pattern} {
- proc foo {} {
- set out ""
- foreach {ptn elem} [list \
- "*\u0000abc\u0000" "\u0000abc\u0000" \
- "*\u0000abc\u0000" "\u0000abc\u0000ef" \
- "*\u0000abc\u0000*" "\u0000abc\u0000ef" \
- "*\u0000abc\u0000" "@\u0000abc\u0000ef" \
- "*\u0000abc\u0000*" "@\u0000abc\u0000ef" \
- ] {
- lappend out [string match $ptn $elem]
- }
- set out
- }
- foo
-} {1 0 1 0 1}
-test stringComp-11.54 {string match, failure} {
- proc foo {} {
- set longString ""
- for {set i 0} {$i < 10} {incr i} {
- append longString "abcdefghijklmnopqrstuvwxy\u0000z01234567890123"
- }
- list [string match *cba* $longString] \
- [string match *a*l*\u0000* $longString] \
- [string match *a*l*\u0000*123 $longString] \
- [string match *a*l*\u0000*123* $longString] \
- [string match *a*l*\u0000*cba* $longString] \
- [string match *===* $longString]
- }
- foo
-} {0 1 1 1 0 0}
-
-## string range
-test stringComp-12.1 {Bug 3588366: end-offsets before start} {
- apply {s {
- string range $s 0 end-5
- }} 12345
-} {}
-
-## string repeat
-## not yet bc
-
-## string replace
-test stringComp-14.1 {Bug 82e7f67325} {
- apply {x {
- set a [join $x {}]
- lappend b [string length [string replace ___! 0 2 $a]]
- lappend b [string length [string replace ___! 0 2 $a[unset a]]]
- }} {a b}
-} {3 3}
-test stringComp-14.2 {Bug 82e7f67325} memory {
- # As in stringComp-14.1, but make sure we don't retain too many refs
- leaktest {
- apply {x {
- set a [join $x {}]
- lappend b [string length [string replace ___! 0 2 $a]]
- lappend b [string length [string replace ___! 0 2 $a[unset a]]]
- }} {a b}
- }
-} {0}
-test stringComp-14.3 {Bug 0dca3bfa8f} {
- apply {arg {
- set argCopy $arg
- set arg [string replace $arg 1 2 aa]
- # Crashes in comparison before fix
- expr {$arg ne $argCopy}
- }} abcde
-} 1
-test stringComp-14.4 {Bug 1af8de570511} {
- apply {{x y} {
- # Generate an unshared string value
- set val ""
- for { set i 0 } { $i < $x } { incr i } {
- set val [format "0%s" $val]
- }
- string replace $val[unset val] 1 1 $y
- }} 4 x
-} 0x00
-test stringComp-14.5 {} {
- string length [string replace [string repeat a\u00fe 2] 3 end {}]
-} 3
-
-## 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
-
-## string cat
-test stringComp-29.1 {string cat, no arg} {
- proc foo {} {string cat}
- foo
-} ""
-test stringComp-29.2 {string cat, single arg} {
- proc foo {} {
- set x FOO
- string compare $x [string cat $x]
- }
- foo
-} 0
-test stringComp-29.3 {string cat, two args} {
- proc foo {} {
- set x FOO
- string compare $x$x [string cat $x $x]
- }
- foo
-} 0
-test stringComp-29.4 {string cat, many args} {
- proc foo {} {
- set x FOO
- set n 260
- set xx [string repeat $x $n]
- set vv [string repeat {$x} $n]
- set vvs [string repeat {$x } $n]
- set r1 [string compare $xx [subst $vv]]
- set r2 [string compare $xx [eval "string cat $vvs"]]
- list $r1 $r2
- }
- foo
-} {0 0}
-
-
-# cleanup
-catch {rename foo {}}
-::tcltest::cleanupTests
-return
-
-# Local Variables:
-# mode: tcl
-# End:
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 8209142..a78b5f8 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -414,10 +414,10 @@ test stringObj-13.3 {Tcl_GetCharLength with byte-size chars} testobj {
list [string length $a] [string length $a]
} {6 6}
test stringObj-13.4 {Tcl_GetCharLength with mixed width chars} testobj {
- string length "\u00ae"
+ string length "\u00ae"
} 1
test stringObj-13.5 {Tcl_GetCharLength with mixed width chars} testobj {
- # string length "○○"
+ # string length "○○"
# Use \uXXXX notation below instead of hardcoding the values, otherwise
# the test will fail in multibyte locales.
string length "\u00EF\u00BF\u00AE\u00EF\u00BF\u00AE"
@@ -480,7 +480,6 @@ test stringObj-15.8 {Tcl_Append*ToObj: self appends} testobj {
teststringobj set 1 foo
teststringobj appendself2 1 3
} foo
-
if {[testConstraint testobj]} {
testobj freeallvars
@@ -489,3 +488,7 @@ if {[testConstraint testobj]} {
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/subst.test b/tests/subst.test
index 2115772..1f3c22a 100644
--- a/tests/subst.test
+++ b/tests/subst.test
@@ -91,29 +91,29 @@ test subst-5.4 {command substitutions} {
} {1 {invalid command name "bogus_command"}}
test subst-5.5 {command substitutions} {
set a 0
- list [catch {subst {[set a 1}} msg] $a $msg
+ 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
+ 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
+ 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
+ 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
+ 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
+ list [catch {exec [info nameofexecutable] << $script} msg] $msg
} {1 {missing close-bracket}}
test subst-6.1 {clear the result after command substitution} -body {
@@ -166,7 +166,7 @@ test subst-8.6 {return in a subst} -returnCodes error -body {
subst "foo \[return {x}; bogus code bar"
} -result {missing close-bracket}
test subst-8.7 {return in a subst, parse error} -body {
- subst {foo [return {x} ; set a {}"" ; stuff] bar}
+ subst {foo [return {x} ; set a {}"" ; stuff] bar}
} -returnCodes error -result {extra characters after close-brace}
test subst-8.8 {return in a subst, parse error} -body {
subst {foo [return {x} ; set bar baz ; set a {}"" ; stuff] bar}
diff --git a/tests/tailcall.test b/tests/tailcall.test
index 3751c35..9174167 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -28,9 +28,9 @@ if {[testConstraint testnrelevels]} {
namespace eval testnre {
#
# [testnrelevels] returns a 6-list with: C-stack depth, iPtr->numlevels,
- # cmdFrame level, callFrame level, tosPtr and callback depth
+ # cmdFrame level, callFrame level, tosPtr and callback depth
#
- variable last [testnrelevels]
+ variable last [testnrelevels]
proc depthDiff {} {
variable last
set depth [testnrelevels]
@@ -148,7 +148,7 @@ test tailcall-0.5 {tailcall is constant space} -constraints testnrelevels -setup
} -result {0 0 0 0 0 0}
test tailcall-0.5.1 {tailcall is constant space} -constraints testnrelevels -setup {
- #
+ #
# This test is related to [bug d87cb182053fd79b3]: the fix to that bug was
# to remove a call to TclSkipTailcall, which caused a violation of the
# constant-space property of tailcall in that particular
@@ -245,7 +245,7 @@ test tailcall-1 {tailcall} -body {
}
variable x *::
proc xset args {error ::xset}
- list [::b::moo] | $x $a::x $b::x | $::b::y
+ list [::b::moo] | $x $a::x $b::x | $::b::y
} -cleanup {
unset x
rename xset {}
@@ -619,7 +619,7 @@ test tailcall-12.3a3 {[Bug 2695587]} -body {
set x
} -cleanup {
unset x
-} -result {0 1}
+} -result {0 1}
test tailcall-12.3b0 {[Bug 2695587]} -body {
apply {{} {
@@ -654,7 +654,7 @@ test tailcall-12.3b3 {[Bug 2695587]} -body {
set x
} -cleanup {
unset x
-} -result {0 1}
+} -result {0 1}
# MORE VARIANTS MISSING: bc'ed caught script vs (bc'ed, not-bc'ed)
# catch. Actually superfluous now, as tailcall just returns TCL_RETURN so that
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
index cfd3ea3..c8759a8 100644
--- a/tests/tcltests.tcl
+++ b/tests/tcltests.tcl
@@ -10,4 +10,4 @@ testConstraint thread [
expr {0 == [catch {package require Thread 2.7-}]}]
testConstraint notValgrind [expr {![testConstraint valgrind]}]
-package provide tcltests 0.1
+package provide tcltests 0.1 \ No newline at end of file
diff --git a/tests/thread.test b/tests/thread.test
index eaaaa41..2524911 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -11,14 +11,17 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2
+ namespace import -force ::tcltest::*
+}
# when thread::release is used, -wait is passed in order allow the thread to
# be fully finalized, which avoids valgrind "still reachable" reports.
-package require tcltests
-
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
# Some tests require the testthread command
diff --git a/tests/trace.test b/tests/trace.test
index d830f3c..1099f48 100644
--- a/tests/trace.test
+++ b/tests/trace.test
@@ -164,30 +164,30 @@ test trace-1.10 {trace variable reads} {
} {}
test trace-1.11 {read traces that modify the array structure} {
unset -nocomplain x
- set x(bar) 0
- trace variable x r {set x(foo) 1 ;#}
- trace variable x r {unset -nocomplain x(bar) ;#}
+ 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} {
unset -nocomplain x
- set x(bar) 0
- trace variable x r {unset -nocomplain x(bar) ;#}
- trace variable x r {set x(foo) 1 ;#}
+ 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} {
unset -nocomplain x
- set x(bar) 0
- trace variable x r {set x(foo) 1 ;#}
- trace variable x r {unset -nocomplain 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} {
unset -nocomplain x
- set x(bar) 0
- trace variable x r {unset -nocomplain x;#}
- trace variable x r {set x(foo) 1 ;#}
+ 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}}
@@ -419,7 +419,7 @@ test trace-5.8 {array traces fire for undefined variables} {
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-6.1 {multiple ops traced at once} {
@@ -767,7 +767,7 @@ test trace-13.1 {delete one trace from another} {
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 delTraces
trace add variable x read {traceTag 5}
set x
set info
@@ -872,7 +872,7 @@ test trace-14.5 {trace command, invalid 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 message styles for their opList options; these loops test those
# error messages.
set i 0
@@ -2104,7 +2104,7 @@ foo foo 0 1 leave}
test trace-28.2 {exec traces with 'error'} {
set info {}
set res {}
-
+
proc foo {} {
if {[catch {bar}]} {
return "error"
@@ -2126,7 +2126,7 @@ test trace-28.2 {exec traces with 'error'} {
trace remove execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
-
+
list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
@@ -2152,7 +2152,7 @@ foo foo 0 error leave}}
test trace-28.3 {exec traces with 'return -code error'} {
set info {}
set res {}
-
+
proc foo {} {
if {[catch {bar}]} {
return "error"
@@ -2174,7 +2174,7 @@ test trace-28.3 {exec traces with 'return -code error'} {
trace remove execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
-
+
list $res [join $info \n]
} {{error error} {foo foo enter
foo {if {[catch {bar}]} {
@@ -2204,7 +2204,7 @@ test trace-28.4 {exec traces in slave with 'return -code error'} {
set res [interp eval slave {
set info {}
set res {}
-
+
proc foo {} {
if {[catch {bar}]} {
return "error"
@@ -2212,21 +2212,21 @@ test trace-28.4 {exec traces in slave with 'return -code error'} {
return "ok"
}
}
-
+
proc bar {} { return -code error "msg" }
-
+
lappend res [foo]
-
+
trace add execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
-
+
# With the trace active
-
+
lappend res [foo]
-
+
trace remove execution foo {enter enterstep leave leavestep} \
[list traceExecute foo]
-
+
list $res
}]
interp delete slave
@@ -2610,7 +2610,7 @@ test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
proc foo {} {
incr ::traceCalls
# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
- # internals
+ # internals
lset ::bar 1 2
}
} -body {
@@ -2631,7 +2631,7 @@ test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
rename dotrace {}
rename foo {}
} -result {3 | 0 1 1}
-
+
test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
set ::traceLog 0
set ::traceCalls 0
@@ -2668,7 +2668,7 @@ test trace-40.1 {execution trace errors become command errors} {
catch foo m
return -level 0 $m[unset m]
} bar
-
+
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
diff --git a/tests/unixFCmd.test b/tests/unixFCmd.test
index 183c145..08eb664 100644
--- a/tests/unixFCmd.test
+++ b/tests/unixFCmd.test
@@ -221,12 +221,12 @@ test unixFCmd-2.5 {TclpCopyFile: copy attributes} -setup {
cleanup
} -constraints {unix notRoot} -body {
close [open tf1 a]
- file attributes tf1 -permissions 0472
+ file attributes tf1 -permissions 0o472
file copy tf1 tf2
file attributes tf2 -permissions
} -cleanup {
cleanup
-} -result 00472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
+} -result 0o472 ;# i.e. perms field of [exec ls -l tf2] is -r--rwx-w-
test unixFCmd-3.1 {CopyFile not done} {emptyTest unix notRoot} {
} {}
@@ -375,11 +375,11 @@ proc permcheck {testnum permList expected} {
set result
} $expected
}
-permcheck unixFCmd-17.5 rwxrwxrwx 00777
-permcheck unixFCmd-17.6 r--r---w- 00442
-permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 00740 00540 00547}
-permcheck unixFCmd-17.11 --x--x--x 00111
-permcheck unixFCmd-17.12 {0 a+rwx} {00000 00777}
+permcheck unixFCmd-17.5 rwxrwxrwx 0o777
+permcheck unixFCmd-17.6 r--r---w- 0o442
+permcheck unixFCmd-17.7 {0 u+rwx,g+r u-w o+rwx} {00000 0o740 0o540 0o547}
+permcheck unixFCmd-17.11 --x--x--x 0o111
+permcheck unixFCmd-17.12 {0 a+rwx} {00000 0o777}
file delete -force -- foo.test
test unixFCmd-18.1 {Unix pwd} -constraints {unix notRoot nonPortable} -setup {
diff --git a/tests/unixForkEvent.test b/tests/unixForkEvent.test
index 120f362..d7b86fd 100644
--- a/tests/unixForkEvent.test
+++ b/tests/unixForkEvent.test
@@ -37,7 +37,7 @@ test unixforkevent-1.1 {fork and test writeable event} \
viewFile result.txt $myFolder
} \
-result {writable} \
- -cleanup {
+ -cleanup {
catch { removeFolder $myFolder }
}
diff --git a/tests/unixInit.test b/tests/unixInit.test
index 681a931..ab00b4e 100644
--- a/tests/unixInit.test
+++ b/tests/unixInit.test
@@ -15,6 +15,9 @@ namespace import ::tcltest::*
unset -nocomplain path
catch {set oldlang $env(LANG)}
set env(LANG) C
+
+# Some tests require the testgetencpath command
+testConstraint testgetencpath [llength [info commands testgetencpath]]
test unixInit-1.1 {TclpInitPlatform: ignore SIGPIPE} {unix stdio} {
set x {}
@@ -87,13 +90,15 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio}
skip [concat [skip] unixInit-2.*]
-test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} {
- set origDir [testgetdefenc]
- testsetdefenc slappy
- set path [testgetdefenc]
- testsetdefenc $origDir
+test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} -constraints {
+ testgetencpath
+} -body {
+ set origPath [testgetencpath]
+ testsetencpath slappy
+ set path [testgetencpath]
+ testsetencpath $origPath
set path
-} {slappy}
+} -result {slappy}
test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup {
unset -nocomplain oldlibrary
if {[info exists env(TCL_LIBRARY)]} {
diff --git a/tests/unixNotfy.test b/tests/unixNotfy.test
index 2f03529..0bd8c69 100644
--- a/tests/unixNotfy.test
+++ b/tests/unixNotfy.test
@@ -18,27 +18,22 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# When run in a Tk shell, these tests hang.
testConstraint noTk [expr {0 != [catch {package present Tk}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
-# Darwin always uses a threaded notifier
-testConstraint unthreaded [expr {
- ![::tcl::pkgconfig get threaded]
- && $tcl_platform(os) ne "Darwin"
-}]
# The next two tests will hang if threads are enabled because the notifier
# will not necessarily wait for ever in this case, so it does not generate
# an error.
-test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
+test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
catch {vwait x}
set f [open [makeFile "" foo] w]
fileevent $f writable {set x 1}
vwait x
close $f
list [catch {vwait x} msg] $msg
-} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
+} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
catch { close $f }
catch { removeFile foo }
}
-test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
+test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
catch {vwait x}
set f1 [open [makeFile "" foo] w]
set f2 [open [makeFile "" foo2] w]
@@ -90,7 +85,7 @@ test unixNotfy-2.2 {Tcl_DeleteFileHandler} \
set x
} \
-result {ok} \
- -cleanup {
+ -cleanup {
catch { close $f1 }
catch { close $f2 }
catch { removeFile foo }
diff --git a/tests/unknown.test b/tests/unknown.test
index e80d3a6..6c31c3d 100644
--- a/tests/unknown.test
+++ b/tests/unknown.test
@@ -58,7 +58,7 @@ test unknown-4.1 {errors in "unknown" procedure} {
catch {rename unknown {}}
catch {rename unknown.old unknown}
cleanupTests
-return
+return
# Local Variables:
# mode: tcl
diff --git a/tests/uplevel.test b/tests/uplevel.test
index 9ecc0d5..be2268a 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -137,27 +137,27 @@ test uplevel-4.15 {level parsing} {
test uplevel-4.16 {level parsing} {
apply {{} {uplevel #[expr 1] {}}}
} {}
-test uplevel-4.17 {level parsing} {
+test uplevel-4.17 {level parsing} -returnCodes error -body {
apply {{} {uplevel -0xffffffff {}}}
-} {}
-test uplevel-4.18 {level parsing} {
+} -result {bad level "-0xffffffff"}
+test uplevel-4.18 {level parsing} -returnCodes error -body {
apply {{} {uplevel #-0xffffffff {}}}
-} {}
-test uplevel-4.19 {level parsing} {
+} -result {bad level "#-0xffffffff"}
+test uplevel-4.19 {level parsing} -returnCodes error -body {
apply {{} {uplevel [expr -0xffffffff] {}}}
-} {}
-test uplevel-4.20 {level parsing} {
+} -result {bad level "-4294967295"}
+test uplevel-4.20 {level parsing} -returnCodes error -body {
apply {{} {uplevel #[expr -0xffffffff] {}}}
-} {}
+} -result {bad level "#-4294967295"}
test uplevel-4.21 {level parsing} -body {
apply {{} {uplevel -1 {}}}
-} -returnCodes error -result {invalid command name "-1"}
+} -returnCodes error -result {bad level "-1"}
test uplevel-4.22 {level parsing} -body {
apply {{} {uplevel #-1 {}}}
} -returnCodes error -result {bad level "#-1"}
test uplevel-4.23 {level parsing} -body {
apply {{} {uplevel [expr -1] {}}}
-} -returnCodes error -result {invalid command name "-1"}
+} -returnCodes error -result {bad level "-1"}
test uplevel-4.24 {level parsing} -body {
apply {{} {uplevel #[expr -1] {}}}
} -returnCodes error -result {bad level "#-1"}
@@ -175,13 +175,13 @@ test uplevel-4.28 {level parsing} -body {
} -returnCodes error -result {bad level "#4294967295"}
test uplevel-4.29 {level parsing} -body {
apply {{} {uplevel 0.2 {}}}
-} -returnCodes error -result {bad level "0.2"}
+} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.30 {level parsing} -body {
apply {{} {uplevel #0.2 {}}}
} -returnCodes error -result {bad level "#0.2"}
test uplevel-4.31 {level parsing} -body {
apply {{} {uplevel [expr 0.2] {}}}
-} -returnCodes error -result {bad level "0.2"}
+} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.32 {level parsing} -body {
apply {{} {uplevel #[expr 0.2] {}}}
} -returnCodes error -result {bad level "#0.2"}
@@ -193,7 +193,7 @@ test uplevel-4.34 {level parsing} -body {
} -returnCodes error -result {bad level "#.2"}
test uplevel-4.35 {level parsing} -body {
apply {{} {uplevel [expr .2] {}}}
-} -returnCodes error -result {bad level "0.2"}
+} -returnCodes error -result {invalid command name "0.2"}
test uplevel-4.36 {level parsing} -body {
apply {{} {uplevel #[expr .2] {}}}
} -returnCodes error -result {bad level "#0.2"}
@@ -237,7 +237,7 @@ test uplevel-7.1 {var access, no LVT in either level} -setup {
unset -nocomplain y z
} -body {
namespace eval foo {
- set x 2
+ set x 2
set y 2
uplevel 1 {
set x 3
@@ -256,7 +256,7 @@ test uplevel-7.2 {var access, no LVT in upper level} -setup {
unset -nocomplain y z
} -body {
proc foo {} {
- set x 2
+ set x 2
set y 2
uplevel 1 {
set x 3
@@ -280,7 +280,7 @@ test uplevel-7.3 {var access, LVT in upper level} -setup {
}
} -body {
proc foo {} {
- set x 2
+ set x 2
set y 2
uplevel 1 {
set x 3
diff --git a/tests/upvar.test b/tests/upvar.test
index 5ea870d..476250c 100644
--- a/tests/upvar.test
+++ b/tests/upvar.test
@@ -477,7 +477,7 @@ test upvar-NS-1.4 {nsupvar links to correct variable} -body {
} -returnCodes error -cleanup {
namespace delete test_ns_1
} -result {namespace "test_ns_0" not found in "::test_ns_1"}
-
+
test upvar-NS-1.5 {nsupvar links to correct variable} -body {
namespace eval test_ns_1 {
namespace eval test_ns_0 {}
diff --git a/tests/utf.test b/tests/utf.test
index 95775a8..8a48191 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -21,7 +21,7 @@ testConstraint testbytestring [llength [info commands testbytestring]]
catch {unset x}
# Some tests require support for 4-byte UTF-8 sequences
-testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
+testConstraint tip389 [expr {[string length \U010000] == 2}]
test utf-1.1 {Tcl_UniCharToUtf: 1 byte sequences} testbytestring {
expr {"\x01" eq [testbytestring "\x01"]}
@@ -41,9 +41,21 @@ test utf-1.5 {Tcl_UniCharToUtf: overflowed Tcl_UniChar} testbytestring {
test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
expr {[format %c -1] eq [testbytestring "\xef\xbf\xbd"]}
} 1
-test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints {fullutf testbytestring} -body {
+test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints testbytestring -body {
expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]}
} -result 1
+test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
+ expr {"\ud842" eq [testbytestring "\xed\xa1\x82"]}
+} 1
+test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
+ expr {"\udc42" eq [testbytestring "\xed\xb1\x82"]}
+} 1
+test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, high surrogate} testbytestring {
+ expr {[format %c 0xd842] eq [testbytestring "\xed\xa1\x82"]}
+} 1
+test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, low surrogate} testbytestring {
+ expr {[format %c 0xdc42] eq [testbytestring "\xed\xb1\x82"]}
+} 1
test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
string length "abc"
@@ -66,10 +78,10 @@ test utf-2.6 {Tcl_UtfToUniChar: lead (3-byte) followed by 1 trail} testbytestrin
test utf-2.7 {Tcl_UtfToUniChar: lead (3-byte) followed by 2 trail} testbytestring {
string length [testbytestring "\xE4\xb9\x8e"]
} {1}
-test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
+test utf-2.8 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body {
string length [testbytestring "\xF0\x90\x80\x80"]
} -result {2}
-test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {fullutf testbytestring} -body {
+test utf-2.9 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail} -constraints {tip389 testbytestring} -body {
string length [testbytestring "\xF4\x8F\xBF\xBF"]
} -result {2}
test utf-2.10 {Tcl_UtfToUniChar: lead (4-byte) followed by 3 trail, underflow} testbytestring {
@@ -146,6 +158,12 @@ test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
string index \u4e4e\u25a\xff\u543 2
} "\uff"
+test utf-8.5 {Tcl_UniCharAtIndex: high surrogate} {
+ string index \ud842 0
+} "\ud842"
+test utf-8.5 {Tcl_UniCharAtIndex: low surrogate} {
+ string index \udc42 0
+} "\udc42"
test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
string range abcd 0 2
@@ -228,15 +246,13 @@ bsCheck \U4e21 20001
bsCheck \U004e21 20001
bsCheck \U00004e21 20001
bsCheck \U0000004e21 78
-if {[testConstraint fullutf]} {
- bsCheck \U00110000 69632
- bsCheck \U01100000 69632
- bsCheck \U11000000 69632
- bsCheck \U0010FFFF 1114111
- bsCheck \U010FFFF0 1114111
- bsCheck \U10FFFF00 1114111
- bsCheck \UFFFFFFFF 1048575
-}
+bsCheck \U00110000 69632
+bsCheck \U01100000 69632
+bsCheck \U11000000 69632
+bsCheck \U0010FFFF 1114111
+bsCheck \U010FFFF0 1114111
+bsCheck \U10FFFF00 1114111
+bsCheck \UFFFFFFFF 1048575
test utf-11.1 {Tcl_UtfToUpper} {
string toupper {}
@@ -250,6 +266,12 @@ test utf-11.3 {Tcl_UtfToUpper} {
test utf-11.4 {Tcl_UtfToUpper} {
string toupper \u01e3ab
} \u01e2AB
+test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
+ string toupper \u10d0\u1c90
+} \u1c90\u1c90
+test utf-11.6 {Tcl_UtfToUpper low/high surrogate)} {
+ string toupper \udc24\ud824
+} \udc24\ud824
test utf-12.1 {Tcl_UtfToLower} {
string tolower {}
@@ -263,6 +285,12 @@ test utf-12.3 {Tcl_UtfToLower} {
test utf-12.4 {Tcl_UtfToLower} {
string tolower \u01e2AB
} \u01e3ab
+test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
+ string tolower \u10d0\u1c90
+} \u10d0\u10d0
+test utf-12.6 {Tcl_UtfToUpper low/high surrogate)} {
+ string tolower \udc24\ud824
+} \udc24\ud824
test utf-13.1 {Tcl_UtfToTitle} {
string totitle {}
@@ -276,6 +304,15 @@ test utf-13.3 {Tcl_UtfToTitle} {
test utf-13.4 {Tcl_UtfToTitle} {
string totitle \u01f3ab
} \u01f2ab
+test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
+ string totitle \u10d0\u1c90
+} \u10d0\u1c90
+test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
+ string totitle \u1c90\u10d0
+} \u1c90\u10d0
+test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
+ string totitle \udc24\ud824
+} \udc24\ud824
test utf-14.1 {Tcl_UtfNcasecmp} {
string compare -nocase a b
diff --git a/tests/util.test b/tests/util.test
index 2ac11bf..5079a89 100644
--- a/tests/util.test
+++ b/tests/util.test
@@ -20,6 +20,7 @@ testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]
+testConstraint testprint [llength [info commands testprint]]
# Big test for correct ordering of data in [expr]
@@ -552,6 +553,12 @@ test util-9.0.6 {TclGetIntForIndex} {
test util-9.0.7 {TclGetIntForIndex} {
string index abcd { 01 }
} b
+test util-9.0.8 {TclGetIntForIndex} {
+ string index abcd { 0d0 }
+} a
+test util-9.0.9 {TclGetIntForIndex} {
+ string index abcd { -0d0 }
+} a
test util-9.1.0 {TclGetIntForIndex} {
string index abcd 3
} d
@@ -564,6 +571,12 @@ test util-9.1.2 {TclGetIntForIndex} {
test util-9.1.3 {TclGetIntForIndex} {
string index abcdefghijk { 0xa }
} k
+test util-9.1.4 {TclGetIntForIndex} {
+ string index abcdefghijk 0d10
+} k
+test util-9.1.5 {TclGetIntForIndex} {
+ string index abcdefghijk { 0d10 }
+} k
test util-9.2.0 {TclGetIntForIndex} {
string index abcd end
} d
@@ -573,14 +586,14 @@ test util-9.2.1 {TclGetIntForIndex} -body {
test util-9.2.2 {TclGetIntForIndex} -body {
string index abcd {end }
} -returnCodes error -match glob -result *
-test util-9.3 {TclGetIntForIndex} {
+test util-9.3 {TclGetIntForIndex} -body {
# Deprecated
string index abcd en
-} d
-test util-9.4 {TclGetIntForIndex} {
+} -returnCodes error -match glob -result *
+test util-9.4 {TclGetIntForIndex} -body {
# Deprecated
string index abcd e
-} d
+} -returnCodes error -match glob -result *
test util-9.5.0 {TclGetIntForIndex} {
string index abcd end-1
} c
@@ -671,12 +684,18 @@ test util-9.30 {TclGetIntForIndex} -body {
test util-9.31 {TclGetIntForIndex} -body {
string index a 0x
} -returnCodes error -match glob -result *
+test util-9.31.1 {TclGetIntForIndex} -body {
+ string index a 0d
+} -returnCodes error -match glob -result *
test util-9.32 {TclGetIntForIndex} -body {
string index a 0x1FFFFFFFF+0
-} -returnCodes error -match glob -result *
+} -result {}
test util-9.33 {TclGetIntForIndex} -body {
string index a 100000000000+0
-} -returnCodes error -match glob -result *
+} -result {}
+test util-9.33.1 {TclGetIntForIndex} -body {
+ string index a 0d100000000000+0
+} -result {}
test util-9.34 {TclGetIntForIndex} -body {
string index a 1.0
} -returnCodes error -match glob -result *
@@ -709,7 +728,50 @@ test util-9.43 {TclGetIntForIndex} -body {
} -returnCodes error -match glob -result *
test util-9.44 {TclGetIntForIndex} -body {
string index a 0+1000000000000
+} -result {}
+test util-9.45 {TclGetIntForIndex} {
+ string index abcd end+2305843009213693950
+} {}
+test util-9.46 {TclGetIntForIndex} {
+ string index abcd end+4294967294
+} {}
+# TIP 502
+test util-9.47 {TclGetIntForIndex} {
+ string index abcd 0x10000000000000000
+} {}
+test util-9.48 {TclGetIntForIndex} {
+ string index abcd -0x10000000000000000
+} {}
+test util-9.49 {TclGetIntForIndex} -body {
+ string index abcd end*1
+} -returnCodes error -match glob -result *
+test util-9.50 {TclGetIntForIndex} -body {
+ string index abcd {end- 1}
+} -returnCodes error -match glob -result *
+test util-9.51 {TclGetIntForIndex} -body {
+ string index abcd end-end
+} -returnCodes error -match glob -result *
+test util-9.52 {TclGetIntForIndex} -body {
+ string index abcd end-x
} -returnCodes error -match glob -result *
+test util-9.53 {TclGetIntForIndex} -body {
+ string index abcd end-0.1
+} -returnCodes error -match glob -result *
+test util-9.54 {TclGetIntForIndex} {
+ string index abcd end-0x10000000000000000
+} {}
+test util-9.55 {TclGetIntForIndex} {
+ string index abcd end+0x10000000000000000
+} {}
+test util-9.56 {TclGetIntForIndex} {
+ string index abcd end--0x10000000000000000
+} {}
+test util-9.57 {TclGetIntForIndex} {
+ string index abcd end+-0x10000000000000000
+} {}
+test util-9.58 {TclGetIntForIndex} {
+ string index abcd end--0x8000000000000000
+} {}
test util-10.1 {Tcl_PrintDouble - rounding} {ieeeFloatingPoint} {
convertDouble 0x0000000000000000
@@ -4017,6 +4079,54 @@ test util-17.1 {bankers' rounding [Bug 3349507]} {ieeeFloatingPoint} {
0x4400000000000000 0xc400000000000000
}]
+test util-18.1 {Tcl_ObjPrintf} {testprint} {
+ testprint %lld [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.2 {Tcl_ObjPrintf} {testprint} {
+ testprint %I64d [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.3 {Tcl_ObjPrintf} {testprint} {
+ testprint %qd [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.4 {Tcl_ObjPrintf} {testprint} {
+ testprint %jd [expr 2**63-1]
+} {9223372036854775807}
+
+test util-18.5 {Tcl_ObjPrintf} {testprint} {
+ testprint %lld [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.6 {Tcl_ObjPrintf} {testprint} {
+ testprint %I64d [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.7 {Tcl_ObjPrintf} {testprint} {
+ testprint %qd [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.8 {Tcl_ObjPrintf} {testprint} {
+ testprint %jd [expr -2**63]
+} {-9223372036854775808}
+
+test util-18.9 {Tcl_ObjPrintf} {testprint} {
+ testprint "%I64d %I32d" [expr -2**63+2]
+} {-9223372036854775806 2}
+
+test util-18.10 {Tcl_ObjPrintf} {testprint} {
+ testprint "%I64d %p" 65535
+} {65535 0xffff}
+
+test util-18.11 {Tcl_ObjPrintf} {testprint} {
+ testprint "%I64d %td" 65536
+} {65536 65536}
+
+test util-18.12 {Tcl_ObjPrintf} {testprint} {
+ testprint "%I64d %Id" 65537
+} {65537 65537}
+
set ::tcl_precision $saved_precision
# cleanup
diff --git a/tests/var.test b/tests/var.test
index 32388a2..a5b91f8 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -41,6 +41,7 @@ if {[testConstraint memory]} {
}
}
+
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {unset xx}
@@ -53,7 +54,7 @@ catch {unset arr}
test var-1.1 {TclLookupVar, Array handling} -setup {
catch {unset a}
} -body {
- set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
+ set x "incr" ;# force no compilation and runtime call to Tcl_IncrCmd
set i 10
set arr(foo) 37
list [$x i] $i [$x arr(foo)] $arr(foo)
@@ -256,7 +257,7 @@ test var-3.3 {MakeUpvar, my var has TCL_GLOBAL_ONLY specified} -setup {
set a 123321
proc p {} {
# create global xx linked to global a
- testupvar 1 a {} xx global
+ testupvar 1 a {} xx global
}
list [p] $xx [set xx 789] $a
} -result {{} 123321 789 789}
@@ -268,7 +269,7 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
catch {unset ::test_ns_var::vv}
proc p {} {
# create namespace var vv linked to global a
- testupvar 1 a {} vv namespace
+ testupvar 1 a {} vv namespace
}
p
}
@@ -570,11 +571,11 @@ test var-7.14 {Tcl_VariableObjCmd, array element parameter} -body {
namespace eval test_ns_var { variable arrayvar(1) }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.15 {Tcl_VariableObjCmd, array element parameter} -body {
- namespace eval test_ns_var {
+ namespace eval test_ns_var {
variable arrayvar
set arrayvar(1) x
variable arrayvar(1) y
- }
+ }
} -returnCodes error -result "can't define \"arrayvar(1)\": name refers to an element in an array"
test var-7.16 {Tcl_VariableObjCmd, no args (TIP 323)} {
variable
@@ -828,7 +829,7 @@ test var-15.1 {segfault in [unset], [Bug 735335]} {
set var $name
}
#
- # Note that the variable name has to be
+ # Note that the variable name has to be
# unused previously for the segfault to
# be triggered.
#
@@ -1016,9 +1017,6 @@ test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
} -result 1
test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
- proc getbytes {} {
- lindex [split [memory info] \n] 3 3
- }
proc doit k {
variable A
set A($k) {}
@@ -1038,13 +1036,9 @@ test var-22.0 {leak in array element unset: Bug a3309d01db} -setup {
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
array unset A
- rename getbytes {}
rename doit {}
} -result 0
test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
- proc getbytes {} {
- lindex [split [memory info] \n] 3 3
- }
proc doit {} {
interp create slave
slave eval {
@@ -1066,15 +1060,431 @@ test var-22.1 {leak in localVarName intrep: Bug 80304238ac} -setup {
set leakedBytes [expr {$end - $tmp}]
} -cleanup {
array unset A
- rename getbytes {}
rename doit {}
} -result 0
+test var-22.2 {leak in parsedVarName} -constraints memory -body {
+ set i 0
+ leaktest {lappend x($i)}
+} -cleanup {
+ unset -nocomplain i x
+} -result 0
+
+unset -nocomplain a k v
+test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
+ array for {k v} c d e {}
+} -result {wrong # args: should be "array for {key value} arrayName script"}
+test var-23.2 {array command, for loop, not enough args} -returnCodes error -body {
+ array for {k v} {}
+} -result {wrong # args: should be "array for {key value} arrayName script"}
+test var-23.3 {array command, for loop, too many list args} -setup {
+ unset -nocomplain a
+} -returnCodes error -body {
+ array for {k v w} a {}
+} -result {must have two variable names}
+test var-23.4 {array command, for loop, not enough list args} -setup {
+ unset -nocomplain a
+} -returnCodes error -body {
+ array for {k} a {}
+} -result {must have two variable names}
+test var-23.5 {array command, for loop, no array} -setup {
+ unset -nocomplain a
+} -returnCodes error -body {
+ array for {k v} a {}
+} -result {"a" isn't an array}
+test var-23.6 {array command, for loop, array doesn't exist yet but has compiler-allocated procedure slot} -setup {
+ catch {rename p ""}
+} -returnCodes error -body {
+ apply {{x} {
+ if {$x==1} {
+ return [array for {k v} a {}]
+ }
+ set a(x) 123
+ }} 1
+} -result {"a" isn't an array}
+test var-23.7 {array enumeration} -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ array set a {a 1 b 2 c 3}
+ array for {k v} a {
+ lappend reslist $k $v
+ }
+ lsort -stride 2 -index 0 $reslist
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {a 1 b 2 c 3}
+test var-23.9 {array enumeration, nested} -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ array set a {a 1 b 2 c 3}
+ array for {k1 v1} a {
+ lappend reslist $k1 $v1
+ set r2 {}
+ array for {k2 v2} a {
+ lappend r2 $k2 $v2
+ }
+ lappend reslist [lsort -stride 2 -index 0 $r2]
+ }
+ # there is no guarantee in which order the array contents will be
+ # returned.
+ lsort -stride 3 -index 0 $reslist
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {a 1 {a 1 b 2 c 3} b 2 {a 1 b 2 c 3} c 3 {a 1 b 2 c 3}}
+test var-23.10 {array enumeration, delete key} -match glob -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ set retval {}
+ try {
+ array set a {a 1 b 2 c 3 d 4}
+ array for {k v} a {
+ lappend reslist $k $v
+ if { $k eq "a" } {
+ unset a(c)
+ }
+ }
+ lsort -stride 2 -index 0 $reslist
+ } on error {err res} {
+ set retval [dict get $res -errorinfo]
+ }
+ set retval
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+ unset -nocomplain retval
+} -result {array changed during iteration*}
+test var-23.11 {array enumeration, insert key} -match glob -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ set retval {}
+ try {
+ array set a {a 1 b 2 c 3 d 4}
+ array for {k v} a {
+ lappend reslist $k $v
+ if { $k eq "a" } {
+ set a(e) 5
+ }
+ }
+ lsort -stride 2 -index 0 $reslist
+ } on error {err res} {
+ set retval [dict get $res -errorinfo]
+ }
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {array changed during iteration*}
+test var-23.12 {array enumeration, change value} -setup {
+ unset -nocomplain a
+ set reslist [list]
+} -body {
+ array set a {a 1 b 2 c 3}
+ array for {k v} a {
+ lappend reslist $k $v
+ if { $k eq "a" } {
+ set a(c) 9
+ }
+ }
+ lsort -stride 2 -index 0 $reslist
+} -cleanup {
+ unset -nocomplain a
+ unset -nocomplain reslist
+} -result {a 1 b 2 c 9}
+test var-23.13 {array enumeration, number of traces} -setup {
+ set ::countarrayfor 0
+ proc ::tracearrayfor { args } {
+ incr ::countarrayfor
+ }
+ unset -nocomplain ::a
+ set reslist [list]
+} -body {
+ array set ::a {a 1 b 2 c 3}
+ foreach {k} [array names a] {
+ trace add variable ::a($k) read ::tracearrayfor
+ }
+ array for {k v} ::a {
+ lappend reslist $k $v
+ }
+ set ::countarrayfor
+} -cleanup {
+ unset -nocomplain ::countarrayfor
+ unset -nocomplain ::a
+ unset -nocomplain reslist
+} -result 3
+test var-23.14 {array for, shared arguments} -setup {
+ set vn {k v}
+ unset -nocomplain $vn
+} -body {
+ array set $vn {a 1 b 2 c 3}
+ array for $vn $vn {}
+} -cleanup {
+ unset -nocomplain $vn vn
+} -result {}
+test var-24.1 {array default set and get: interpreted} -setup {
+ unset -nocomplain ary
+} -body {
+ array set ary {a 3}
+ array default set ary 7
+ list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
+ [array default get ary]
+} -cleanup {
+ unset -nocomplain ary
+} -result {3 7 1 0 7}
+test var-24.2 {array default set and get: compiled} {
+ apply {{} {
+ array set ary {a 3}
+ array default set ary 7
+ list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
+ [array default get ary]
+ }}
+} {3 7 1 0 7}
+test var-24.3 {array default unset: interpreted} -setup {
+ unset -nocomplain ary
+} -body {
+ array set ary {a 3}
+ array default set ary 7
+ list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
+} -cleanup {
+ unset -nocomplain ary
+} -result {3 7 {} 3 1}
+test var-24.4 {array default unset: compiled} {
+ apply {{} {
+ array set ary {a 3}
+ array default set ary 7
+ list $ary(a) $ary(b) [array default unset ary] $ary(a) \
+ [catch {set ary(b)}]
+ }}
+} {3 7 {} 3 1}
+test var-24.5 {array default exists: interpreted} -setup {
+ unset -nocomplain ary result
+ set result {}
+} -body {
+ array set ary {a 3}
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ array default set ary 7
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ array default unset ary
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ unset ary
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ array default set ary 11
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+} -cleanup {
+ unset -nocomplain ary result
+} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
+test var-24.6 {array default exists: compiled} {
+ apply {{} {
+ array set ary {a 3}
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ array default set ary 7
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ array default unset ary
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ unset ary
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ array default set ary 11
+ lappend result [info exists ary],[array exists ary],[array default exists ary]
+ }}
+} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
+test var-24.7 {array default and append: interpreted} -setup {
+ unset -nocomplain ary result
+ set result {}
+} -body {
+ array default set ary grill
+ lappend result [array size ary] [info exist ary(x)]
+ append ary(x) abc
+ lappend result [array size ary] $ary(x)
+ array default unset ary
+ append ary(x) def
+ append ary(y) ghi
+ lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+ unset -nocomplain ary result
+} -result {0 0 1 grillabc 2 grillabcdef ghi}
+test var-24.8 {array default and append: compiled} {
+ apply {{} {
+ array default set ary grill
+ lappend result [array size ary] [info exist ary(x)]
+ append ary(x) abc
+ lappend result [array size ary] $ary(x)
+ array default unset ary
+ append ary(x) def
+ append ary(y) ghi
+ lappend result [array size ary] $ary(x) $ary(y)
+ }}
+} {0 0 1 grillabc 2 grillabcdef ghi}
+test var-24.9 {array default and lappend: interpreted} -setup {
+ unset -nocomplain ary result
+ set result {}
+} -body {
+ array default set ary grill
+ lappend result [array size ary] [info exist ary(x)]
+ lappend ary(x) abc
+ lappend result [array size ary] $ary(x)
+ array default unset ary
+ lappend ary(x) def
+ lappend ary(y) ghi
+ lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+ unset -nocomplain ary result
+} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
+test var-24.10 {array default and lappend: compiled} {
+ apply {{} {
+ array default set ary grill
+ lappend result [array size ary] [info exist ary(x)]
+ lappend ary(x) abc
+ lappend result [array size ary] $ary(x)
+ array default unset ary
+ lappend ary(x) def
+ lappend ary(y) ghi
+ lappend result [array size ary] $ary(x) $ary(y)
+ }}
+} {0 0 1 {grill abc} 2 {grill abc def} ghi}
+test var-24.11 {array default and incr: interpreted} -setup {
+ unset -nocomplain ary result
+ set result {}
+} -body {
+ array default set ary 7
+ lappend result [array size ary] [info exist ary(x)]
+ incr ary(x) 11
+ lappend result [array size ary] $ary(x)
+ array default unset ary
+ incr ary(x)
+ incr ary(y)
+ lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+ unset -nocomplain ary result
+} -result {0 0 1 18 2 19 1}
+test var-24.12 {array default and incr: compiled} {
+ apply {{} {
+ array default set ary 7
+ lappend result [array size ary] [info exist ary(x)]
+ incr ary(x) 11
+ lappend result [array size ary] $ary(x)
+ array default unset ary
+ incr ary(x)
+ incr ary(y)
+ lappend result [array size ary] $ary(x) $ary(y)
+ }}
+} {0 0 1 18 2 19 1}
+test var-24.13 {array default and dict: interpreted} -setup {
+ unset -nocomplain ary x y z
+} -body {
+ array default set ary {x y}
+ dict lappend ary(p) x z
+ dict update ary(q) x y {
+ set y z
+ }
+ dict with ary(r) {
+ set x 123
+ }
+ lsort -stride 2 -index 0 [array get ary]
+} -cleanup {
+ unset -nocomplain ary x y z
+} -result {p {x {y z}} q {x z} r {x 123}}
+test var-24.14 {array default and dict: compiled} {
+ lsort -stride 2 -index 0 [apply {{} {
+ array default set ary {x y}
+ dict lappend ary(p) x z
+ dict update ary(q) x y {
+ set y z
+ }
+ dict with ary(r) {
+ set x 123
+ }
+ array get ary
+ }}]
+} {p {x {y z}} q {x z} r {x 123}}
+test var-24.15 {array default set and get: two-level} {
+ apply {{} {
+ array set ary {a 3}
+ array default set ary 7
+ apply {{} {
+ upvar 1 ary ary ary(c) c
+ lappend result $ary(a) $ary(b) $c
+ lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
+ lappend result [array default get ary]
+ }}
+ }}
+} {3 7 7 1 0 0 7}
+test var-24.16 {array default set: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ set ary not-an-array
+ array default set ary 7
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result {can't array default set "ary": variable isn't array}
+test var-24.17 {array default set: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ array default set ary
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result * -match glob
+test var-24.18 {array default set: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ array default set ary x y
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result * -match glob
+test var-24.19 {array default get: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ set ary not-an-array
+ array default get ary
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.20 {array default get: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ array default get ary x y
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result * -match glob
+test var-24.21 {array default exists: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ set ary not-an-array
+ array default exists ary
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.22 {array default exists: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ array default exists ary x
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result * -match glob
+test var-24.23 {array default unset: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ set ary not-an-array
+ array default unset ary
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.24 {array default unset: errors} -setup {
+ unset -nocomplain ary
+} -body {
+ array default unset ary x
+} -returnCodes error -cleanup {
+ unset -nocomplain ary
+} -result * -match glob
catch {namespace delete ns}
catch {unset arr}
catch {unset v}
+catch {rename getbytes ""}
catch {rename p ""}
catch {namespace delete test_ns_var}
catch {namespace delete test_ns_var2}
diff --git a/tests/winFCmd.test b/tests/winFCmd.test
index 5243eca..a0b7053 100644
--- a/tests/winFCmd.test
+++ b/tests/winFCmd.test
@@ -21,8 +21,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
# Initialise the test constraints
testConstraint winVista 0
-testConstraint win2000orXP 0
-testConstraint winOlderThan2000 0
+testConstraint winXP 0
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile [llength [info commands testfile]]
testConstraint testchmod [llength [info commands testchmod]]
@@ -56,15 +55,11 @@ proc cleanup {args} {
}
}
-if {[testConstraint winOnly]} {
- if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
- if {$::tcl_platform(osVersion) >= 6.0} {
- testConstraint winVista 1
- } else {
- testConstraint win2000orXP 1
- }
+if {[testConstraint win]} {
+ if {$::tcl_platform(osVersion) >= 5.0} {
+ testConstraint winVista 1
} else {
- testConstraint winOlderThan2000 1
+ testConstraint winXP 1
}
}
@@ -204,17 +199,12 @@ test winFCmd-1.12 {TclpRenameFile: errno: EACCES} -setup {
} -returnCodes error -result EACCES
test winFCmd-1.13 {TclpRenameFile: errno: EACCES} -setup {
cleanup
-} -constraints {win win2000orXP testfile} -body {
+} -constraints {win winXP testfile} -body {
testfile mv nul tf1
} -returnCodes error -result EINVAL
-test winFCmd-1.14 {TclpRenameFile: errno: EACCES} -setup {
- cleanup
-} -constraints {win nt winOlderThan2000 testfile} -body {
- testfile mv nul tf1
-} -returnCodes error -result EACCES
test winFCmd-1.15 {TclpRenameFile: errno: EEXIST} -setup {
cleanup
-} -constraints {win nt testfile} -body {
+} -constraints {win testfile} -body {
createfile tf1
testfile mv tf1 nul
} -returnCodes error -result EEXIST
@@ -237,19 +227,12 @@ test winFCmd-1.18 {TclpRenameFile: srcAttr == -1} -setup {
} -returnCodes error -result ENOENT
test winFCmd-1.19 {TclpRenameFile: errno == EACCES} -setup {
cleanup
-} -constraints {win win2000orXP testfile} -body {
+} -constraints {win winXP testfile} -body {
testfile mv nul tf1
} -returnCodes error -result EINVAL
-test winFCmd-1.19.1 {TclpRenameFile: errno == EACCES} -setup {
- cleanup
-} -constraints {win nt winOlderThan2000 testfile} -body {
- testfile mv nul tf1
-} -returnCodes error -result EACCES
test winFCmd-1.20 {TclpRenameFile: src is dir} -setup {
cleanup
-} -constraints {win nt testfile} -body {
- # under 95, this would actually succeed and move the current dir out from
- # under the current process!
+} -constraints {win testfile} -body {
file delete /tf1
testfile mv [pwd] /tf1
} -returnCodes error -result EACCES
@@ -457,14 +440,9 @@ test winFCmd-2.6 {TclpCopyFile: errno: ENOENT} -setup {
} -returnCodes error -result ENOENT
test winFCmd-2.7 {TclpCopyFile: errno: EACCES} -setup {
cleanup
-} -constraints {win win2000orXP testfile} -body {
+} -constraints {win winXP testfile} -body {
testfile cp nul tf1
} -returnCodes error -result EINVAL
-test winFCmd-2.8 {TclpCopyFile: errno: EACCES} -setup {
- cleanup
-} -constraints {win nt winOlderThan2000 testfile} -body {
- testfile cp nul tf1
-} -returnCodes error -result EACCES
test winFCmd-2.10 {TclpCopyFile: CopyFile succeeds} -setup {
cleanup
} -constraints {win testfile} -body {
@@ -622,7 +600,7 @@ test winFCmd-3.11 {TclpDeleteFile: still can't remove path} -setup {
test winFCmd-4.1 {TclpCreateDirectory: errno: EACCES} -body {
testfile mkdir $cdrom/dummy~~.dir
-} -constraints {win nt cdrom testfile} -returnCodes error -result EACCES
+} -constraints {win cdrom testfile} -returnCodes error -result EACCES
test winFCmd-4.3 {TclpCreateDirectory: errno: EEXIST} -setup {
cleanup
} -constraints {win testfile} -body {
@@ -720,7 +698,7 @@ test winFCmd-6.9 {TclpRemoveDirectory: errno == EACCES} -setup {
} -result {td1 EACCES}
test winFCmd-6.11 {TclpRemoveDirectory: attr == -1} -setup {
cleanup
-} -constraints {win nt testfile} -body {
+} -constraints {win testfile} -body {
testfile rmdir /
# WinXP returns EEXIST, WinNT seems to return EACCES. No policy
# decision has been made as to which is correct.
@@ -818,7 +796,7 @@ test winFCmd-7.7 {TraverseWinTree: append \ to source if necessary} -setup {
} -result {tf1}
test winFCmd-7.9 {TraverseWinTree: append \ to source if necessary} -body {
testfile rmdir $cdrom/
-} -constraints {win nt cdrom testfile} -returnCodes error -match glob \
+} -constraints {win cdrom testfile} -returnCodes error -match glob \
-result {* EACCES}
test winFCmd-7.10 {TraverseWinTree: can't read directory: handle == INVALID} \
{win emptyTest} {
@@ -856,7 +834,7 @@ test winFCmd-7.13 {TraverseWinTree: append \ to target if necessary} -setup {
} -result {tf1}
test winFCmd-7.15 {TraverseWinTree: append \ to target if necessary} -setup {
cleanup
-} -constraints {win nt testfile} -body {
+} -constraints {win testfile} -body {
file mkdir td1
testfile cpdir td1 /
} -cleanup {
@@ -1071,7 +1049,7 @@ test winFCmd-12.5 {ConvertFileNameFormat: absolute path} -body {
} -constraints {win} -result {/ /}
test winFCmd-12.6 {ConvertFileNameFormat: absolute path with drive} -setup {
catch {file delete -force -- c:/td1}
-} -constraints {win win2000orXP} -body {
+} -constraints {win winXP} -body {
createfile c:/td1 {}
string tolower [file attributes c:/td1 -longname]
} -cleanup {
@@ -1358,13 +1336,13 @@ test winFCmd-18.8 {Windows reserved path names} -constraints win -body {
file normalize cOm1:
} -result COM1
-test winFCmd-19.1 {Windows extended path names} -constraints nt -body {
+test winFCmd-19.1 {Windows extended path names} -constraints win -body {
file normalize //?/c:/windows/win.ini
} -result //?/c:/windows/win.ini
-test winFCmd-19.2 {Windows extended path names} -constraints nt -body {
+test winFCmd-19.2 {Windows extended path names} -constraints win -body {
file normalize //?/c:/windows/../windows/win.ini
} -result //?/c:/windows/win.ini
-test winFCmd-19.3 {Windows extended path names} -constraints nt -setup {
+test winFCmd-19.3 {Windows extended path names} -constraints win -setup {
set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
set tmpfile [file normalize $tmpfile]
} -body {
@@ -1375,7 +1353,7 @@ test winFCmd-19.3 {Windows extended path names} -constraints nt -setup {
} -cleanup {
catch {file delete $tmpfile}
} -result [list 0 {}]
-test winFCmd-19.4 {Windows extended path names} -constraints nt -setup {
+test winFCmd-19.4 {Windows extended path names} -constraints win -setup {
set tmpfile [file join $::env(TEMP) tcl[string repeat x 20].tmp]
set tmpfile //?/[file normalize $tmpfile]
} -body {
@@ -1386,7 +1364,7 @@ test winFCmd-19.4 {Windows extended path names} -constraints nt -setup {
} -cleanup {
catch {file delete $tmpfile}
} -result [list 0 {}]
-test winFCmd-19.5 {Windows extended path names} -constraints nt -setup {
+test winFCmd-19.5 {Windows extended path names} -constraints win -setup {
set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
set tmpfile [file normalize $tmpfile]
} -body {
@@ -1397,7 +1375,7 @@ test winFCmd-19.5 {Windows extended path names} -constraints nt -setup {
} -cleanup {
catch {file delete $tmpfile}
} -result [list 0 {}]
-test winFCmd-19.6 {Windows extended path names} -constraints nt -setup {
+test winFCmd-19.6 {Windows extended path names} -constraints win -setup {
set tmpfile [file join $::env(TEMP) tcl[string repeat x 248].tmp]
set tmpfile //?/[file normalize $tmpfile]
} -body {
@@ -1408,7 +1386,7 @@ test winFCmd-19.6 {Windows extended path names} -constraints nt -setup {
} -cleanup {
catch {file delete $tmpfile}
} -result [list 0 {}]
-test winFCmd-19.7 {Windows extended path names} -constraints nt -setup {
+test winFCmd-19.7 {Windows extended path names} -constraints win -setup {
set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
set tmpfile [file normalize $tmpfile]
} -body {
@@ -1419,7 +1397,7 @@ test winFCmd-19.7 {Windows extended path names} -constraints nt -setup {
} -cleanup {
catch {file delete $tmpfile}
} -result [list 0 {} [list tcl[pid].tmp]]
-test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
+test winFCmd-19.8 {Windows extended path names} -constraints win -setup {
set tmpfile [file join $::env(TEMP) "tcl[pid].tmp "]
set tmpfile //?/[file normalize $tmpfile]
} -body {
@@ -1431,7 +1409,7 @@ test winFCmd-19.8 {Windows extended path names} -constraints nt -setup {
catch {file delete $tmpfile}
} -result [list 0 {} [list "tcl[pid].tmp "]]
-test winFCmd-19.9 {Windows devices path names} -constraints nt -body {
+test winFCmd-19.9 {Windows devices path names} -constraints win -body {
file normalize //./com1
} -result //./com1
diff --git a/tests/winFile.test b/tests/winFile.test
index eb6addd..b288063 100644
--- a/tests/winFile.test
+++ b/tests/winFile.test
@@ -21,23 +21,19 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0
-testConstraint win2000 0
if {[testConstraint testvolumetype]} {
testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}
-if {[testConstraint nt] && $::tcl_platform(osVersion) >= 5.0} {
- testConstraint win2000 1
-}
test winFile-1.1 {TclpGetUserHome} -constraints {win} -body {
glob ~nosuchuser
} -returnCodes error -result {user "nosuchuser" doesn't exist}
-test winFile-1.2 {TclpGetUserHome} -constraints {win nt nonPortable} -body {
+test winFile-1.2 {TclpGetUserHome} -constraints {win nonPortable} -body {
# The administrator account should always exist.
glob ~administrator
} -match glob -result *
-test winFile-1.4 {TclpGetUserHome} {win nt nonPortable} {
+test winFile-1.4 {TclpGetUserHome} {win nonPortable} {
catch {glob ~stanton@workgroup}
} {0}
@@ -155,7 +151,7 @@ if {[testConstraint win]} {
test winFile-4.0 {
Enhanced NTFS user/group permissions: test no acccess
} -constraints {
- win nt notNTFS win2000
+ win notNTFS
} -setup {
set owner [getuser $fname]
set user $::env(USERDOMAIN)\\$::env(USERNAME)
@@ -170,7 +166,7 @@ test winFile-4.0 {
test winFile-4.1 {
Enhanced NTFS user/group permissions: test readable only
} -constraints {
- win nt notNTFS
+ win notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
@@ -181,7 +177,7 @@ test winFile-4.1 {
test winFile-4.2 {
Enhanced NTFS user/group permissions: test writable only
} -constraints {
- win nt notNTFS
+ win notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
@@ -193,7 +189,7 @@ test winFile-4.2 {
test winFile-4.3 {
Enhanced NTFS user/group permissions: test read+write
} -constraints {
- win nt notNTFS
+ win notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
@@ -206,7 +202,7 @@ test winFile-4.3 {
test winFile-4.4 {
Enhanced NTFS user/group permissions: test full access
} -constraints {
- win nt notNTFS
+ win notNTFS
} -setup {
set user $::env(USERDOMAIN)\\$::env(USERNAME)
} -body {
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 06bd67e..7e01c5f 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -39,7 +39,7 @@ testConstraint slowTest 0
set big bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb\n
append big $big
-append big $big
+append big $big
append big $big
append big $big
append big $big
@@ -79,11 +79,11 @@ test winpipe-1.2 {32 bit comprehensive tests: from big file} {win 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} {win nt exec cat32} {
+test winpipe-1.3 {32 bit comprehensive tests: a little from pipe} {win exec cat32} {
exec [interpreter] $path(more) < $path(little) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} {little stderr32}
-test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win nt exec cat32} {
+test winpipe-1.4 {32 bit comprehensive tests: a lot from pipe} {win exec cat32} {
exec [interpreter] $path(more) < $path(big) | $cat32 > $path(stdout) 2> $path(stderr)
list [contents $path(stdout)] [contents $path(stderr)]
} "{$big} stderr32"
@@ -176,7 +176,7 @@ test winpipe-1.21 {32 bit comprehensive tests: read/write application} \
set r
} "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
-test winpipe-4.1 {Tcl_WaitPid} {win nt exec cat32} {
+test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {
proc readResults {f} {
global x result
if { [eof $f] } {
diff --git a/tests/zipfs.test b/tests/zipfs.test
new file mode 100644
index 0000000..782d032
--- /dev/null
+++ b/tests/zipfs.test
@@ -0,0 +1,284 @@
+# The file tests the tclZlib.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
+#
+# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+ package require tcltest 2.1
+ namespace import -force ::tcltest::*
+}
+
+testConstraint zipfs [expr {
+ [llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]
+}]
+testConstraint zipfslib 1
+
+# Removed in tip430 - zipfs is no longer a static package
+#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
+# load {} zipfs
+#} -result {}
+
+set ziproot [zipfs root]
+set CWD [pwd]
+set tmpdir [file join $CWD tmp]
+file mkdir $tmpdir
+
+test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
+ package require zipfs
+} -result {2.0}
+test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
+ expr {${ziproot} in [file volumes]}
+} -result 1
+
+if {![string match ${ziproot}* $tcl_library]} {
+ ###
+ # "make test" does not map tcl_library from the dynamic library on Unix
+ #
+ # Hack the environment to pretend we did pull tcl_library from a zip
+ # archive
+ ###
+ set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]]
+ testConstraint zipfslib [file exists $tclzip]
+ if {[testConstraint zipfslib]} {
+ zipfs mount /lib/tcl $tclzip
+ set ::tcl_library ${ziproot}lib/tcl/tcl_library
+ }
+}
+
+test zipfs-0.2 {zipfs basics} -constraints zipfslib -body {
+ string match ${ziproot}* $tcl_library
+} -result 1
+test zipfs-0.3 {zipfs basics: glob} -constraints zipfslib -setup {
+ set pwd [pwd]
+} -body {
+ cd $tcl_library
+ expr { [file join . http] in [glob -dir . http*] }
+} -cleanup {
+ cd $pwd
+} -result 1
+test zipfs-0.4 {zipfs basics: glob} -constraints zipfslib -setup {
+ set pwd [pwd]
+} -body {
+ cd $tcl_library
+ expr { [file join $tcl_library http] in [glob -dir [pwd] http*] }
+} -cleanup {
+ cd $pwd
+} -result 1
+test zipfs-0.5 {zipfs basics: glob} -constraints zipfslib -body {
+ expr { [file join $tcl_library http] in [glob -dir $tcl_library http*] }
+} -result 1
+test zipfs-0.6 {zipfs basics: glob} -constraints zipfslib -body {
+ expr { [file join $tcl_library http] in [glob [file join $tcl_library http*]] }
+} -result 1
+test zipfs-0.7 {zipfs basics: glob} -constraints zipfslib -body {
+ expr { "http" in [glob -tails -dir $tcl_library http*] }
+} -result 1
+test zipfs-0.8 {zipfs basics: glob} -constraints zipfslib -body {
+ expr { "http" in [glob -nocomplain -tails -types d -dir $tcl_library http*] }
+} -result 1
+test zipfs-0.9 {zipfs basics: glob} -constraints zipfslib -body {
+ glob -nocomplain -tails -types f -dir $tcl_library http*
+} -result {}
+test zipfs-0.10 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
+ file join [zipfs root] bar baz
+} -result "[zipfs root]bar/baz"
+test zipfs-0.11 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
+ file normalize [zipfs root]
+} -result "[zipfs root]"
+test zipfs-0.12 {zipfs basics: join} -constraints {zipfs zipfslib} -body {
+ file normalize [zipfs root]//bar/baz//qux/../
+} -result "[zipfs root]bar/baz"
+
+test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs mount a b c d e f
+} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
+test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs unmount a b c d e f
+} -result {wrong # args: should be "zipfs unmount zipfile"}
+test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs mkkey a b c d e f
+} -result {wrong # args: should be "zipfs mkkey password"}
+test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs mkimg a b c d e f
+} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
+test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs mkzip a b c d e f
+} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
+test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs exists a b c d e f
+} -result {wrong # args: should be "zipfs exists filename"}
+test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs info a b c d e f
+} -result {wrong # args: should be "zipfs info filename"}
+test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
+ zipfs list a b c d e f
+} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}
+
+file mkdir tmp
+test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
+ zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx
+} -result {empty archive}
+###
+# The next series of tests operate within a zipfile created a temporary
+# directory.
+###
+set zipfile [file join $tmpdir abc.zip]
+if {[file exists $zipfile]} {
+ file delete $zipfile
+}
+test zipfs-2.2 {zipfs mkzip} -constraints zipfs -body {
+ cd $tcl_library/encoding
+ zipfs mkzip $zipfile .
+ zipfs mount ${ziproot}abc $zipfile
+ zipfs list -glob ${ziproot}abc/cp850.*
+} -cleanup {
+ cd $CWD
+} -result "[zipfs root]abc/cp850.enc"
+testConstraint zipfsenc [zipfs exists /abc/cp850.enc]
+test zipfs-2.3 {zipfs info} -constraints {zipfs zipfsenc} -body {
+ set r [zipfs info ${ziproot}abc/cp850.enc]
+ lrange $r 0 2
+} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable
+test zipfs-2.4 {zipfs data} -constraints {zipfs zipfsenc} -body {
+ set zipfd [open ${ziproot}/abc/cp850.enc] ;# FIXME: leave open - see later test
+ read $zipfd
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+} ;# FIXME: result depends on content of encodings dir
+test zipfs-2.5 {zipfs exists} -constraints {zipfs zipfsenc} -body {
+ zipfs exists /abc/cp850.enc
+} -result 1
+test zipfs-2.6 {zipfs unmount while busy} -constraints {zipfs zipfsenc} -body {
+ zipfs unmount /abc
+} -returnCodes error -result {filesystem is busy}
+test zipfs-2.7 {zipfs unmount} -constraints {zipfs zipfsenc} -body {
+ close $zipfd
+ zipfs unmount /abc
+ zipfs exists /abc/cp850.enc
+} -result 0
+###
+# Repeat the tests for a buffer mounted archive
+###
+test zipfs-2.8 {zipfs mkzip} -constraints zipfs -body {
+ cd $tcl_library/encoding
+ zipfs mkzip $zipfile .
+ set fin [open $zipfile r]
+ fconfigure $fin -translation binary
+ set dat [read $fin]
+ close $fin
+ zipfs mount_data def $dat
+ zipfs list -glob ${ziproot}def/cp850.*
+} -cleanup {
+ cd $CWD
+} -result "[zipfs root]def/cp850.enc"
+testConstraint zipfsencbuf [zipfs exists /def/cp850.enc]
+test zipfs-2.9 {zipfs info} -constraints {zipfs zipfsencbuf} -body {
+ set r [zipfs info ${ziproot}def/cp850.enc]
+ lrange $r 0 2
+} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable
+test zipfs-2.10 {zipfs data} -constraints {zipfs zipfsencbuf} -body {
+ set zipfd [open ${ziproot}/def/cp850.enc] ;# FIXME: leave open - see later test
+ read $zipfd
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+} ;# FIXME: result depends on content of encodings dir
+test zipfs-2.11 {zipfs exists} -constraints {zipfs zipfsencbuf} -body {
+ zipfs exists /def/cp850.enc
+} -result 1
+test zipfs-2.12 {zipfs unmount while busy} -constraints {zipfs zipfsencbuf} -body {
+ zipfs unmount /def
+} -returnCodes error -result {filesystem is busy}
+test zipfs-2.13 {zipfs unmount} -constraints {zipfs zipfsencbuf} -body {
+ close $zipfd
+ zipfs unmount /def
+ zipfs exists /def/cp850.enc
+} -result 0
+
+catch {file delete -force $tmpdir}
+
+test zipfs-3.1 {zipfs in child interpreters} -constraints zipfs -setup {
+ set interp [interp create]
+} -body {
+ interp eval $interp {
+ zipfs ?
+ }
+} -returnCodes error -cleanup {
+ interp delete $interp
+} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
+test zipfs-3.2 {zipfs in child interpreters} -constraints zipfs -setup {
+ set interp [interp create]
+} -body {
+ interp eval $interp {
+ zipfs mkzip
+ }
+} -returnCodes error -cleanup {
+ interp delete $interp
+} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
+test zipfs-3.3 {zipfs in child interpreters} -constraints zipfs -setup {
+ set safe [interp create -safe]
+} -body {
+ interp eval $safe {
+ zipfs ?
+ }
+} -returnCodes error -cleanup {
+ interp delete $safe
+} -result {unknown or ambiguous subcommand "?": must be canonical, exists, find, info, list, lmkimg, lmkzip, mkimg, mkkey, mkzip, mount, mount_data, root, or unmount}
+test zipfs-3.4 {zipfs in child interpreters} -constraints zipfs -setup {
+ set safe [interp create -safe]
+} -body {
+ interp eval $safe {
+ zipfs mkzip
+ }
+} -returnCodes error -cleanup {
+ interp delete $safe
+} -result {not allowed to invoke subcommand mkzip of zipfs}
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tools/configure b/tools/configure
index 3d30039..5903cc8 100755
--- a/tools/configure
+++ b/tools/configure
@@ -1,81 +1,458 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59.
+# Generated by GNU Autoconf 2.69.
+#
+#
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+#
#
-# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
-DUALCASE=1; export DUALCASE # for MKS sh
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
else
- as_unset=false
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
+ else
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
+ fi
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
fi
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Use a proper internal environment variable to ensure we don't fall
+ # into an infinite loop, continuously re-executing ourselves.
+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+ _as_can_reexec=no; export _as_can_reexec;
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+ fi
+ # We don't want this to propagate to other subprocesses.
+ { _as_can_reexec=; unset _as_can_reexec;}
+if test "x$CONFIG_SHELL" = x; then
+ as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+ emulate sh
+ NULLCMD=:
+ # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '\${1+\"\$@\"}'='\"\$@\"'
+ setopt NO_GLOB_SUBST
+else
+ case \`(set -o) 2>/dev/null\` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
+fi
+"
+ as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+ exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
+ as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+ as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+ eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"
+ if (eval "$as_required") 2>/dev/null; then :
+ as_have_required=yes
+else
+ as_have_required=no
+fi
+ if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ as_found=:
+ case $as_dir in #(
+ /*)
+ for as_base in sh bash ksh sh5; do
+ # Try only shells that exist, to save several forks.
+ as_shell=$as_dir/$as_base
+ if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ CONFIG_SHELL=$as_shell as_have_required=yes
+ if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ break 2
+fi
+fi
+ done;;
+ esac
+ as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+ CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+ if test "x$CONFIG_SHELL" != x; then :
+ export CONFIG_SHELL
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
+fi
+
+ if test x$as_have_required = xno; then :
+ $as_echo "$0: This script requires a shell more modern than all"
+ $as_echo "$0: the shells that I found on your system."
+ if test x${ZSH_VERSION+set} = xset ; then
+ $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+ $as_echo "$0: be upgraded to zsh 4.3.4 or later."
else
- $as_unset $as_var
+ $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
+$0: including any error possibly output before this
+$0: message. Then install a modern shell, or manually run
+$0: the script under such a shell if you do have one."
fi
-done
+ exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$1; test $as_status -eq 0 && as_status=1
+ if test "$4"; then
+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+ fi
+ $as_echo "$as_me: error: $2" >&2
+ as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-
-# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -83,146 +460,91 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
+ as_lineno_1=$LINENO as_lineno_1a=$LINENO
+ as_lineno_2=$LINENO as_lineno_2a=$LINENO
+ eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+ test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+ # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)
+ sed -n '
+ p
+ /[$]LINENO/=
+ ' <$as_myself |
sed '
+ s/[$]LINENO.*/&-/
+ t lineno
+ b
+ :lineno
N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ :loop
+ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
+ s/-\n.*//
' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
- { (exit 1); exit 1; }; }
+ chmod +x "$as_me.lineno" ||
+ { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+ # already done that, so ensure we don't try to do so again and fall
+ # in an infinite loop. This has already happened in practice.
+ _as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
+ # original and so on. Autoconf is especially sensitive to this).
+ . "./$as_me.lineno"
# Exit status is that of the last command.
exit
}
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+ case `echo 'xy\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
else
- as_expr=false
+ rm -f conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -pR'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -pR'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
+ as_ln_s='cp -pR'
fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-as_executable_p="test -f"
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -231,38 +553,25 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
# Name of the host.
-# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
-exec 6>&1
-
#
# Initializations.
#
ac_default_prefix=/usr/local
+ac_clean_files=
ac_config_libobj_dir=.
+LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
-
-# Maximum number of lines to put in a shell here document.
-# This variable seems obsolete. It should probably be removed, and
-# only ac_max_sed_lines should be used.
-: ${ac_max_here_lines=38}
# Identity of this package.
PACKAGE_NAME=
@@ -270,14 +579,70 @@ PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
+PACKAGE_URL=
ac_unique_file="man2tcl.c"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS TCL_WIN_VERSION CC TCL_VERSION TCL_PATCH_LEVEL TCL_SRC_DIR TCL_BIN_DIR LIBOBJS LTLIBOBJS'
+ac_subst_vars='LTLIBOBJS
+LIBOBJS
+TCL_BIN_DIR
+TCL_SRC_DIR
+TCL_PATCH_LEVEL
+TCL_VERSION
+CC
+TCL_WIN_VERSION
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL'
ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+with_tcl
+'
+ ac_precious_vars='build_alias
+host_alias
+target_alias'
+
# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
@@ -300,34 +665,49 @@ x_libraries=NONE
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
-datadir='${prefix}/share'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
+docdir='${datarootdir}/doc/${PACKAGE}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
ac_prev=
+ac_dashdash=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
- eval "$ac_prev=\$ac_option"
+ eval $ac_prev=\$ac_option
ac_prev=
continue
fi
- ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+ case $ac_option in
+ *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+ *=) ac_optarg= ;;
+ *) ac_optarg=yes ;;
+ esac
# Accept the important Cygnus configure options, so we can diagnose typos.
- case $ac_option in
+ case $ac_dashdash$ac_option in
+ --)
+ ac_dashdash=yes ;;
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
@@ -349,33 +729,59 @@ do
--config-cache | -C)
cache_file=config.cache ;;
- -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ -datadir | --datadir | --datadi | --datad)
ac_prev=datadir ;;
- -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
- | --da=*)
+ -datadir=* | --datadir=* | --datadi=* | --datad=*)
datadir=$ac_optarg ;;
+ -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+ | --dataroo | --dataro | --datar)
+ ac_prev=datarootdir ;;
+ -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+ datarootdir=$ac_optarg ;;
+
-disable-* | --disable-*)
- ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- eval "enable_$ac_feature=no" ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval enable_$ac_useropt=no ;;
+
+ -docdir | --docdir | --docdi | --doc | --do)
+ ac_prev=docdir ;;
+ -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+ docdir=$ac_optarg ;;
+
+ -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+ ac_prev=dvidir ;;
+ -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+ dvidir=$ac_optarg ;;
-enable-* | --enable-*)
- ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
esac
- eval "enable_$ac_feature='$ac_optarg'" ;;
+ eval enable_$ac_useropt=\$ac_optarg ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -402,6 +808,12 @@ do
-host=* | --host=* | --hos=* | --ho=*)
host_alias=$ac_optarg ;;
+ -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+ ac_prev=htmldir ;;
+ -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+ | --ht=*)
+ htmldir=$ac_optarg ;;
+
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
@@ -426,13 +838,16 @@ do
| --libexe=* | --libex=* | --libe=*)
libexecdir=$ac_optarg ;;
+ -localedir | --localedir | --localedi | --localed | --locale)
+ ac_prev=localedir ;;
+ -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+ localedir=$ac_optarg ;;
+
-localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst \
- | --locals | --local | --loca | --loc | --lo)
+ | --localstate | --localstat | --localsta | --localst | --locals)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* \
- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
@@ -497,6 +912,16 @@ do
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
+ -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+ ac_prev=pdfdir ;;
+ -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+ pdfdir=$ac_optarg ;;
+
+ -psdir | --psdir | --psdi | --psd | --ps)
+ ac_prev=psdir ;;
+ -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+ psdir=$ac_optarg ;;
+
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
@@ -547,26 +972,36 @@ do
ac_init_version=: ;;
-with-* | --with-*)
- ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
esac
- eval "with_$ac_package='$ac_optarg'" ;;
+ eval with_$ac_useropt=\$ac_optarg ;;
-without-* | --without-*)
- ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/-/_/g'`
- eval "with_$ac_package=no" ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval with_$ac_useropt=no ;;
--x)
# Obsolete; use --with-x.
@@ -586,27 +1021,26 @@ do
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries=$ac_optarg ;;
- -*) { echo "$as_me: error: unrecognized option: $ac_option
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; }
+ -*) as_fn_error $? "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information"
;;
*=*)
ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
# Reject names that are not valid shell variable names.
- expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
- { (exit 1); exit 1; }; }
- ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
- eval "$ac_envvar='$ac_optarg'"
+ case $ac_envvar in #(
+ '' | [0-9]* | *[!_$as_cr_alnum]* )
+ as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
+ esac
+ eval $ac_envvar=\$ac_optarg
export $ac_envvar ;;
*)
# FIXME: should be removed in autoconf 3.0.
- echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- echo "$as_me: WARNING: invalid host type: $ac_option" >&2
- : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
;;
esac
@@ -614,31 +1048,36 @@ done
if test -n "$ac_prev"; then
ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- { echo "$as_me: error: missing argument to $ac_option" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error $? "missing argument to $ac_option"
fi
-# Be sure to have absolute paths.
-for ac_var in exec_prefix prefix
-do
- eval ac_val=$`echo $ac_var`
- case $ac_val in
- [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+if test -n "$ac_unrecognized_opts"; then
+ case $enable_option_checking in
+ no) ;;
+ fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
+ *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
esac
-done
+fi
-# Be sure to have absolute paths.
-for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
- localstatedir libdir includedir oldincludedir infodir mandir
+# Check all directory arguments for consistency.
+for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
+ datadir sysconfdir sharedstatedir localstatedir includedir \
+ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+ libdir localedir mandir
do
- eval ac_val=$`echo $ac_var`
+ eval ac_val=\$$ac_var
+ # Remove trailing slashes.
+ case $ac_val in
+ */ )
+ ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+ eval $ac_var=\$ac_val;;
+ esac
+ # Be sure to have absolute directory names.
case $ac_val in
- [\\/$]* | ?:[\\/]* ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+ [\\/$]* | ?:[\\/]* ) continue;;
+ NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
esac
+ as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done
# There might be people who depend on the old broken behavior: `$host'
@@ -652,8 +1091,6 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used." >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@@ -665,54 +1102,72 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias-
test "$silent" = yes && exec 6>/dev/null
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+ as_fn_error $? "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+ as_fn_error $? "pwd does not report name of working directory"
+
+
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
- # Try the directory containing this script, then its parent.
- ac_confdir=`(dirname "$0") 2>/dev/null ||
-$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$0" : 'X\(//\)[^/]' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$0" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ # Try the directory containing this script, then the parent directory.
+ ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_myself" : 'X\(//\)[^/]' \| \
+ X"$as_myself" : 'X\(//\)$' \| \
+ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
srcdir=$ac_confdir
- if test ! -r $srcdir/$ac_unique_file; then
+ if test ! -r "$srcdir/$ac_unique_file"; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
- { (exit 1); exit 1; }; }
- else
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
- { (exit 1); exit 1; }; }
- fi
+if test ! -r "$srcdir/$ac_unique_file"; then
+ test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+ as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
+ pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+ srcdir=.
fi
-(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
- { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
- { (exit 1); exit 1; }; }
-srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
-ac_env_build_alias_set=${build_alias+set}
-ac_env_build_alias_value=$build_alias
-ac_cv_env_build_alias_set=${build_alias+set}
-ac_cv_env_build_alias_value=$build_alias
-ac_env_host_alias_set=${host_alias+set}
-ac_env_host_alias_value=$host_alias
-ac_cv_env_host_alias_set=${host_alias+set}
-ac_cv_env_host_alias_value=$host_alias
-ac_env_target_alias_set=${target_alias+set}
-ac_env_target_alias_value=$target_alias
-ac_cv_env_target_alias_set=${target_alias+set}
-ac_cv_env_target_alias_value=$target_alias
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+ eval ac_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_env_${ac_var}_value=\$${ac_var}
+ eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
#
# Report the --help message.
@@ -735,20 +1190,17 @@ Configuration:
--help=short display options specific to this package
--help=recursive display the short help of all the included packages
-V, --version display version information and exit
- -q, --quiet, --silent do not print \`checking...' messages
+ -q, --quiet, --silent do not print \`checking ...' messages
--cache-file=FILE cache test results in FILE [disabled]
-C, --config-cache alias for \`--cache-file=config.cache'
-n, --no-create do not create output files
--srcdir=DIR find the sources in DIR [configure dir or \`..']
-_ACEOF
-
- cat <<_ACEOF
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
+ [$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
+ [PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
@@ -758,18 +1210,25 @@ for instance \`--prefix=\$HOME'.
For better control, use the options below.
Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --datadir=DIR read-only architecture-independent data [PREFIX/share]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --infodir=DIR info documentation [PREFIX/info]
- --mandir=DIR man documentation [PREFIX/man]
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
+ --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
+ --infodir=DIR info documentation [DATAROOTDIR/info]
+ --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
+ --mandir=DIR man documentation [DATAROOTDIR/man]
+ --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE]
+ --htmldir=DIR html documentation [DOCDIR]
+ --dvidir=DIR dvi documentation [DOCDIR]
+ --pdfdir=DIR pdf documentation [DOCDIR]
+ --psdir=DIR ps documentation [DOCDIR]
_ACEOF
cat <<\_ACEOF
@@ -785,119 +1244,93 @@ Optional Packages:
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-tcl=DIR use Tcl $DEF_VER binaries from DIR
+Report bugs to the package provider.
_ACEOF
+ac_status=$?
fi
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
- ac_popdir=`pwd`
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d $ac_dir || continue
+ test -d "$ac_dir" ||
+ { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+ continue
ac_builddir=.
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
- cd $ac_dir
- # Check for guested configure; otherwise get Cygnus style configure.
- if test -f $ac_srcdir/configure.gnu; then
- echo
- $SHELL $ac_srcdir/configure.gnu --help=recursive
- elif test -f $ac_srcdir/configure; then
- echo
- $SHELL $ac_srcdir/configure --help=recursive
- elif test -f $ac_srcdir/configure.ac ||
- test -f $ac_srcdir/configure.in; then
- echo
- $ac_configure --help
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+ cd "$ac_dir" || { ac_status=$?; continue; }
+ # Check for guested configure.
+ if test -f "$ac_srcdir/configure.gnu"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+ elif test -f "$ac_srcdir/configure"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure" --help=recursive
else
- echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
- fi
- cd $ac_popdir
+ $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi || ac_status=$?
+ cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
-test -n "$ac_init_help" && exit 0
+test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
+configure
+generated by GNU Autoconf 2.69
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
- exit 0
+ exit
fi
-exec 5>config.log
-cat >&5 <<_ACEOF
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
_ACEOF
+exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
@@ -916,7 +1349,7 @@ uname -v = `(uname -v) 2>/dev/null || echo unknown`
/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
-hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`
/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
@@ -928,8 +1361,9 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- echo "PATH: $as_dir"
-done
+ $as_echo "PATH: $as_dir"
+ done
+IFS=$as_save_IFS
} >&5
@@ -951,7 +1385,6 @@ _ACEOF
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
-ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
@@ -962,13 +1395,13 @@ do
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
continue ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*)
+ ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
- 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
2)
- ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ as_fn_append ac_configure_args1 " '$ac_arg'"
if test $ac_must_keep_next = true; then
ac_must_keep_next=false # Got value, back to normal.
else
@@ -984,104 +1417,115 @@ do
-* ) ac_must_keep_next=true ;;
esac
fi
- ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
- # Get rid of the leading space.
- ac_sep=" "
+ as_fn_append ac_configure_args " '$ac_arg'"
;;
esac
done
done
-$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
-$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
# would cause problems or look ugly.
-# WARNING: Be sure not to use single quotes in there, as some shells,
-# such as our DU 5.0 friend, will then `close' the trap.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
# Save into config.log some information that might help in debugging.
{
echo
- cat <<\_ASBOX
-## ---------------- ##
+ $as_echo "## ---------------- ##
## Cache variables. ##
-## ---------------- ##
-_ASBOX
+## ---------------- ##"
echo
# The following way of writing the cache mishandles newlines in values,
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
+ esac ;;
+ esac
+ done
(set) 2>&1 |
- case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
+ case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
sed -n \
- "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
- ;;
+ "s/'\''/'\''\\\\'\'''\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+ ;; #(
*)
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-}
+ esac |
+ sort
+)
echo
- cat <<\_ASBOX
-## ----------------- ##
+ $as_echo "## ----------------- ##
## Output variables. ##
-## ----------------- ##
-_ASBOX
+## ----------------- ##"
echo
for ac_var in $ac_subst_vars
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
if test -n "$ac_subst_files"; then
- cat <<\_ASBOX
-## ------------- ##
-## Output files. ##
-## ------------- ##
-_ASBOX
+ $as_echo "## ------------------- ##
+## File substitutions. ##
+## ------------------- ##"
echo
for ac_var in $ac_subst_files
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
fi
if test -s confdefs.h; then
- cat <<\_ASBOX
-## ----------- ##
+ $as_echo "## ----------- ##
## confdefs.h. ##
-## ----------- ##
-_ASBOX
+## ----------- ##"
echo
- sed "/^$/d" confdefs.h | sort
+ cat confdefs.h
echo
fi
test "$ac_signal" != 0 &&
- echo "$as_me: caught signal $ac_signal"
- echo "$as_me: exit $exit_status"
+ $as_echo "$as_me: caught signal $ac_signal"
+ $as_echo "$as_me: exit $exit_status"
} >&5
- rm -f core *.core &&
- rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ rm -f core *.core core.conftest.* &&
+ rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
- ' 0
+' 0
for ac_signal in 1 2 13 15; do
- trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+ trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo >confdefs.h
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
# Predefined preprocessor variables.
@@ -1089,112 +1533,137 @@ cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
# Let the site file select an alternate cache file if it wants to.
-# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+ # We do not want a PATH search for config.site.
+ case $CONFIG_SITE in #((
+ -*) ac_site_file1=./$CONFIG_SITE;;
+ */*) ac_site_file1=$CONFIG_SITE;;
+ *) ac_site_file1=./$CONFIG_SITE;;
+ esac
+elif test "x$prefix" != xNONE; then
+ ac_site_file1=$prefix/share/config.site
+ ac_site_file2=$prefix/etc/config.site
+else
+ ac_site_file1=$ac_default_prefix/share/config.site
+ ac_site_file2=$ac_default_prefix/etc/config.site
fi
-for ac_site_file in $CONFIG_SITE; do
- if test -r "$ac_site_file"; then
- { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
-echo "$as_me: loading site script $ac_site_file" >&6;}
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+ test "x$ac_site_file" = xNONE && continue
+ if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
sed 's/^/| /' "$ac_site_file" >&5
- . "$ac_site_file"
+ . "$ac_site_file" \
+ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "failed to load site script $ac_site_file
+See \`config.log' for more details" "$LINENO" 5; }
fi
done
if test -r "$cache_file"; then
- # Some versions of bash will fail to source /dev/null (special
- # files actually), so we avoid doing that.
- if test -f "$cache_file"; then
- { echo "$as_me:$LINENO: loading cache $cache_file" >&5
-echo "$as_me: loading cache $cache_file" >&6;}
+ # Some versions of bash will fail to source /dev/null (special files
+ # actually), so we avoid doing that. DJGPP emulates it as a regular file.
+ if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
- [\\/]* | ?:[\\/]* ) . $cache_file;;
- *) . ./$cache_file;;
+ [\\/]* | ?:[\\/]* ) . "$cache_file";;
+ *) . "./$cache_file";;
esac
fi
else
- { echo "$as_me:$LINENO: creating cache $cache_file" >&5
-echo "$as_me: creating cache $cache_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
-for ac_var in `(set) 2>&1 |
- sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+for ac_var in $ac_precious_vars; do
eval ac_old_set=\$ac_cv_env_${ac_var}_set
eval ac_new_set=\$ac_env_${ac_var}_set
- eval ac_old_val="\$ac_cv_env_${ac_var}_value"
- eval ac_new_val="\$ac_env_${ac_var}_value"
+ eval ac_old_val=\$ac_cv_env_${ac_var}_value
+ eval ac_new_val=\$ac_env_${ac_var}_value
case $ac_old_set,$ac_new_set in
set,)
- { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
ac_cache_corrupted=: ;;
,set)
- { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
ac_cache_corrupted=: ;;
,);;
*)
if test "x$ac_old_val" != "x$ac_new_val"; then
- { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
-echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
- { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
-echo "$as_me: former value: $ac_old_val" >&2;}
- { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
-echo "$as_me: current value: $ac_new_val" >&2;}
- ac_cache_corrupted=:
+ # differences in whitespace do not lead to failure.
+ ac_old_val_w=`echo x $ac_old_val`
+ ac_new_val_w=`echo x $ac_new_val`
+ if test "$ac_old_val_w" != "$ac_new_val_w"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ ac_cache_corrupted=:
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+ eval $ac_var=\$ac_old_val
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5
+$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5
+$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}
fi;;
esac
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
*" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
- *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) as_fn_append ac_configure_args " '$ac_arg'" ;;
esac
fi
done
if $ac_cache_corrupted; then
- { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
-echo "$as_me: error: changes in the environment can compromise the build" >&2;}
- { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
-echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
- { (exit 1); exit 1; }; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -1205,23 +1674,6 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# Recover information that Tcl computed with its configure script.
#--------------------------------------------------------------------
@@ -1229,25 +1681,21 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
-DEF_VER=8.6
+DEF_VER=8.7
-# Check whether --with-tcl or --without-tcl was given.
-if test "${with_tcl+set}" = set; then
- withval="$with_tcl"
- TCL_BIN_DIR=$withval
+# Check whether --with-tcl was given.
+if test "${with_tcl+set}" = set; then :
+ withval=$with_tcl; TCL_BIN_DIR=$withval
else
TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`
-fi;
+fi
+
if test ! -d $TCL_BIN_DIR; then
- { { echo "$as_me:$LINENO: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&5
-echo "$as_me: error: Tcl directory $TCL_BIN_DIR doesn't exist" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error $? "Tcl directory $TCL_BIN_DIR doesn't exist" "$LINENO" 5
fi
if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
- { { echo "$as_me:$LINENO: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&5
-echo "$as_me: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error $? "There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" "$LINENO" 5
fi
. $TCL_BIN_DIR/tclConfig.sh
@@ -1261,7 +1709,8 @@ CC=$TCL_CC
- ac_config_files="$ac_config_files Makefile tcl.hpj"
+ac_config_files="$ac_config_files Makefile tcl.hpj"
+
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
@@ -1280,39 +1729,70 @@ _ACEOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
+# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
+ esac ;;
+ esac
+ done
+
(set) 2>&1 |
- case `(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 \).
+ case $as_nl`(ac_space=' '; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
+ # `set' does not quote correctly, so add quotes: double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \.
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
- ;;
+ ;; #(
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-} |
+ esac |
+ sort
+) |
sed '
+ /^ac_cv_env_/b end
t clear
- : clear
+ :clear
s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
t end
- /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
- : end' >>confcache
-if diff $cache_file confcache >/dev/null 2>&1; then :; else
- if test -w $cache_file; then
- test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
- cat confcache >$cache_file
+ s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+ if test -w "$cache_file"; then
+ if test "x$cache_file" != "x/dev/null"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+ if test ! -f "$cache_file" || test -h "$cache_file"; then
+ cat confcache >"$cache_file"
+ else
+ case $cache_file in #(
+ */* | ?:*)
+ mv -f confcache "$cache_file"$$ &&
+ mv -f "$cache_file"$$ "$cache_file" ;; #(
+ *)
+ mv -f confcache "$cache_file" ;;
+ esac
+ fi
+ fi
else
- echo "not updating unwritable cache $cache_file"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
fi
fi
rm -f confcache
@@ -1321,63 +1801,55 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-# VPATH may cause trouble with some makes, so we remove $(srcdir),
-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
-# trailing colons and then remove the whole line if VPATH becomes empty
-# (actually we leave an empty line to preserve line numbers).
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=/{
-s/:*\$(srcdir):*/:/;
-s/:*\${srcdir}:*/:/;
-s/:*@srcdir@:*/:/;
-s/^\([^=]*=[ ]*\):*/\1/;
-s/:*$//;
-s/^[^=]*=[ ]*$//;
-}'
-fi
-
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
-# take arguments), then we branch to the quote section. Otherwise,
+# take arguments), then branch to the quote section. Otherwise,
# look for a macro that doesn't take arguments.
-cat >confdef2opt.sed <<\_ACEOF
+ac_script='
+:mline
+/\\$/{
+ N
+ s,\\\n,,
+ b mline
+}
t clear
-: clear
-s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+:clear
+s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g
t quote
-s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g
t quote
-d
-: quote
-s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
-s,\[,\\&,g
-s,\],\\&,g
-s,\$,$$,g
-p
-_ACEOF
-# We use echo to avoid assuming a particular line-breaking character.
-# The extra dot is to prevent the shell from consuming trailing
-# line-breaks from the sub-command output. A line-break within
-# single-quotes doesn't work because, if this script is created in a
-# platform that uses two characters for line-breaks (e.g., DOS), tr
-# would break.
-ac_LF_and_DOT=`echo; echo .`
-DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
-rm -f confdef2opt.sed
+b any
+:quote
+s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g
+s/\[/\\&/g
+s/\]/\\&/g
+s/\$/$$/g
+H
+:any
+${
+ g
+ s/^\n//
+ s/\n/ /g
+ p
+}
+'
+DEFS=`sed -n "$ac_script" confdefs.h`
ac_libobjs=
ac_ltlibobjs=
+U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
# 1. Remove the extension, and $U if already installed.
- ac_i=`echo "$ac_i" |
- sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
- # 2. Add them.
- ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
- ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+ ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+ ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+ # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
+ # will be set to the directory where LIBOBJS objects are built.
+ as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+ as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs
@@ -1385,12 +1857,14 @@ LTLIBOBJS=$ac_ltlibobjs
-: ${CONFIG_STATUS=./config.status}
+: "${CONFIG_STATUS=./config.status}"
+ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
-{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
-echo "$as_me: creating $CONFIG_STATUS" >&6;}
-cat >$CONFIG_STATUS <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
@@ -1400,81 +1874,253 @@ cat >$CONFIG_STATUS <<_ACEOF
debug=false
ac_cs_recheck=false
ac_cs_silent=false
-SHELL=\${CONFIG_SHELL-$SHELL}
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
-DUALCASE=1; export DUALCASE # for MKS sh
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
else
- as_unset=false
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
+ else
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
+ fi
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
fi
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
+fi
+
+
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
+fi
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- $as_unset $as_var
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$1; test $as_status -eq 0 && as_status=1
+ if test "$4"; then
+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
fi
-done
+ $as_echo "$as_me: error: $2" >&2
+ as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -1482,148 +2128,111 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
- sed '
- N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
- t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
- ' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
- # Exit status is that of the last command.
- exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+ case `echo 'xy\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
else
- as_expr=false
+ rm -f conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -pR'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -pR'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
+ as_ln_s='cp -pR'
fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-as_executable_p="test -f"
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -1632,31 +2241,20 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
exec 6>&1
-
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling. Logging --version etc. is OK.
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
+# values after options handling.
+ac_log="
This file was extended by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -1664,124 +2262,116 @@ generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_COMMANDS = $CONFIG_COMMANDS
$ $0 $@
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
_ACEOF
-# Files that config.status was made for.
-if test -n "$ac_config_files"; then
- echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
-fi
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
-if test -n "$ac_config_headers"; then
- echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
-fi
-if test -n "$ac_config_links"; then
- echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
-fi
-if test -n "$ac_config_commands"; then
- echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
-fi
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_files="$ac_config_files"
-cat >>$CONFIG_STATUS <<\_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration. Unless the files
+and actions are specified as TAGs, all are instantiated by default.
-Usage: $0 [OPTIONS] [FILE]...
+Usage: $0 [OPTION]... [TAG]...
-h, --help print this help, then exit
- -V, --version print version number, then exit
- -q, --quiet do not print progress messages
+ -V, --version print version number and configuration settings, then exit
+ --config print configuration, then exit
+ -q, --quiet, --silent
+ do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
Configuration files:
$config_files
-Report bugs to <bug-autoconf@gnu.org>."
-_ACEOF
+Report bugs to the package provider."
-cat >>$CONFIG_STATUS <<_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
-configured by $0, generated by GNU Autoconf 2.59,
- with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+configured by $0, generated by GNU Autoconf 2.69,
+ with options \\"\$ac_cs_config\\"
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
-srcdir=$srcdir
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-# If no file are specified by the user, then we need to provide default
-# value. By we need to know if files were specified by the user.
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
case $1 in
- --*=*)
- ac_option=`expr "x$1" : 'x\([^=]*\)='`
- ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ --*=?*)
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
+ ac_shift=:
+ ;;
+ --*=)
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=
ac_shift=:
;;
- -*)
+ *)
ac_option=$1
ac_optarg=$2
ac_shift=shift
;;
- *) # This is not an option, so the user has probably given explicit
- # arguments.
- ac_option=$1
- ac_need_defaults=false;;
esac
case $ac_option in
# Handling of the options.
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
- --version | --vers* | -V )
- echo "$ac_cs_version"; exit 0 ;;
- --he | --h)
- # Conflict between --help and --header
- { { echo "$as_me:$LINENO: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; };;
- --help | --hel | -h )
- echo "$ac_cs_usage"; exit 0 ;;
- --debug | --d* | -d )
+ --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+ $as_echo "$ac_cs_version"; exit ;;
+ --config | --confi | --conf | --con | --co | --c )
+ $as_echo "$ac_cs_config"; exit ;;
+ --debug | --debu | --deb | --de | --d | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
- CONFIG_FILES="$CONFIG_FILES $ac_optarg"
- ac_need_defaults=false;;
- --header | --heade | --head | --hea )
- $ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ case $ac_optarg in
+ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ '') as_fn_error $? "missing file argument" ;;
+ esac
+ as_fn_append CONFIG_FILES " '$ac_optarg'"
ac_need_defaults=false;;
+ --he | --h | --help | --hel | -h )
+ $as_echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
- -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; } ;;
+ -*) as_fn_error $? "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
- *) ac_config_targets="$ac_config_targets $1" ;;
+ *) as_fn_append ac_config_targets " $1"
+ ac_need_defaults=false ;;
esac
shift
@@ -1795,31 +2385,45 @@ if $ac_cs_silent; then
fi
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
- exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ shift
+ \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+ CONFIG_SHELL='$SHELL'
+ export CONFIG_SHELL
+ exec "\$@"
fi
_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+ $as_echo "$ac_log"
+} >&5
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-
-
-cat >>$CONFIG_STATUS <<\_ACEOF
+# Handling of arguments.
for ac_config_target in $ac_config_targets
do
- case "$ac_config_target" in
- # Handling of arguments.
- "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
- "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
- *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
- { (exit 1); exit 1; }; };;
+ case $ac_config_target in
+ "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
+
+ *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
esac
done
+
# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used. Set only those that are not.
# We use the long form for the default assignment because of an extremely
@@ -1829,323 +2433,414 @@ if $ac_need_defaults; then
fi
# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
+# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
- trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
- trap '{ (exit 1); exit 1; }' 1 2 13 15
+ tmp= ac_tmp=
+ trap 'exit_status=$?
+ : "${ac_tmp:=$tmp}"
+ { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
+' 0
+ trap 'as_fn_exit 1' 1 2 13 15
}
-
# Create a (secure) tmp directory for tmp files.
{
- tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
- test -n "$tmp" && test -d "$tmp"
+ tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+ test -d "$tmp"
} ||
{
- tmp=./confstat$$-$RANDOM
- (umask 077 && mkdir $tmp)
-} ||
+ tmp=./conf$$-$RANDOM
+ (umask 077 && mkdir "$tmp")
+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
+ac_tmp=$tmp
+
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
+if test -n "$CONFIG_FILES"; then
+
+
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+ eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+ ac_cs_awk_cr='\\r'
+else
+ ac_cs_awk_cr=$ac_cr
+fi
+
+echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
+_ACEOF
+
+
{
- echo "$me: cannot create a temporary directory in ." >&2
- { (exit 1); exit 1; }
+ echo "cat >conf$$subs.awk <<_ACEOF" &&
+ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+ echo "_ACEOF"
+} >conf$$subs.sh ||
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+ . ./conf$$subs.sh ||
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+
+ ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+ if test $ac_delim_n = $ac_delim_num; then
+ break
+ elif $ac_last_try; then
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ else
+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+ fi
+done
+rm -f conf$$subs.sh
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' <conf$$subs.awk | sed '
+/^[^""]/{
+ N
+ s/\n//
+}
+' >>$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
+ for (key in S) S_is_set[key] = 1
+ FS = ""
+
+}
+{
+ line = $ 0
+ nfields = split(line, field, "@")
+ substed = 0
+ len = length(field[1])
+ for (i = 2; i < nfields; i++) {
+ key = field[i]
+ keylen = length(key)
+ if (S_is_set[key]) {
+ value = S[key]
+ line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+ len += length(value) + length(field[++i])
+ substed = 1
+ } else
+ len += 1 + keylen
+ }
+
+ print line
}
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+ cat
+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
+ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{
+h
+s///
+s/^/:/
+s/[ ]*$/:/
+s/:\$(srcdir):/:/g
+s/:\${srcdir}:/:/g
+s/:@srcdir@:/:/g
+s/^:*//
+s/:*$//
+x
+s/\(=[ ]*\).*/\1/
+G
+s/\n//
+s/^[^=]*=[ ]*$//
+}'
+fi
-#
-# CONFIG_FILES section.
-#
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+fi # test -n "$CONFIG_FILES"
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "\$CONFIG_FILES"; then
- # Protect against being on the right side of a sed subst in config.status.
- sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
- s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
-s,@SHELL@,$SHELL,;t t
-s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
-s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
-s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
-s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
-s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
-s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
-s,@exec_prefix@,$exec_prefix,;t t
-s,@prefix@,$prefix,;t t
-s,@program_transform_name@,$program_transform_name,;t t
-s,@bindir@,$bindir,;t t
-s,@sbindir@,$sbindir,;t t
-s,@libexecdir@,$libexecdir,;t t
-s,@datadir@,$datadir,;t t
-s,@sysconfdir@,$sysconfdir,;t t
-s,@sharedstatedir@,$sharedstatedir,;t t
-s,@localstatedir@,$localstatedir,;t t
-s,@libdir@,$libdir,;t t
-s,@includedir@,$includedir,;t t
-s,@oldincludedir@,$oldincludedir,;t t
-s,@infodir@,$infodir,;t t
-s,@mandir@,$mandir,;t t
-s,@build_alias@,$build_alias,;t t
-s,@host_alias@,$host_alias,;t t
-s,@target_alias@,$target_alias,;t t
-s,@DEFS@,$DEFS,;t t
-s,@ECHO_C@,$ECHO_C,;t t
-s,@ECHO_N@,$ECHO_N,;t t
-s,@ECHO_T@,$ECHO_T,;t t
-s,@LIBS@,$LIBS,;t t
-s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t
-s,@CC@,$CC,;t t
-s,@TCL_VERSION@,$TCL_VERSION,;t t
-s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
-s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
-s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t
-s,@LIBOBJS@,$LIBOBJS,;t t
-s,@LTLIBOBJS@,$LTLIBOBJS,;t t
-CEOF
-_ACEOF
+eval set X " :F $CONFIG_FILES "
+shift
+for ac_tag
+do
+ case $ac_tag in
+ :[FHLC]) ac_mode=$ac_tag; continue;;
+ esac
+ case $ac_mode$ac_tag in
+ :[FHL]*:*);;
+ :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
+ :[FH]-) ac_tag=-:-;;
+ :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+ esac
+ ac_save_IFS=$IFS
+ IFS=:
+ set x $ac_tag
+ IFS=$ac_save_IFS
+ shift
+ ac_file=$1
+ shift
- cat >>$CONFIG_STATUS <<\_ACEOF
- # Split the substitutions into bite-sized pieces for seds with
- # small command number limits, like on Digital OSF/1 and HP-UX.
- ac_max_sed_lines=48
- ac_sed_frag=1 # Number of current file.
- ac_beg=1 # First line for current file.
- ac_end=$ac_max_sed_lines # Line after last line for current file.
- ac_more_lines=:
- ac_sed_cmds=
- while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- else
- sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- fi
- if test ! -s $tmp/subs.frag; then
- ac_more_lines=false
- else
- # The purpose of the label and of the branching condition is to
- # speed up the sed processing (if there are no `@' at all, there
- # is no need to browse any of the substitutions).
- # These are the two extra sed commands mentioned above.
- (echo ':t
- /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
- fi
- ac_sed_frag=`expr $ac_sed_frag + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_lines`
+ case $ac_mode in
+ :L) ac_source=$1;;
+ :[FH])
+ ac_file_inputs=
+ for ac_f
+ do
+ case $ac_f in
+ -) ac_f="$ac_tmp/stdin";;
+ *) # Look for the file first in the build tree, then in the source tree
+ # (if the path is not absolute). The absolute path cannot be DOS-style,
+ # because $ac_f cannot contain `:'.
+ test -f "$ac_f" ||
+ case $ac_f in
+ [\\/$]*) false;;
+ *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+ esac ||
+ as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+ esac
+ case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+ as_fn_append ac_file_inputs " '$ac_f'"
+ done
+
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ configure_input='Generated from '`
+ $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+ `' by configure.'
+ if test x"$ac_file" != x-; then
+ configure_input="$ac_file. $configure_input"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
fi
- done
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
- fi
-fi # test -n "$CONFIG_FILES"
+ # Neutralize special characters interpreted by sed in replacement strings.
+ case $configure_input in #(
+ *\&* | *\|* | *\\* )
+ ac_sed_conf_input=`$as_echo "$configure_input" |
+ sed 's/[\\\\&|]/\\\\&/g'`;; #(
+ *) ac_sed_conf_input=$configure_input;;
+ esac
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
+ case $ac_tag in
+ *:-:* | *:-) cat >"$ac_tmp/stdin" \
+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
+ esac
+ ;;
esac
- # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+ ac_dir=`$as_dirname -- "$ac_file" ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
+ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ as_dir="$ac_dir"; as_fn_mkdir_p
ac_builddir=.
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
+ case $ac_mode in
+ :F)
+ #
+ # CONFIG_FILE
+ #
+_ACEOF
- if test x"$ac_file" != x-; then
- { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
- rm -f "$ac_file"
- fi
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- configure_input=
- else
- configure_input="$ac_file. "
- fi
- configure_input=$configure_input"Generated from `echo $ac_file_in |
- sed 's,.*/,,'` by configure."
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+ac_sed_dataroot='
+/datarootdir/ {
+ p
+ q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ ac_datarootdir_hack='
+ s&@datadir@&$datadir&g
+ s&@docdir@&$docdir&g
+ s&@infodir@&$infodir&g
+ s&@localedir@&$localedir&g
+ s&@mandir@&$mandir&g
+ s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
- sed "$ac_vpsub
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s,@configure_input@,$configure_input,;t t
-s,@srcdir@,$ac_srcdir,;t t
-s,@abs_srcdir@,$ac_abs_srcdir,;t t
-s,@top_srcdir@,$ac_top_srcdir,;t t
-s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s,@builddir@,$ac_builddir,;t t
-s,@abs_builddir@,$ac_abs_builddir,;t t
-s,@top_builddir@,$ac_top_builddir,;t t
-s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
- rm -f $tmp/stdin
- if test x"$ac_file" != x-; then
- mv $tmp/out $ac_file
- else
- cat $tmp/out
- rm -f $tmp/out
- fi
+s|@configure_input@|$ac_sed_conf_input|;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+$ac_datarootdir_hack
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
+ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+ { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
+ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \
+ "$ac_tmp/out"`; test -z "$ac_out"; } &&
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined" >&5
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined" >&2;}
+
+ rm -f "$ac_tmp/stdin"
+ case $ac_file in
+ -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
+ *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
+ esac \
+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+ ;;
-done
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-{ (exit 0); exit 0; }
+ esac
+
+done # for ac_tag
+
+
+as_fn_exit 0
_ACEOF
-chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save
+test $ac_write_fail = 0 ||
+ as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
@@ -2165,6 +2860,10 @@ if test "$no_create" != yes; then
exec 5>>config.log
# Use ||, not &&, to avoid exiting from the if with $? = 1, which
# would make configure fail if this is the last instruction.
- $ac_cs_success || { (exit 1); exit 1; }
+ $ac_cs_success || as_fn_exit 1
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
diff --git a/tools/configure.in b/tools/configure.ac
index 6aebcaa..3caa141 100644
--- a/tools/configure.in
+++ b/tools/configure.ac
@@ -2,7 +2,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run to configure the
dnl Makefile in this directory.
AC_INIT(man2tcl.c)
-AC_PREREQ(2.59)
+AC_PREREQ(2.69)
# Recover information that Tcl computed with its configure script.
@@ -11,7 +11,7 @@ AC_PREREQ(2.59)
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
-DEF_VER=8.6
+DEF_VER=8.7
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
diff --git a/tools/encoding/ebcdic.txt b/tools/encoding/ebcdic.txt
index d9fa42e..d9fa42e 100644..100755
--- a/tools/encoding/ebcdic.txt
+++ b/tools/encoding/ebcdic.txt
diff --git a/tools/encoding/tis-620.txt b/tools/encoding/tis-620.txt
index d3656c5..d3656c5 100644..100755
--- a/tools/encoding/tis-620.txt
+++ b/tools/encoding/tis-620.txt
diff --git a/tools/fix_tommath_h.tcl b/tools/fix_tommath_h.tcl
index 04bf857..cee29fa 100755
--- a/tools/fix_tommath_h.tcl
+++ b/tools/fix_tommath_h.tcl
@@ -22,7 +22,6 @@ foreach line [split $data \n] {
{#define BN_H_} {
puts $line
puts {}
- puts "\#include \"tclInt.h\""
puts "\#include \"tclTomMathDecls.h\""
puts "\#ifndef MODULE_SCOPE"
puts "\#define MODULE_SCOPE extern"
@@ -46,6 +45,12 @@ foreach line [split $data \n] {
puts "\#define MP_DIGIT_DECLARED"
puts "\#endif"
}
+ {typedef.*mp_word;} {
+ puts "\#ifndef MP_WORD_DECLARED"
+ puts $line
+ puts "\#define MP_WORD_DECLARED"
+ puts "\#endif"
+ }
{typedef struct} {
puts "\#ifndef MP_INT_DECLARED"
puts "\#define MP_INT_DECLARED"
@@ -73,10 +78,6 @@ foreach line [split $data \n] {
puts "\#if 0 /* these are macros in tclTomMathDecls.h */"
set eat_endif 1
}
- {__x86_64__} {
- puts "[string map {__x86_64__ NEVER} $line]\
- /* 128-bit ints fail in too many places */"
- }
{#include} {
# remove all includes
}
diff --git a/tools/installVfs.tcl b/tools/installVfs.tcl
new file mode 100644
index 0000000..ad1f5c7
--- /dev/null
+++ b/tools/installVfs.tcl
@@ -0,0 +1,54 @@
+#!/bin/sh
+#\
+exec tclsh "$0" ${1+"$@"}
+
+#----------------------------------------------------------------------
+#
+# installVfs.tcl --
+#
+# This file wraps the /library file system around a binary
+#
+#----------------------------------------------------------------------
+#
+# Copyright (c) 2018 by Sean Woods. All rights reserved.
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#----------------------------------------------------------------------
+
+proc mapDir {resultvar prefix filepath} {
+ upvar 1 $resultvar result
+ if {![info exists result]} {
+ set result {}
+ }
+ set queue [list $prefix $filepath]
+ while {[llength $queue]} {
+ set queue [lassign $queue qprefix qpath]
+ foreach ftail [glob -directory $qpath -nocomplain -tails *] {
+ set f [file join $qpath $ftail]
+ if {[file isdirectory $f]} {
+ if {$ftail eq "CVS"} continue
+ lappend queue [file join $qprefix $ftail] $f
+ } elseif {[file isfile $f]} {
+ if {$ftail eq "pkgIndex.tcl"} continue
+ if {$ftail eq "manifest.txt"} {
+ lappend result $f [file join $qprefix pkgIndex.tcl]
+ } else {
+ lappend result $f [file join $qprefix $ftail]
+ }
+ }
+ }
+ }
+}
+if {[llength $argv]<4} {
+ error "Usage: [file tail [info script]] IMG_OUTPUT IMG_INPUT PREFIX FILE_SYSTEM ?PREFIX FILE_SYSTEM?..."
+}
+
+set paths [lassign $argv DLL_OUTPUT DLL_INPUT]
+foreach {prefix fpath} $paths {
+ mapDir files $prefix [file normalize $fpath]
+}
+if {$DLL_INPUT != {}} {
+ zipfs lmkzip $DLL_OUTPUT $files
+} else {
+ zipfs lmkimg $DLL_OUTPUT $files {} $DLL_INPUT
+}
diff --git a/tools/loadICU.tcl b/tools/loadICU.tcl
index 31f1e54..43d7e6a 100755
--- a/tools/loadICU.tcl
+++ b/tools/loadICU.tcl
@@ -27,6 +27,9 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#----------------------------------------------------------------------
+puts stdout "TODO: output in UTF-8 in stead of using \\uhhhh sequences"
+exit; # Remove those two lines after modifying this tool.
+
# Calculate the Chinese numerals from zero to ninety-nine.
set zhDigits [list {} \u4e00 \u4e8c \u4e09 \u56db \
diff --git a/tools/makeHeader.tcl b/tools/makeHeader.tcl
new file mode 100644
index 0000000..e9b7ed1
--- /dev/null
+++ b/tools/makeHeader.tcl
@@ -0,0 +1,182 @@
+# makeHeader.tcl --
+#
+# This script generates embeddable C source (in a .h file) from a .tcl
+# script.
+#
+# Copyright (c) 2018 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.6
+
+namespace eval makeHeader {
+
+ ####################################################################
+ #
+ # mapSpecial --
+ # Transform a single line so that it is able to be put in a C string.
+ #
+ proc mapSpecial {str} {
+ # All Tcl metacharacters and key C backslash sequences
+ set MAP {
+ \" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\?
+ \a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v
+ }
+ set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]}
+
+ subst [regsub -all {[^\u0020-\u007e]} [string map $MAP $str] $XFORM]
+ }
+
+ ####################################################################
+ #
+ # compactLeadingSpaces --
+ # Converts the leading whitespace on a line into a more compact form.
+ #
+ proc compactLeadingSpaces {line} {
+ set line [string map {\t { }} [string trimright $line]]
+ if {[regexp {^[ ]+} $line spaces]} {
+ regsub -all {[ ]{4}} $spaces \t replace
+ set len [expr {[string length $spaces] - 1}]
+ set line [string replace $line 0 $len $replace]
+ }
+ return $line
+ }
+
+ ####################################################################
+ #
+ # processScript --
+ # Transform a whole sequence of lines with [mapSpecial].
+ #
+ proc processScript {scriptLines} {
+ lmap line $scriptLines {
+ # Skip blank and comment lines; they're there in the original
+ # sources so we don't need to copy them over.
+ if {[regexp {^\s*(?:#|$)} $line]} continue
+ format {"%s"} [mapSpecial [compactLeadingSpaces $line]\n]
+ }
+ }
+
+ ####################################################################
+ #
+ # updateTemplate --
+ # Rewrite a template to contain the content from the input script.
+ #
+ proc updateTemplate {dataVar scriptLines} {
+ set BEGIN "*!BEGIN!: Do not edit below this line.*"
+ set END "*!END!: Do not edit above this line.*"
+
+ upvar 1 $dataVar data
+
+ set from [lsearch -glob $data $BEGIN]
+ set to [lsearch -glob $data $END]
+ if {$from == -1 || $to == -1 || $from >= $to} {
+ throw BAD "not a template"
+ }
+
+ set data [lreplace $data $from+1 $to-1 {*}[processScript $scriptLines]]
+ }
+
+ ####################################################################
+ #
+ # stripSurround --
+ # Removes the header and footer comments from a (line-split list of
+ # lines of) Tcl script code.
+ #
+ proc stripSurround {lines} {
+ set RE {^\s*$|^#}
+ set state 0
+ set lines [lmap line [lreverse $lines] {
+ if {!$state && [regexp $RE $line]} continue {
+ set state 1
+ set line
+ }
+ }]
+ return [lmap line [lreverse $lines] {
+ if {$state && [regexp $RE $line]} continue {
+ set state 0
+ set line
+ }
+ }]
+ }
+
+ ####################################################################
+ #
+ # updateTemplateFile --
+ # Rewrites a template file with the lines of the given script.
+ #
+ proc updateTemplateFile {headerFile scriptLines} {
+ set f [open $headerFile "r+"]
+ try {
+ set content [split [chan read -nonewline $f] "\n"]
+ updateTemplate content [stripSurround $scriptLines]
+ chan seek $f 0
+ chan puts $f [join $content \n]
+ chan truncate $f
+ } trap BAD msg {
+ # Add the filename to the message
+ throw BAD "${headerFile}: $msg"
+ } finally {
+ chan close $f
+ }
+ }
+
+ ####################################################################
+ #
+ # readScript --
+ # Read a script from a file and return its lines.
+ #
+ proc readScript {script} {
+ set f [open $script]
+ try {
+ chan configure $f -encoding utf-8
+ return [split [string trim [chan read $f]] "\n"]
+ } finally {
+ chan close $f
+ }
+ }
+
+ ####################################################################
+ #
+ # run --
+ # The main program of this script.
+ #
+ proc run {args} {
+ try {
+ if {[llength $args] != 2} {
+ throw ARGS "inputTclScript templateFile"
+ }
+ lassign $args inputTclScript templateFile
+
+ puts "Inserting $inputTclScript into $templateFile"
+ set scriptLines [readScript $inputTclScript]
+ updateTemplateFile $templateFile $scriptLines
+ exit 0
+ } trap ARGS msg {
+ puts stderr "wrong # args: should be \"[file tail $::argv0] $msg\""
+ exit 2
+ } trap BAD msg {
+ puts stderr $msg
+ exit 1
+ } trap POSIX msg {
+ puts stderr $msg
+ exit 1
+ } on error {- opts} {
+ puts stderr [dict get $opts -errorinfo]
+ exit 3
+ }
+ }
+}
+
+########################################################################
+#
+# Launch the main program
+#
+if {[info script] eq $::argv0} {
+ makeHeader::run {*}$::argv
+}
+
+# Local-Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl
new file mode 100644
index 0000000..cbfb81e
--- /dev/null
+++ b/tools/mkVfs.tcl
@@ -0,0 +1,99 @@
+proc cat fname {
+ set fname [open $fname r]
+ set data [read $fname]
+ close $fname
+ return $data
+}
+
+proc pkgIndexDir {root fout d1} {
+
+ puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
+ [file tail $d1]]
+ set idx [string length $root]
+ foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+ set f [file join $d1 $ftail]
+ if {[file isdirectory $f] && [string compare CVS $ftail]} {
+ pkgIndexDir $root $fout $f
+ } elseif {[file tail $f] eq "pkgIndex.tcl"} {
+ puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
+ puts $fout [cat $f]
+ }
+ }
+}
+
+###
+# Script to build the VFS file system
+###
+proc copyDir {d1 d2} {
+
+ puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
+ [file tail $d2]]
+
+ file delete -force -- $d2
+ file mkdir $d2
+
+ foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+ set f [file join $d1 $ftail]
+ if {[file isdirectory $f] && [string compare CVS $ftail]} {
+ copyDir $f [file join $d2 $ftail]
+ } elseif {[file isfile $f]} {
+ file copy -force $f [file join $d2 $ftail]
+ if {$::tcl_platform(platform) eq {unix}} {
+ file attributes [file join $d2 $ftail] -permissions 0644
+ } else {
+ file attributes [file join $d2 $ftail] -readonly 1
+ }
+ }
+ }
+
+ if {$::tcl_platform(platform) eq {unix}} {
+ file attributes $d2 -permissions 0755
+ } else {
+ file attributes $d2 -readonly 1
+ }
+}
+
+if {[llength $argv] < 3} {
+ puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
+ exit 1
+}
+set TCL_SCRIPT_DIR [lindex $argv 0]
+set TCLSRC_ROOT [lindex $argv 1]
+set PLATFORM [lindex $argv 2]
+set TKDLL [lindex $argv 3]
+set TKVER [lindex $argv 4]
+
+puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
+copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}
+
+if {$PLATFORM == "windows"} {
+ set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
+ puts "DDE DLL $ddedll"
+ if {$ddedll != {}} {
+ file copy $ddedll ${TCL_SCRIPT_DIR}/dde
+ }
+ set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
+ puts "REG DLL $ddedll"
+ if {$regdll != {}} {
+ file copy $regdll ${TCL_SCRIPT_DIR}/reg
+ }
+} else {
+ # Remove the dde and reg package paths
+ file delete -force ${TCL_SCRIPT_DIR}/dde
+ file delete -force ${TCL_SCRIPT_DIR}/reg
+}
+
+# For the following packages, cat their pkgIndex files to tclIndex
+file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
+set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
+puts $fout {#
+# MANIFEST OF INCLUDED PACKAGES
+#
+set VFSROOT $dir
+}
+if {$TKDLL ne {} && [file exists $TKDLL]} {
+ file copy $TKDLL ${TCL_SCRIPT_DIR}
+ puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"]
+}
+pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
+close $fout
diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in
index a94cea6..08d411d 100644
--- a/tools/tcl.hpj.in
+++ b/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=tcl86.cnt
+CNT=tcl87.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl86.hlp
+HLP=tcl87.hlp
[FILES]
tcl.rtf
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index 9052049..b69e601 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -155,8 +155,15 @@ proc process-text {text} {
{\fP} {\fR} \
{\.} . \
{\(bu} "&#8226;" \
- {\*(qo} "&ocirc;" \
]
+ # This might make a few invalid mappings, but we don't use them
+ foreach c {a e i o u y A E I O U Y} {
+ foreach {prefix suffix} {
+ o ring / slash : uml ' acute ^ circ ` grave
+ } {
+ lappend charmap "\\\[${prefix}${c}\]" "&${c}${suffix};"
+ }
+ }
lappend charmap {\-\|\-} -- ; # two hyphens
lappend charmap {\-} - ; # a hyphen
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index d607905..b0c2d8f 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -4,7 +4,7 @@ if {[catch {package require Tcl 8.6-} msg]} {
puts stderr "ERROR: $msg"
puts stderr "If running this script from 'make html', set the\
NATIVE_TCLSH environment\nvariable to point to an installed\
- tclsh8.6 (or the equivalent tclsh86.exe\non Windows)."
+ tclsh8.7 (or the equivalent tclsh87.exe\non Windows)."
exit 1
}
@@ -22,7 +22,7 @@ if {[catch {package require Tcl 8.6-} msg]} {
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows
-set ::Version "50/8.6"
+set ::Version "50/8.7"
set ::CSSFILE "docs.css"
##
@@ -586,6 +586,7 @@ array set exclude_refs_map {
scrollbar.n {set}
selection.n {string}
tcltest.n {error}
+ text.n {bind image lower raise}
tkvars.n {tk}
tkwait.n {variable}
tm.n {exec}
@@ -667,11 +668,7 @@ try {
# ... but try to extract (name, version) from subdir contents
try {
- try {
- set f [open [file join $pkgsDir $dir configure.in]]
- } trap {POSIX ENOENT} {} {
- set f [open [file join $pkgsDir $dir configure.ac]]
- }
+ set f [open [file join $pkgsDir $dir configure.ac]]
foreach line [split [read $f] \n] {
if {2 == [scan $line \
{ AC_INIT ( [%[^]]] , [%[^]]] ) } n v]} {
diff --git a/tools/tsdPerf.c b/tools/tsdPerf.c
index 40004b1..7a599e0 100644
--- a/tools/tsdPerf.c
+++ b/tools/tsdPerf.c
@@ -5,21 +5,21 @@ extern DLLEXPORT Tcl_PackageInitProc Tsdperf_Init;
static Tcl_ThreadDataKey key;
typedef struct {
- int value;
+ Tcl_WideInt value;
} TsdPerf;
static int
tsdPerfSetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const *objv) {
TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
- int i;
+ Tcl_WideInt i;
if (2 != objc) {
Tcl_WrongNumArgs(interp, 1, objv, "value");
return TCL_ERROR;
}
- if (TCL_OK != Tcl_GetIntFromObj(interp, objv[1], &i)) {
+ if (TCL_OK != Tcl_GetWideIntFromObj(interp, objv[1], &i)) {
return TCL_ERROR;
}
@@ -33,14 +33,14 @@ tsdPerfGetObjCmd(ClientData cdata, Tcl_Interp *interp, int objc, Tcl_Obj *const
TsdPerf *perf = Tcl_GetThreadData(&key, sizeof(TsdPerf));
- Tcl_SetObjResult(interp, Tcl_NewIntObj(perf->value));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(perf->value));
return TCL_OK;
}
int
Tsdperf_Init(Tcl_Interp *interp) {
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
diff --git a/unix/Makefile.in b/unix/Makefile.in
index d13c490..d769f03 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -83,7 +83,7 @@ HTML_INSTALL_DIR = $(INSTALL_ROOT)$(HTML_DIR)
CONFIG_INSTALL_DIR = $(INSTALL_ROOT)$(libdir)
# Directory in which to install bundled packages:
-PACKAGE_DIR = @PACKAGE_DIR@
+PACKAGE_DIR = @PACKAGE_DIR@
# Package search path.
TCL_PACKAGE_PATH = @TCL_PACKAGE_PATH@
@@ -151,8 +151,8 @@ SHELL = @MAKEFILE_SHELL@
# around; better to use the install-sh script that comes with the
# distribution, which is slower but guaranteed to work.
-INSTALL_STRIP_PROGRAM = -s
-INSTALL_STRIP_LIBRARY = -S -x
+INSTALL_STRIP_PROGRAM = -s
+INSTALL_STRIP_LIBRARY = -S -x
INSTALL = $(SHELL) $(UNIX_DIR)/install-sh -c
INSTALL_PROGRAM = ${INSTALL}
@@ -171,7 +171,7 @@ TCLTEST_EXE = tcltest${EXE_SUFFIX}
NATIVE_TCLSH = @TCLSH_PROG@
# The symbols below provide support for dynamic loading and shared libraries.
-# See configure.in for a description of what the symbols mean. The values of
+# See configure.ac for a description of what the symbols mean. The values of
# the symbols are normally set by the configure script. You shouldn't normally
# need to modify any of these definitions by hand.
@@ -242,11 +242,13 @@ ZLIB_DIR = ${COMPAT_DIR}/zlib
ZLIB_INCLUDE = @ZLIB_INCLUDE@
CC = @CC@
+OBJEXT = @OBJEXT@
+
#CC = purify -best-effort @CC@ -DPURIFY
# Flags to be passed to installManPage to control how the manpages should be
# installed (symlinks, compression, package name suffix).
-MAN_FLAGS = @MAN_FLAGS@
+MAN_FLAGS = @MAN_FLAGS@
# If non-empty, install the timezone files that are included with Tcl,
# otherwise use the ones that ship with the OS.
@@ -259,12 +261,13 @@ INSTALL_TZDATA = @INSTALL_TZDATA@
#--------------------------------------------------------------------------
GDB = gdb
+LLDB = lldb
TRACE = strace
TRACE_OPTS =
VALGRIND = valgrind
VALGRINDARGS = --tool=memcheck --num-callers=24 \
- --leak-resolution=high --leak-check=yes --show-reachable=yes -v \
- --suppressions=$(TOOL_DIR)/valgrind_suppress
+ --leak-resolution=high --leak-check=yes --show-reachable=yes -v \
+ --suppressions=$(TOOL_DIR)/valgrind_suppress
#--------------------------------------------------------------------------
# The information below should be usable as is. The configure script won't
@@ -272,8 +275,9 @@ VALGRINDARGS = --tool=memcheck --num-callers=24 \
#--------------------------------------------------------------------------
STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
-${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
+ -I"${BUILD_DIR}" -I${UNIX_DIR} -I${GENERIC_DIR} -I${TOMMATH_DIR} \
+ ${AC_FLAGS} ${PROTO_FLAGS} ${ENV_FLAGS} ${EXTRA_CFLAGS} \
+ @EXTRA_CC_SWITCHES@
CC_SWITCHES = $(STUB_CC_SWITCHES) ${NO_DEPRECATED_FLAGS}
@@ -282,7 +286,7 @@ APP_CC_SWITCHES = $(CC_SWITCHES) @EXTRA_APP_CC_SWITCHES@
LIBS = @TCL_LIBS@
DEPEND_SWITCHES = ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
-${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
+ ${AC_FLAGS} ${PROTO_FLAGS} ${EXTRA_CFLAGS} @EXTRA_CC_SWITCHES@
TCLSH_OBJS = tclAppInit.o
@@ -305,37 +309,39 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
tclPkg.o tclPkgConfig.o tclPosixStr.o \
- tclPreserve.o tclProc.o tclRegexp.o \
+ tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
tclResolve.o tclResult.o tclScan.o tclStringObj.o \
tclStrToD.o tclThread.o \
tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
- tclTomMathInterface.o
+ tclTomMathInterface.o tclZipfs.o
OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
tclOOMethod.o tclOOStubInit.o
TOMMATH_OBJS = bncore.o bn_reverse.o bn_fast_s_mp_mul_digs.o \
bn_fast_s_mp_sqr.o bn_mp_add.o bn_mp_and.o \
- bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
- bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
+ bn_mp_add_d.o bn_mp_clamp.o bn_mp_clear.o bn_mp_clear_multi.o \
+ bn_mp_cmp.o bn_mp_cmp_d.o bn_mp_cmp_mag.o \
bn_mp_cnt_lsb.o bn_mp_copy.o \
bn_mp_count_bits.o bn_mp_div.o bn_mp_div_d.o bn_mp_div_2.o \
- bn_mp_div_2d.o bn_mp_div_3.o bn_mp_exch.o \
- bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_grow.o bn_mp_init.o \
+ bn_mp_div_2d.o bn_mp_div_3.o \
+ bn_mp_exch.o bn_mp_expt_d.o bn_mp_expt_d_ex.o bn_mp_get_int.o \
+ bn_mp_get_long.o bn_mp_get_long_long.o bn_mp_grow.o bn_mp_init.o \
bn_mp_init_copy.o bn_mp_init_multi.o bn_mp_init_set.o \
bn_mp_init_set_int.o bn_mp_init_size.o bn_mp_karatsuba_mul.o \
bn_mp_karatsuba_sqr.o \
- bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
- bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
+ bn_mp_lshd.o bn_mp_mod.o bn_mp_mod_2d.o bn_mp_mul.o bn_mp_mul_2.o \
+ bn_mp_mul_2d.o bn_mp_mul_d.o bn_mp_neg.o bn_mp_or.o \
bn_mp_radix_size.o bn_mp_radix_smap.o \
- bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
- bn_mp_shrink.o \
+ bn_mp_read_radix.o bn_mp_rshd.o bn_mp_set.o bn_mp_set_int.o \
+ bn_mp_set_long.o bn_mp_set_long_long.o bn_mp_shrink.o \
bn_mp_sqr.o bn_mp_sqrt.o bn_mp_sub.o bn_mp_sub_d.o \
- bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
+ bn_mp_tc_and.o bn_mp_tc_div_2d.o bn_mp_tc_or.o bn_mp_tc_xor.o \
+ bn_mp_to_unsigned_bin.o bn_mp_to_unsigned_bin_n.o \
bn_mp_toom_mul.o bn_mp_toom_sqr.o bn_mp_toradix_n.o \
bn_mp_unsigned_bin_size.o bn_mp_xor.o bn_mp_zero.o bn_s_mp_add.o \
- bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
+ bn_s_mp_mul_digs.o bn_s_mp_sqr.o bn_s_mp_sub.o
STUB_LIB_OBJS = tclStubLib.o \
tclTomMathStubLib.o \
@@ -347,7 +353,7 @@ UNIX_OBJS = tclUnixChan.o tclUnixEvent.o tclUnixFCmd.o \
tclUnixTime.o tclUnixInit.o tclUnixThrd.o \
tclUnixCompat.o
-NOTIFY_OBJS = tclUnixNotfy.o
+NOTIFY_OBJS = tclEpollNotfy.o tclKqueueNotfy.o tclSelectNotfy.o
MAC_OSX_OBJS = tclMacOSXBundle.o tclMacOSXFCmd.o tclMacOSXNotify.o
@@ -446,6 +452,7 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclPosixStr.c \
$(GENERIC_DIR)/tclPreserve.c \
$(GENERIC_DIR)/tclProc.c \
+ $(GENERIC_DIR)/tclProcess.c \
$(GENERIC_DIR)/tclRegexp.c \
$(GENERIC_DIR)/tclResolve.c \
$(GENERIC_DIR)/tclResult.c \
@@ -465,7 +472,8 @@ GENERIC_SRCS = \
$(GENERIC_DIR)/tclUtil.c \
$(GENERIC_DIR)/tclVar.c \
$(GENERIC_DIR)/tclAssembly.c \
- $(GENERIC_DIR)/tclZlib.c
+ $(GENERIC_DIR)/tclZlib.c \
+ $(GENERIC_DIR)/tclZipfs.c
OO_SRCS = \
$(GENERIC_DIR)/tclOO.c \
@@ -506,6 +514,9 @@ TOMMATH_SRCS = \
$(TOMMATH_DIR)/bn_mp_exch.c \
$(TOMMATH_DIR)/bn_mp_expt_d.c \
$(TOMMATH_DIR)/bn_mp_expt_d_ex.c \
+ $(TOMMATH_DIR)/bn_mp_get_int.c \
+ $(TOMMATH_DIR)/bn_mp_get_long.c \
+ $(TOMMATH_DIR)/bn_mp_get_long_long.c \
$(TOMMATH_DIR)/bn_mp_grow.c \
$(TOMMATH_DIR)/bn_mp_init.c \
$(TOMMATH_DIR)/bn_mp_init_copy.c \
@@ -530,11 +541,17 @@ TOMMATH_SRCS = \
$(TOMMATH_DIR)/bn_mp_rshd.c \
$(TOMMATH_DIR)/bn_mp_set.c \
$(TOMMATH_DIR)/bn_mp_set_int.c \
+ $(TOMMATH_DIR)/bn_mp_set_long.c \
+ $(TOMMATH_DIR)/bn_mp_set_long_long.c \
$(TOMMATH_DIR)/bn_mp_shrink.c \
$(TOMMATH_DIR)/bn_mp_sqr.c \
$(TOMMATH_DIR)/bn_mp_sqrt.c \
$(TOMMATH_DIR)/bn_mp_sub.c \
$(TOMMATH_DIR)/bn_mp_sub_d.c \
+ $(TOMMATH_DIR)/bn_mp_tc_and.c \
+ $(TOMMATH_DIR)/bn_mp_tc_div_2d.c \
+ $(TOMMATH_DIR)/bn_mp_tc_or.c \
+ $(TOMMATH_DIR)/bn_mp_tc_xor.c \
$(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c \
$(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c \
$(TOMMATH_DIR)/bn_mp_toom_mul.c \
@@ -567,7 +584,9 @@ UNIX_SRCS = \
$(UNIX_DIR)/tclUnixCompat.c
NOTIFY_SRCS = \
- $(UNIX_DIR)/tclUnixNotfy.c
+ $(UNIX_DIR)/tclEpollNotfy.c \
+ $(UNIX_DIR)/tclKqueueNotfy.c \
+ $(UNIX_DIR)/tclSelectNotfy.c
DL_SRCS = \
$(UNIX_DIR)/tclLoadAix.c \
@@ -611,6 +630,44 @@ ZLIB_SRCS = \
SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
$(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@
+###
+# Tip 430 - ZipFS Modifications
+###
+
+TCL_ZIP_FILE = @TCL_ZIP_FILE@
+TCL_VFS_ROOT = libtcl.vfs
+TCL_VFS_PATH = ${TCL_VFS_ROOT}/tcl_library
+
+HOST_CC = @CC_FOR_BUILD@
+HOST_EXEEXT = @EXEEXT_FOR_BUILD@
+HOST_OBJEXT = @OBJEXT_FOR_BUILD@
+ZIPFS_BUILD = @ZIPFS_BUILD@
+NATIVE_ZIP = @ZIP_PROG@
+ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@
+ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@
+SHARED_BUILD = @SHARED_BUILD@
+INSTALL_LIBRARIES = @INSTALL_LIBRARIES@
+INSTALL_MSGS = @INSTALL_MSGS@
+
+# Minizip
+MINIZIP_OBJS = \
+ adler32.$(HOST_OBJEXT) \
+ compress.$(HOST_OBJEXT) \
+ crc32.$(HOST_OBJEXT) \
+ deflate.$(HOST_OBJEXT) \
+ infback.$(HOST_OBJEXT) \
+ inffast.$(HOST_OBJEXT) \
+ inflate.$(HOST_OBJEXT) \
+ inftrees.$(HOST_OBJEXT) \
+ ioapi.$(HOST_OBJEXT) \
+ trees.$(HOST_OBJEXT) \
+ uncompr.$(HOST_OBJEXT) \
+ zip.$(HOST_OBJEXT) \
+ zutil.$(HOST_OBJEXT) \
+ minizip.$(HOST_OBJEXT)
+
+ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@
+
#--------------------------------------------------------------------------
# Start of rules
#--------------------------------------------------------------------------
@@ -623,15 +680,41 @@ libraries:
doc:
+tclzipfile: ${TCL_ZIP_FILE}
+
+${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS}
+ @rm -rf ${TCL_VFS_ROOT}
+ @mkdir -p ${TCL_VFS_PATH}
+ @echo "creating ${TCL_VFS_PATH} (prepare compression)"
+ @( \
+ ln -s $(TOP_DIR)/library/* ${TCL_VFS_PATH}/ && \
+ ln ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl \
+ ) || ( \
+ cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \
+ cp -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \
+ )
+ @find ${TCL_VFS_ROOT} -type d -empty -delete
+ (zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \
+ (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \
+ cd ${TCL_VFS_ROOT} && \
+ $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \
+ echo "${TCL_ZIP_FILE} successful created with $$zip" && \
+ cd ..)
+
# The following target is configured by autoconf to generate either a shared
# library or non-shared library for Tcl.
-${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS}
+${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE}
rm -f $@
@MAKE_LIB@
+ @if test "${ZIPFS_BUILD}" = "1" ; then \
+ cat ${TCL_ZIP_FILE} >> ${LIB_FILE}; \
+ ${NATIVE_ZIP} -A ${LIB_FILE} \
+ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \
+ fi
${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
- @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \
- (cd ${TOP_DIR}/win; ${MAKE} winextensions); \
+ @if [ "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll" ] ; then \
+ ( cd ${TOP_DIR}/win; ${MAKE} winextensions ); \
fi
rm -f $@
@MAKE_STUB_LIB@
@@ -661,13 +744,14 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
clean: clean-packages
rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
- errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@
- cd dltest ; $(MAKE) clean
+ errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \
+ minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs
+ (cd dltest ; $(MAKE) clean)
distclean: distclean-packages clean
rm -rf Makefile config.status config.cache config.log tclConfig.sh \
tclConfig.h *.plist Tcl.framework tcl.pc
- cd dltest ; $(MAKE) distclean
+ (cd dltest ; $(MAKE) distclean)
depend:
makedepend -- $(DEPEND_SWITCHES) -- $(SRCS)
@@ -722,7 +806,14 @@ gdb-test: ${TCLTEST_EXE}
@echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run
@echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run
$(GDB) ./${TCLTEST_EXE} --command=gdb.run
- rm gdb.run
+ @rm gdb.run
+
+lldb-test: ${TCLTEST_EXE}
+ @echo "settings set target.env-vars @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > lldb.run
+ @echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
+ $(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl \
+ $(TESTFLAGS) -singleproc 1
+ @rm lldb.run
# Useful target to launch a built tcltest with the proper path,...
runtest: ${TCLTEST_EXE}
@@ -756,7 +847,9 @@ gdb: ${TCL_EXE}
$(SHELL_ENV) $(GDB) ./${TCL_EXE}
valgrind: ${TCL_EXE} ${TCLTEST_EXE}
- $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind $(TESTFLAGS)
+ $(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCLTEST_EXE} \
+ $(TOP_DIR)/tests/all.tcl -singleproc 1 -constraints valgrind \
+ $(TESTFLAGS)
valgrindshell: ${TCL_EXE}
$(SHELL_ENV) $(VALGRIND) $(VALGRINDARGS) ./${TCL_EXE} $(SCRIPT)
@@ -771,7 +864,7 @@ trace-test: ${TCLTEST_EXE}
# Installation rules
#--------------------------------------------------------------------------
-INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA)
+INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
INSTALL_DOC_TARGETS = install-doc
INSTALL_PACKAGE_TARGETS = install-packages
INSTALL_DEV_TARGETS = install-headers
@@ -783,19 +876,16 @@ install: $(INSTALL_TARGETS)
install-strip:
$(MAKE) $(INSTALL_TARGETS) \
- INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}" \
- INSTALL_LIBRARY="$(INSTALL_LIBRARY) ${INSTALL_STRIP_LIBRARY}"
+ INSTALL_PROGRAM="$(INSTALL_PROGRAM) ${INSTALL_STRIP_PROGRAM}"
install-binaries: binaries
@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" \
- "$(CONFIG_INSTALL_DIR)"; \
- do \
+ "$(CONFIG_INSTALL_DIR)" ; do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
$(INSTALL_DATA_DIR) "$$i"; \
- else true; \
- fi; \
- done;
+ fi; \
+ done
@echo "Installing $(LIB_FILE) to $(DLL_INSTALL_DIR)/"
@@INSTALL_LIB@
@chmod 555 "$(DLL_INSTALL_DIR)/$(LIB_FILE)"
@@ -815,70 +905,77 @@ install-binaries: binaries
@$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
+install-libraries-zipfs-shared: libraries
+ @for i in "$(SCRIPT_INSTALL_DIR)" ; do \
+ if [ ! -d "$$i" ] ; then \
+ echo "Making directory $$i"; \
+ $(INSTALL_DATA_DIR) "$$i"; \
+ fi; \
+ done
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
+ @for i in $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \
+ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
+ done
+
+install-libraries-zipfs-static: install-libraries-zipfs-shared
+ $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"
+
+MODULE_INSTALL_DIR=$(SCRIPT_INSTALL_DIR)/..
+
install-libraries: libraries
- @for i in "$(SCRIPT_INSTALL_DIR)"; \
- do \
+ @for i in "$(SCRIPT_INSTALL_DIR)" ; do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
$(INSTALL_DATA_DIR) "$$i"; \
- else true; \
- fi; \
- done;
- @for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
- do \
+ fi; \
+ done
+ @for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7 ; do \
if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
- else true; \
- fi; \
- done;
- @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
+ fi; \
+ done
+ @echo "Installing library files to $(SCRIPT_INSTALL_DIR)/"
@for i in $(TOP_DIR)/library/*.tcl $(TOP_DIR)/library/tclIndex \
- $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
- do \
+ $(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@ ; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
- done;
- @echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
- @for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
- do \
- $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
- done;
- @echo "Installing package http 2.9.0 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.9.0.tm;
- @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
- @for i in $(TOP_DIR)/library/opt/*.tcl ; \
- do \
+ done
+ @echo "Installing package http 2.9.0 as a Tcl Module"
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
+ "$(MODULE_INSTALL_DIR)"/tcl8/8.6/http-2.9.0.tm
+ @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
+ @for i in $(TOP_DIR)/library/opt/*.tcl ; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
- done;
- @echo "Installing package msgcat 1.6.1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm;
- @echo "Installing package tcltest 2.5.0 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.5.0.tm;
-
- @echo "Installing package platform 1.0.14 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
- @echo "Installing package platform::shell 1.1.4 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;
-
- @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
+ done
+ @echo "Installing package msgcat 1.7.0 as a Tcl Module"
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl \
+ "$(MODULE_INSTALL_DIR)"/tcl8/8.7/msgcat-1.7.0.tm
+ @echo "Installing package tcltest 2.5.0 as a Tcl Module"
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl \
+ "$(MODULE_INSTALL_DIR)"/tcl8/8.5/tcltest-2.5.0.tm
+ @echo "Installing package platform 1.0.14 as a Tcl Module"
+ @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl \
+ "$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform-1.0.14.tm
+ @echo "Installing package platform::shell 1.1.4 as a Tcl Module"
+ @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl \
+ "$(MODULE_INSTALL_DIR)"/tcl8/8.4/platform/shell-1.1.4.tm
+ @echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/"
@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/encoding; \
- done;
- @if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ]; then \
+ done
+ @if [ -n "$(TCL_MODULE_PATH)" -a -f $(TOP_DIR)/library/tm.tcl ] ; then \
echo "Customizing tcl module path"; \
echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \
"$(SCRIPT_INSTALL_DIR)"/tm.tcl; \
fi
install-tzdata:
- @for i in tzdata; \
- do \
+ @for i in tzdata ; do \
if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
- else true; \
- fi; \
- done;
+ fi; \
+ done
@echo "Installing time zone files to $(SCRIPT_INSTALL_DIR)/tzdata/"
@for i in $(TOP_DIR)/library/tzdata/* ; do \
if [ -d $$i ] ; then \
@@ -902,86 +999,80 @@ install-tzdata:
else \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/tzdata; \
fi; \
- done;
+ done
install-msgs:
- @for i in msgs; \
- do \
+ @for i in msgs ; do \
if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
$(INSTALL_DATA_DIR) "$(SCRIPT_INSTALL_DIR)"/$$i; \
- else true; \
- fi; \
- done;
+ fi; \
+ done
@echo "Installing message catalog files to $(SCRIPT_INSTALL_DIR)/msgs/"
@for i in $(TOP_DIR)/library/msgs/*.msg ; do \
- $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
- done;
+ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/msgs; \
+ done
install-doc: doc
- @for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; \
- do \
+ @for i in "$(MAN_INSTALL_DIR)" "$(MAN1_INSTALL_DIR)" "$(MAN3_INSTALL_DIR)" "$(MANN_INSTALL_DIR)" ; do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
$(INSTALL_DATA_DIR) "$$i"; \
- else true; \
- fi; \
- done;
- @echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/";
- @for i in $(TOP_DIR)/doc/*.1; do \
+ fi; \
+ done
+ @echo "Installing and cross-linking top-level (.1) docs to $(MAN1_INSTALL_DIR)/"
+ @for i in $(TOP_DIR)/doc/*.1 ; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN1_INSTALL_DIR)"; \
done
-
- @echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/";
- @for i in $(TOP_DIR)/doc/*.3; do \
+ @echo "Installing and cross-linking C API (.3) docs to $(MAN3_INSTALL_DIR)/"
+ @for i in $(TOP_DIR)/doc/*.3 ; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MAN3_INSTALL_DIR)"; \
done
-
@echo "Installing and cross-linking command (.n) docs to $(MANN_INSTALL_DIR)/";
- @for i in $(TOP_DIR)/doc/*.n; do \
+ @for i in $(TOP_DIR)/doc/*.n ; do \
$(SHELL) $(UNIX_DIR)/installManPage $(MAN_FLAGS) $$i "$(MANN_INSTALL_DIR)"; \
done
+# Public headers that define Tcl's API
+TCL_PUBLIC_HEADERS = $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
+ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
+ $(GENERIC_DIR)/tclPlatDecls.h $(GENERIC_DIR)/tclTomMath.h \
+ $(GENERIC_DIR)/tclTomMathDecls.h
+# Private headers that define Tcl's internal API
+TCL_PRIVATE_HEADERS = $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
+ $(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
+ $(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
+ $(UNIX_DIR)/tclUnixPort.h
+# Any other headers you find in the Tcl sources are purely part of Tcl's
+# implementation, and aren't to be installed.
+
install-headers:
- @for i in "$(INCLUDE_INSTALL_DIR)"; \
- do \
+ @for i in "$(INCLUDE_INSTALL_DIR)" ; do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
$(INSTALL_DATA_DIR) "$$i"; \
- else true; \
- fi; \
- done;
+ fi; \
+ done
@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
- @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
- $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
- $(GENERIC_DIR)/tclPlatDecls.h \
- $(GENERIC_DIR)/tclTomMath.h \
- $(GENERIC_DIR)/tclTomMathDecls.h ; \
- do \
+ @for i in $(TCL_PUBLIC_HEADERS) ; do \
$(INSTALL_DATA) $$i "$(INCLUDE_INSTALL_DIR)"; \
- done;
+ done
# Optional target to install private headers
install-private-headers:
- @for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
- do \
+ @for i in "$(PRIVATE_INCLUDE_INSTALL_DIR)" ; do \
if [ ! -d "$$i" ] ; then \
echo "Making directory $$i"; \
$(INSTALL_DATA_DIR) "$$i"; \
- else true; \
- fi; \
- done;
+ fi; \
+ done
@echo "Installing private header files to $(PRIVATE_INCLUDE_INSTALL_DIR)/";
- @for i in $(GENERIC_DIR)/tclInt.h $(GENERIC_DIR)/tclIntDecls.h \
- $(GENERIC_DIR)/tclIntPlatDecls.h $(GENERIC_DIR)/tclPort.h \
- $(GENERIC_DIR)/tclOOInt.h $(GENERIC_DIR)/tclOOIntDecls.h \
- $(UNIX_DIR)/tclUnixPort.h; \
- do \
+ @for i in $(TCL_PRIVATE_HEADERS) ; do \
$(INSTALL_DATA) $$i "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
- done;
- @if test -f tclConfig.h; then\
+ done
+ @if test -f tclConfig.h ; then \
$(INSTALL_DATA) tclConfig.h "$(PRIVATE_INCLUDE_INSTALL_DIR)"; \
- fi;
+ fi
#--------------------------------------------------------------------------
# Rules for how to compile C files
@@ -1000,42 +1091,45 @@ tclTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
@if test -f tclAppInit.o ; then \
rm -f tclAppInit.sav; \
mv tclAppInit.o tclAppInit.sav; \
- fi;
+ fi
$(CC) -c $(APP_CC_SWITCHES) \
-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
-DTCL_TEST $(UNIX_DIR)/tclAppInit.c
- rm -f tclTestInit.o
+ @rm -f tclTestInit.o
mv tclAppInit.o tclTestInit.o
@if test -f tclAppInit.sav ; then \
mv tclAppInit.sav tclAppInit.o; \
- fi;
+ fi
xtTestInit.o: $(UNIX_DIR)/tclAppInit.c ${TCL_EXE}
@if test -f tclAppInit.o ; then \
rm -f tclAppInit.sav; \
mv tclAppInit.o tclAppInit.sav; \
- fi;
+ fi
$(CC) -c $(APP_CC_SWITCHES) \
-DTCL_BUILDTIME_LIBRARY="\"${TCL_BUILDTIME_LIBRARY}\"" \
-DTCL_TEST -DTCL_XT_TEST $(UNIX_DIR)/tclAppInit.c
- rm -f xtTestInit.o
+ @rm -f xtTestInit.o
mv tclAppInit.o xtTestInit.o
@if test -f tclAppInit.sav ; then \
mv tclAppInit.sav tclAppInit.o; \
- fi;
+ fi
# Object files used on all Unix systems:
-REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
- $(GENERIC_DIR)/regcustom.h
-TCLREHDRS=$(GENERIC_DIR)/tclRegexp.h
-COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
-FSHDR=$(GENERIC_DIR)/tclFileSystem.h
-IOHDR=$(GENERIC_DIR)/tclIO.h
-MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
-PARSEHDR=$(GENERIC_DIR)/tclParse.h
-NREHDR=$(GENERIC_DIR)/tclInt.h
-TRIMHDR=$(GENERIC_DIR)/tclStringTrim.h
+REGHDRS = $(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
+ $(GENERIC_DIR)/regcustom.h
+TCLREHDRS = $(GENERIC_DIR)/tclRegexp.h
+COMPILEHDR = $(GENERIC_DIR)/tclCompile.h
+FSHDR = $(GENERIC_DIR)/tclFileSystem.h
+IOHDR = $(GENERIC_DIR)/tclIO.h
+MATHHDRS = $(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
+PARSEHDR = $(GENERIC_DIR)/tclParse.h
+NREHDR = $(GENERIC_DIR)/tclInt.h
+TRIMHDR = $(GENERIC_DIR)/tclStringTrim.h
+
+TCL_LOCATIONS = -DTCL_LIBRARY="\"${TCL_LIBRARY}\"" \
+ -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""
regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
@@ -1219,7 +1313,7 @@ tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR)
tclNotify.o: $(GENERIC_DIR)/tclNotify.c
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
-tclOO.o: $(GENERIC_DIR)/tclOO.c
+tclOO.o: $(GENERIC_DIR)/tclOO.c $(GENERIC_DIR)/tclOOScript.h
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c
tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
@@ -1264,19 +1358,19 @@ tclPkg.o: $(GENERIC_DIR)/tclPkg.c
# prefix/exec_prefix but all the different paths individually.
tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
- $(CC) -c $(CC_SWITCHES) \
+ $(CC) -c $(CC_SWITCHES) \
-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \
-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
- \
-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
-DCFG_RUNTIME_BINDIR="\"$(bindir)\"" \
-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
-DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \
-DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \
- \
+ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
+ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
$(GENERIC_DIR)/tclPkgConfig.c
tclPosixStr.o: $(GENERIC_DIR)/tclPosixStr.c
@@ -1288,6 +1382,9 @@ tclPreserve.o: $(GENERIC_DIR)/tclPreserve.c
tclProc.o: $(GENERIC_DIR)/tclProc.c $(COMPILEHDR) $(NREHDR)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProc.c
+tclProcess.o: $(GENERIC_DIR)/tclProcess.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclProcess.c
+
tclRegexp.o: $(GENERIC_DIR)/tclRegexp.c $(TCLREHDRS)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclRegexp.c
@@ -1324,6 +1421,15 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c
tclZlib.o: $(GENERIC_DIR)/tclZlib.c
$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
+tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
+ $(CC) -c $(CC_SWITCHES) \
+ -DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
+ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
+ -DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
+ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
+ $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip \
+ $(GENERIC_DIR)/tclZipfs.c
+
tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
@@ -1426,6 +1532,15 @@ bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS)
bn_mp_expt_d_ex.o: $(TOMMATH_DIR)/bn_mp_expt_d_ex.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d_ex.c
+bn_mp_get_int.o: $(TOMMATH_DIR)/bn_mp_get_int.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_int.c
+
+bn_mp_get_long.o: $(TOMMATH_DIR)/bn_mp_get_long.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long.c
+
+bn_mp_get_long_long.o: $(TOMMATH_DIR)/bn_mp_get_long_long.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_get_long_long.c
+
bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_grow.c
@@ -1498,6 +1613,12 @@ bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS)
bn_mp_set_int.o: $(TOMMATH_DIR)/bn_mp_set_int.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_int.c
+bn_mp_set_long.o: $(TOMMATH_DIR)/bn_mp_set_long.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_long.c
+
+bn_mp_set_long_long.o: $(TOMMATH_DIR)/bn_mp_set_long_long.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_long_long.c
+
bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_shrink.c
@@ -1513,6 +1634,18 @@ bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS)
bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c
+bn_mp_tc_and.o: $(TOMMATH_DIR)/bn_mp_tc_and.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_and.c
+
+bn_mp_tc_div_2d.o: $(TOMMATH_DIR)/bn_mp_tc_div_2d.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_div_2d.c
+
+bn_mp_tc_or.o: $(TOMMATH_DIR)/bn_mp_tc_or.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_or.c
+
+bn_mp_tc_xor.o: $(TOMMATH_DIR)/bn_mp_tc_xor.c $(MATHHDRS)
+ $(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_tc_xor.c
+
bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c
@@ -1561,8 +1694,14 @@ tclUnixFCmd.o: $(UNIX_DIR)/tclUnixFCmd.c
tclUnixFile.o: $(UNIX_DIR)/tclUnixFile.c $(FSHDR)
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixFile.c
-tclUnixNotfy.o: $(UNIX_DIR)/tclUnixNotfy.c
- $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixNotfy.c
+tclEpollNotfy.o: $(UNIX_DIR)/tclEpollNotfy.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclEpollNotfy.c
+
+tclKqueueNotfy.o: $(UNIX_DIR)/tclKqueueNotfy.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclKqueueNotfy.c
+
+tclSelectNotfy.o: $(UNIX_DIR)/tclSelectNotfy.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclSelectNotfy.c
tclUnixPipe.o: $(UNIX_DIR)/tclUnixPipe.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixPipe.c
@@ -1579,7 +1718,6 @@ tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
-TCL_LOCATIONS=-DTCL_LIBRARY="\"${TCL_LIBRARY}\"" -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""
tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
$(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c
@@ -1705,106 +1843,157 @@ tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c
$(CC) -c $(CC_SWITCHES) $<
#--------------------------------------------------------------------------
+# Minizip implementation
+#--------------------------------------------------------------------------
+adler32.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c
+
+compress.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c
+
+crc32.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c
+
+deflate.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c
+
+ioapi.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
+ $(ZLIB_DIR)/contrib/minizip/ioapi.c
+
+infback.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c
+
+inffast.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c
+
+inflate.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c
+
+inftrees.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c
+
+trees.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c
+
+uncompr.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c
+
+zip.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
+ $(ZLIB_DIR)/contrib/minizip/zip.c
+
+zutil.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c
+
+minizip.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c \
+ $(ZLIB_DIR)/contrib/minizip/minizip.c
+
+minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
+ $(HOST_CC) -o $@ $(MINIZIP_OBJS)
+
+#--------------------------------------------------------------------------
# Bundled Package targets
#--------------------------------------------------------------------------
# Propagate configure args like --enable-64bit to package configure
PKG_CFG_ARGS = @PKG_CFG_ARGS@
# If PKG_DIR is changed to a different relative depth to the build dir, need
-# to adapt the ../.. relative paths below and at the top of configure.in (we
+# to adapt the ../.. relative paths below and at the top of configure.ac (we
# cannot use absolute paths due to issues in nested configure when path to
# build dir contains spaces).
PKG_DIR = ./pkgs
configure-packages:
- @for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- if [ -x $$i/configure ]; then \
- pkg=`basename $$i`; \
- echo "Configuring package '$$pkg'"; \
- mkdir -p $(PKG_DIR)/$$pkg; \
- if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; \
- $$i/configure --with-tcl=../.. \
- --with-tclinclude=$(GENERIC_DIR) \
- $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
- --enable-shared --enable-threads; ) || exit $$?; \
- fi; \
+ @for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ if [ -x $$i/configure ] ; then \
+ pkg=`basename $$i`; \
+ echo "Configuring package '$$pkg'"; \
+ mkdir -p $(PKG_DIR)/$$pkg; \
+ if [ ! -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ ( cd $(PKG_DIR)/$$pkg; \
+ $$i/configure --with-tcl=../.. \
+ --with-tclinclude=$(GENERIC_DIR) \
+ $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
+ --enable-shared; ) || exit $$?; \
+ fi; \
+ fi; \
fi; \
- fi; \
done
packages: configure-packages ${STUB_LIB_FILE}
- @for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Building package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
+ @for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ pkg=`basename $$i`; \
+ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ echo "Building package '$$pkg'"; \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) || exit $$?; \
+ fi; \
fi; \
- fi; \
done
install-packages: packages
- @for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Installing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
- "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
+ @for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ pkg=`basename $$i`; \
+ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ echo "Installing package '$$pkg'"; \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) install \
+ "DESTDIR=$(INSTALL_ROOT)"; ) || exit $$?; \
+ fi; \
fi; \
- fi; \
done
test-packages: ${TCLTEST_EXE} packages
- @for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- echo "Testing package '$$pkg'"; \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
- "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
- "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
- "TCLLIBPATH=../../pkgs" test \
- "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
+ @for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ pkg=`basename $$i`; \
+ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ echo "Testing package '$$pkg'"; \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) \
+ "@LD_LIBRARY_PATH_VAR@=../..:$${@LD_LIBRARY_PATH_VAR@}" \
+ "TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" \
+ "TCLLIBPATH=../../pkgs" test \
+ "TCLSH_PROG=../../${TCLTEST_EXE}"; ) \
+ fi; \
fi; \
- fi; \
done
clean-packages:
- @for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
+ @for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ pkg=`basename $$i`; \
+ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) clean; ) \
+ fi; \
fi; \
- fi; \
done
distclean-packages:
- @for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
+ @for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ pkg=`basename $$i`; \
+ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) distclean; ) \
+ fi; \
+ rm -rf $(PKG_DIR)/$$pkg; \
fi; \
- rm -rf $(PKG_DIR)/$$pkg; \
- fi; \
done; \
rm -rf $(PKG_DIR)
dist-packages: configure-packages
@rm -rf $(DISTROOT)/pkgs; \
mkdir -p $(DISTROOT)/pkgs; \
- for i in $(PKGS_DIR)/*; do \
- if [ -d $$i ]; then \
- pkg=`basename $$i`; \
- if [ -f $(PKG_DIR)/$$pkg/Makefile ]; then \
- ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
- "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
+ for i in $(PKGS_DIR)/* ; do \
+ if [ -d $$i ] ; then \
+ pkg=`basename $$i`; \
+ if [ -f $(PKG_DIR)/$$pkg/Makefile ] ; then \
+ ( cd $(PKG_DIR)/$$pkg; $(MAKE) dist \
+ "DIST_ROOT=$(DISTROOT)/pkgs"; ) || exit $$?; \
+ fi; \
fi; \
- fi; \
done
#--------------------------------------------------------------------------
@@ -1819,9 +2008,9 @@ dist-packages: configure-packages
gendate:
bison --output-file=$(GENERIC_DIR)/tclDate.c \
- --no-lines \
- --name-prefix=TclDate \
- $(GENERIC_DIR)/tclGetDate.y
+ --no-lines \
+ --name-prefix=TclDate \
+ $(GENERIC_DIR)/tclGetDate.y
# yacc -l $(GENERIC_DIR)/tclGetDate.y
# sed -e 's/yy/TclDate/g' -e '/^#include <values.h>/d' \
@@ -1857,6 +2046,11 @@ $(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
@echo "Developers may want to run \"make genstubs\" to regenerate."
@echo "This warning can be safely ignored, do not report as a bug!"
+$(GENERIC_DIR)/tclOOScript.h: $(GENERIC_DIR)/tclOOScript.tcl
+ @echo "Warning: tclOOScript.h may be out of date."
+ @echo "Developers may want to run \"make genscript\" to regenerate."
+ @echo "This warning can be safely ignored, do not report as a bug!"
+
genstubs:
$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
@@ -1864,6 +2058,10 @@ genstubs:
$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
$(GENERIC_DIR)/tclOO.decls
+genscript:
+ $(NATIVE_TCLSH) $(TOOL_DIR)/makeHeader.tcl \
+ $(GENERIC_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h
+
#
# Target to check that all exported functions have an entry in the stubs
# tables.
@@ -1872,14 +2070,16 @@ genstubs:
checkstubs: $(TCL_LIB_FILE)
-@for i in `nm -p $(TCL_LIB_FILE) \
| awk '$$2 ~ /^[TDBCS]$$/ { sub("^_", "", $$3); print $$3 }' \
- | sort -n`; do \
- match=0; \
- for j in $(TCL_DECLS); do \
- if [ `grep -c "$$i *(" $$j` -gt 0 ]; then \
- match=1; \
- fi; \
- done; \
- if [ $$match -eq 0 ]; then echo $$i; fi \
+ | sort -n` ; do \
+ match=0; \
+ for j in $(TCL_DECLS) ; do \
+ if [ `grep -c "$$i *(" $$j` -gt 0 ] ; then \
+ match=1; \
+ fi; \
+ done; \
+ if [ $$match -eq 0 ] ; then \
+ echo $$i; \
+ fi; \
done
#
@@ -1889,14 +2089,16 @@ checkstubs: $(TCL_LIB_FILE)
checkdoc: $(TCL_LIB_FILE)
-@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 \
+ | 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
#
@@ -1925,14 +2127,14 @@ checkexports: $(TCL_LIB_FILE)
#
rpm: all
- rm -f THIS.TCL.SPEC
+ -@rm -f THIS.TCL.SPEC
echo "%define _builddir `pwd`" > THIS.TCL.SPEC
echo "%define _rpmdir `pwd`/RPMS" >> THIS.TCL.SPEC
cat tcl.spec >> THIS.TCL.SPEC
mkdir -p RPMS/i386
rpmbuild -bb THIS.TCL.SPEC
mv RPMS/i386/*.rpm .
- rm -rf RPMS THIS.TCL.SPEC
+ -rm -rf RPMS THIS.TCL.SPEC
#
# Target to create a proper Tcl distribution from information in the master
@@ -1944,7 +2146,9 @@ DISTROOT = /tmp/dist
DISTNAME = tcl${VERSION}${PATCH_LEVEL}
ZIPNAME = tcl${MAJOR_VERSION}${MINOR_VERSION}${PATCH_LEVEL}-src.zip
DISTDIR = $(DISTROOT)/$(DISTNAME)
-$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.in $(UNIX_DIR)/tcl.m4 \
+BUILTIN_PACKAGE_LIST = http opt msgcat reg dde tcltest platform
+
+$(UNIX_DIR)/configure: $(UNIX_DIR)/configure.ac $(UNIX_DIR)/tcl.m4 \
$(UNIX_DIR)/aclocal.m4
cd $(UNIX_DIR); autoconf
$(MAC_OSX_DIR)/configure: $(MAC_OSX_DIR)/configure.ac $(UNIX_DIR)/configure
@@ -1958,14 +2162,14 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
cp -p $(UNIX_DIR)/*.[ch] $(DISTDIR)/unix
cp $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
chmod 664 $(DISTDIR)/unix/Makefile.in
- cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
+ cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.ac \
$(UNIX_DIR)/tcl.m4 $(UNIX_DIR)/aclocal.m4 \
$(UNIX_DIR)/tclConfig.sh.in $(UNIX_DIR)/tclooConfig.sh \
$(UNIX_DIR)/install-sh \
$(UNIX_DIR)/README $(UNIX_DIR)/ldAix $(UNIX_DIR)/tcl.spec \
$(UNIX_DIR)/installManPage $(UNIX_DIR)/tclConfig.h.in \
$(UNIX_DIR)/tcl.pc.in $(DISTDIR)/unix
- chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
+ chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.ac
chmod 775 $(DISTDIR)/unix/ldAix
@mkdir $(DISTDIR)/generic
cp -p $(GENERIC_DIR)/*.[cdh] $(DISTDIR)/generic
@@ -1978,11 +2182,10 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
@mkdir $(DISTDIR)/library
cp -p $(TOP_DIR)/license.terms $(TOP_DIR)/library/*.tcl \
$(TOP_DIR)/library/tclIndex $(DISTDIR)/library
- for i in http1.0 http opt msgcat reg dde tcltest platform; \
- do \
- mkdir $(DISTDIR)/library/$$i ;\
- cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
- done;
+ for i in $(BUILTIN_PACKAGE_LIST) ; do \
+ mkdir $(DISTDIR)/library/$$i;\
+ cp -p $(TOP_DIR)/library/$$i/*.tcl $(DISTDIR)/library/$$i; \
+ done
@mkdir $(DISTDIR)/library/encoding
cp -p $(TOP_DIR)/library/encoding/*.enc $(DISTDIR)/library/encoding
@mkdir $(DISTDIR)/library/msgs
@@ -2010,7 +2213,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
$(DISTDIR)/tests
@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.ac $(TOP_DIR)/win/configure \
$(TOP_DIR)/win/tclConfig.sh.in $(TOP_DIR)/win/tclooConfig.sh \
$(TOP_DIR)/win/tcl.m4 $(TOP_DIR)/win/aclocal.m4 \
$(TOP_DIR)/win/tclsh.exe.manifest.in \
@@ -2019,7 +2222,6 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
$(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.bat $(DISTDIR)/win
cp -p $(TOP_DIR)/win/*.vc $(DISTDIR)/win
- cp -p $(TOP_DIR)/win/coffbase.txt $(DISTDIR)/win
cp -p $(TOP_DIR)/win/tcl.hpj.in $(DISTDIR)/win
cp -p $(TOP_DIR)/win/tcl.ds* $(DISTDIR)/win
cp -p $(TOP_DIR)/win/README $(DISTDIR)/win
@@ -2043,7 +2245,7 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
$(UNIX_DIR)/dltest/README $(DISTDIR)/unix/dltest
@mkdir $(DISTDIR)/tools
cp -p $(TOOL_DIR)/Makefile.in $(TOOL_DIR)/README \
- $(TOOL_DIR)/configure $(TOOL_DIR)/configure.in \
+ $(TOOL_DIR)/configure $(TOOL_DIR)/configure.ac \
$(TOOL_DIR)/*.tcl $(TOOL_DIR)/man2tcl.c \
$(TOOL_DIR)/*.bmp $(TOOL_DIR)/tcl.hpj.in \
$(DISTDIR)/tools
@@ -2052,14 +2254,16 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in $(M
@mkdir $(DISTDIR)/pkgs
cp $(TOP_DIR)/pkgs/README $(DISTDIR)/pkgs
cp $(TOP_DIR)/pkgs/package.list.txt $(DISTDIR)/pkgs
- for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \
+ for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null` ; do \
tar -C $(DISTDIR)/pkgs -xzf "$$i"; \
done
alldist: dist
rm -f $(DISTROOT)/$(DISTNAME)-src.tar.gz $(DISTROOT)/$(ZIPNAME)
- cd $(DISTROOT); tar cf $(DISTNAME)-src.tar $(DISTNAME); \
- gzip -9 $(DISTNAME)-src.tar; zip -qr8 $(ZIPNAME) $(DISTNAME)
+ ( cd $(DISTROOT); \
+ tar cf $(DISTNAME)-src.tar $(DISTNAME); \
+ gzip -9 $(DISTNAME)-src.tar; \
+ zip -qr8 $(ZIPNAME) $(DISTNAME) )
#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
@@ -2111,6 +2315,7 @@ BUILD_HTML = \
.PHONY: install-tzdata install-msgs
.PHONY: packages configure-packages test-packages clean-packages
.PHONY: dist-packages distclean-packages install-packages
+.PHONY: install-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile
#--------------------------------------------------------------------------
# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/unix/README b/unix/README
index d8f1090..381cbdd 100644
--- a/unix/README
+++ b/unix/README
@@ -45,8 +45,6 @@ How To Compile And Install Tcl:
refer to the autoconf documentation (not included here). Tcl's "configure"
supports the following special switches in addition to the standard ones:
- --enable-threads If this switch is set, Tcl will compile itself
- with multithreading support.
--disable-load If this switch is specified then Tcl will
configure itself not to allow dynamic loading,
even if your system appears to support it.
diff --git a/unix/configure b/unix/configure
index 159a21b..ea26c4f 100755
--- a/unix/configure
+++ b/unix/configure
@@ -1,81 +1,459 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59 for tcl 8.6.
+# Generated by GNU Autoconf 2.69 for tcl 8.7.
+#
+#
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+#
#
-# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
-DUALCASE=1; export DUALCASE # for MKS sh
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
+else
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
+ else
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
+ fi
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
fi
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Use a proper internal environment variable to ensure we don't fall
+ # into an infinite loop, continuously re-executing ourselves.
+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+ _as_can_reexec=no; export _as_can_reexec;
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+ fi
+ # We don't want this to propagate to other subprocesses.
+ { _as_can_reexec=; unset _as_can_reexec;}
+if test "x$CONFIG_SHELL" = x; then
+ as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+ emulate sh
+ NULLCMD=:
+ # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '\${1+\"\$@\"}'='\"\$@\"'
+ setopt NO_GLOB_SUBST
+else
+ case \`(set -o) 2>/dev/null\` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
+fi
+"
+ as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+ exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
+ as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+ as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+ eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
+ if (eval "$as_required") 2>/dev/null; then :
+ as_have_required=yes
+else
+ as_have_required=no
+fi
+ if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ as_found=:
+ case $as_dir in #(
+ /*)
+ for as_base in sh bash ksh sh5; do
+ # Try only shells that exist, to save several forks.
+ as_shell=$as_dir/$as_base
+ if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ CONFIG_SHELL=$as_shell as_have_required=yes
+ if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ break 2
+fi
+fi
+ done;;
+ esac
+ as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+ CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+ if test "x$CONFIG_SHELL" != x; then :
+ export CONFIG_SHELL
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
+fi
+
+ if test x$as_have_required = xno; then :
+ $as_echo "$0: This script requires a shell more modern than all"
+ $as_echo "$0: the shells that I found on your system."
+ if test x${ZSH_VERSION+set} = xset ; then
+ $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+ $as_echo "$0: be upgraded to zsh 4.3.4 or later."
else
- $as_unset $as_var
+ $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
+$0: including any error possibly output before this
+$0: message. Then install a modern shell, or manually run
+$0: the script under such a shell if you do have one."
fi
-done
+ exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$1; test $as_status -eq 0 && as_status=1
+ if test "$4"; then
+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+ fi
+ $as_echo "$as_me: error: $2" >&2
+ as_fn_exit $as_status
+} # as_fn_error
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -83,146 +461,91 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
+ as_lineno_1=$LINENO as_lineno_1a=$LINENO
+ as_lineno_2=$LINENO as_lineno_2a=$LINENO
+ eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+ test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+ # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)
+ sed -n '
+ p
+ /[$]LINENO/=
+ ' <$as_myself |
sed '
+ s/[$]LINENO.*/&-/
+ t lineno
+ b
+ :lineno
N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ :loop
+ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
+ s/-\n.*//
' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
- { (exit 1); exit 1; }; }
+ chmod +x "$as_me.lineno" ||
+ { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+ # already done that, so ensure we don't try to do so again and fall
+ # in an infinite loop. This has already happened in practice.
+ _as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
+ # original and so on. Autoconf is especially sensitive to this).
+ . "./$as_me.lineno"
# Exit status is that of the last command.
exit
}
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+ case `echo 'xy\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
else
- as_expr=false
+ rm -f conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -pR'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -pR'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
+ as_ln_s='cp -pR'
fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-as_executable_p="test -f"
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -231,89 +554,249 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
# Name of the host.
-# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
-exec 6>&1
-
#
# Initializations.
#
ac_default_prefix=/usr/local
+ac_clean_files=
ac_config_libobj_dir=.
+LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
-
-# Maximum number of lines to put in a shell here document.
-# This variable seems obsolete. It should probably be removed, and
-# only ac_max_sed_lines should be used.
-: ${ac_max_here_lines=38}
# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
-PACKAGE_VERSION='8.6'
-PACKAGE_STRING='tcl 8.6'
+PACKAGE_VERSION='8.7'
+PACKAGE_STRING='tcl 8.7'
PACKAGE_BUGREPORT=''
+PACKAGE_URL=''
# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
-#if HAVE_SYS_TYPES_H
+#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
-#if HAVE_SYS_STAT_H
+#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
-#if STDC_HEADERS
+#ifdef STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
-# if HAVE_STDLIB_H
+# ifdef HAVE_STDLIB_H
# include <stdlib.h>
# endif
#endif
-#if HAVE_STRING_H
-# if !STDC_HEADERS && HAVE_MEMORY_H
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
# include <memory.h>
# endif
# include <string.h>
#endif
-#if HAVE_STRINGS_H
+#ifdef HAVE_STRINGS_H
# include <strings.h>
#endif
-#if HAVE_INTTYPES_H
+#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
-#else
-# if HAVE_STDINT_H
-# include <stdint.h>
-# endif
#endif
-#if HAVE_UNISTD_H
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAN_FLAGS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP TCL_THREADS TCLSH_PROG ZLIB_OBJS ZLIB_SRCS ZLIB_INCLUDE RANLIB ac_ct_RANLIB AR ac_ct_AR LIBOBJS TCL_LIBS DL_LIBS DL_OBJS PLAT_OBJS PLAT_SRCS LDAIX_SRC CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING LDFLAGS_DEBUG LDFLAGS_OPTIMIZE CC_SEARCH_FLAGS LD_SEARCH_FLAGS STLIB_LD SHLIB_LD TCL_SHLIB_LD_EXTRAS TK_SHLIB_LD_EXTRAS SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX MAKE_LIB MAKE_STUB_LIB INSTALL_LIB DLL_INSTALL_DIR INSTALL_STUB_LIB CFLAGS_DEFAULT LDFLAGS_DEFAULT DTRACE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL TCL_YEAR PKG_CFG_ARGS TCL_LIB_FILE TCL_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_SRC_DIR CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX TCL_SHARED_BUILD LD_LIBRARY_PATH_VAR TCL_BUILD_LIB_SPEC TCL_LIB_VERSIONS_OK TCL_SHARED_LIB_SUFFIX TCL_UNSHARED_LIB_SUFFIX TCL_HAS_LONGLONG INSTALL_TZDATA DTRACE_SRC DTRACE_HDR DTRACE_OBJ MAKEFILE_SHELL BUILD_DLTEST TCL_PACKAGE_PATH TCL_MODULE_PATH TCL_LIBRARY PRIVATE_INCLUDE_DIR HTML_DIR PACKAGE_DIR EXTRA_CC_SWITCHES EXTRA_APP_CC_SWITCHES EXTRA_INSTALL EXTRA_INSTALL_BINARIES EXTRA_BUILD_HTML EXTRA_TCLSH_LIBS DLTEST_LD DLTEST_SUFFIX'
+ac_subst_vars='DLTEST_SUFFIX
+DLTEST_LD
+EXTRA_TCLSH_LIBS
+EXTRA_BUILD_HTML
+EXTRA_INSTALL_BINARIES
+EXTRA_INSTALL
+EXTRA_APP_CC_SWITCHES
+EXTRA_CC_SWITCHES
+PACKAGE_DIR
+HTML_DIR
+PRIVATE_INCLUDE_DIR
+TCL_LIBRARY
+TCL_MODULE_PATH
+TCL_PACKAGE_PATH
+BUILD_DLTEST
+MAKEFILE_SHELL
+DTRACE_OBJ
+DTRACE_HDR
+DTRACE_SRC
+INSTALL_TZDATA
+TCL_HAS_LONGLONG
+TCL_UNSHARED_LIB_SUFFIX
+TCL_SHARED_LIB_SUFFIX
+TCL_LIB_VERSIONS_OK
+TCL_BUILD_LIB_SPEC
+LD_LIBRARY_PATH_VAR
+TCL_SHARED_BUILD
+CFG_TCL_UNSHARED_LIB_SUFFIX
+CFG_TCL_SHARED_LIB_SUFFIX
+TCL_SRC_DIR
+TCL_BUILD_STUB_LIB_PATH
+TCL_BUILD_STUB_LIB_SPEC
+TCL_INCLUDE_SPEC
+TCL_STUB_LIB_PATH
+TCL_STUB_LIB_SPEC
+TCL_STUB_LIB_FLAG
+TCL_STUB_LIB_FILE
+TCL_LIB_SPEC
+TCL_LIB_FLAG
+TCL_LIB_FILE
+PKG_CFG_ARGS
+TCL_YEAR
+TCL_PATCH_LEVEL
+TCL_MINOR_VERSION
+TCL_MAJOR_VERSION
+TCL_VERSION
+INSTALL_MSGS
+INSTALL_LIBRARIES
+TCL_ZIP_FILE
+ZIPFS_BUILD
+ZIP_INSTALL_OBJS
+ZIP_PROG_VFSSEARCH
+ZIP_PROG_OPTIONS
+ZIP_PROG
+EXEEXT_FOR_BUILD
+CC_FOR_BUILD
+DTRACE
+LDFLAGS_DEFAULT
+CFLAGS_DEFAULT
+INSTALL_STUB_LIB
+DLL_INSTALL_DIR
+INSTALL_LIB
+MAKE_STUB_LIB
+MAKE_LIB
+SHLIB_SUFFIX
+SHLIB_CFLAGS
+SHLIB_LD_LIBS
+TK_SHLIB_LD_EXTRAS
+TCL_SHLIB_LD_EXTRAS
+SHLIB_LD
+STLIB_LD
+LD_SEARCH_FLAGS
+CC_SEARCH_FLAGS
+LDFLAGS_OPTIMIZE
+LDFLAGS_DEBUG
+CFLAGS_WARNING
+CFLAGS_OPTIMIZE
+CFLAGS_DEBUG
+LDAIX_SRC
+PLAT_SRCS
+PLAT_OBJS
+DL_OBJS
+DL_LIBS
+TCL_LIBS
+LIBOBJS
+AR
+RANLIB
+ZLIB_INCLUDE
+ZLIB_SRCS
+ZLIB_OBJS
+TCLSH_PROG
+SHARED_BUILD
+EGREP
+GREP
+CPP
+OBJEXT
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+CC
+MAN_FLAGS
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL
+OBJEXT_FOR_BUILD'
ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+enable_man_symlinks
+enable_man_compression
+enable_man_suffix
+with_encoding
+enable_shared
+enable_64bit
+enable_64bit_vis
+enable_rpath
+enable_corefoundation
+enable_load
+enable_symbols
+enable_langinfo
+enable_dll_unloading
+with_tzdata
+enable_dtrace
+enable_zipfs
+enable_framework
+'
+ ac_precious_vars='build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP'
+
# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
@@ -336,34 +819,49 @@ x_libraries=NONE
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
-datadir='${prefix}/share'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
ac_prev=
+ac_dashdash=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
- eval "$ac_prev=\$ac_option"
+ eval $ac_prev=\$ac_option
ac_prev=
continue
fi
- ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+ case $ac_option in
+ *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+ *=) ac_optarg= ;;
+ *) ac_optarg=yes ;;
+ esac
# Accept the important Cygnus configure options, so we can diagnose typos.
- case $ac_option in
+ case $ac_dashdash$ac_option in
+ --)
+ ac_dashdash=yes ;;
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
@@ -385,33 +883,59 @@ do
--config-cache | -C)
cache_file=config.cache ;;
- -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ -datadir | --datadir | --datadi | --datad)
ac_prev=datadir ;;
- -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
- | --da=*)
+ -datadir=* | --datadir=* | --datadi=* | --datad=*)
datadir=$ac_optarg ;;
+ -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+ | --dataroo | --dataro | --datar)
+ ac_prev=datarootdir ;;
+ -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+ datarootdir=$ac_optarg ;;
+
-disable-* | --disable-*)
- ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- eval "enable_$ac_feature=no" ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval enable_$ac_useropt=no ;;
+
+ -docdir | --docdir | --docdi | --doc | --do)
+ ac_prev=docdir ;;
+ -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+ docdir=$ac_optarg ;;
+
+ -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+ ac_prev=dvidir ;;
+ -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+ dvidir=$ac_optarg ;;
-enable-* | --enable-*)
- ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
esac
- eval "enable_$ac_feature='$ac_optarg'" ;;
+ eval enable_$ac_useropt=\$ac_optarg ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -438,6 +962,12 @@ do
-host=* | --host=* | --hos=* | --ho=*)
host_alias=$ac_optarg ;;
+ -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+ ac_prev=htmldir ;;
+ -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+ | --ht=*)
+ htmldir=$ac_optarg ;;
+
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
@@ -462,13 +992,16 @@ do
| --libexe=* | --libex=* | --libe=*)
libexecdir=$ac_optarg ;;
+ -localedir | --localedir | --localedi | --localed | --locale)
+ ac_prev=localedir ;;
+ -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+ localedir=$ac_optarg ;;
+
-localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst \
- | --locals | --local | --loca | --loc | --lo)
+ | --localstate | --localstat | --localsta | --localst | --locals)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* \
- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
@@ -533,6 +1066,16 @@ do
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
+ -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+ ac_prev=pdfdir ;;
+ -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+ pdfdir=$ac_optarg ;;
+
+ -psdir | --psdir | --psdi | --psd | --ps)
+ ac_prev=psdir ;;
+ -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+ psdir=$ac_optarg ;;
+
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
@@ -583,26 +1126,36 @@ do
ac_init_version=: ;;
-with-* | --with-*)
- ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
esac
- eval "with_$ac_package='$ac_optarg'" ;;
+ eval with_$ac_useropt=\$ac_optarg ;;
-without-* | --without-*)
- ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/-/_/g'`
- eval "with_$ac_package=no" ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval with_$ac_useropt=no ;;
--x)
# Obsolete; use --with-x.
@@ -622,27 +1175,26 @@ do
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries=$ac_optarg ;;
- -*) { echo "$as_me: error: unrecognized option: $ac_option
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; }
+ -*) as_fn_error $? "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information"
;;
*=*)
ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
# Reject names that are not valid shell variable names.
- expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
- { (exit 1); exit 1; }; }
- ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
- eval "$ac_envvar='$ac_optarg'"
+ case $ac_envvar in #(
+ '' | [0-9]* | *[!_$as_cr_alnum]* )
+ as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
+ esac
+ eval $ac_envvar=\$ac_optarg
export $ac_envvar ;;
*)
# FIXME: should be removed in autoconf 3.0.
- echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- echo "$as_me: WARNING: invalid host type: $ac_option" >&2
- : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
;;
esac
@@ -650,31 +1202,36 @@ done
if test -n "$ac_prev"; then
ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- { echo "$as_me: error: missing argument to $ac_option" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error $? "missing argument to $ac_option"
fi
-# Be sure to have absolute paths.
-for ac_var in exec_prefix prefix
-do
- eval ac_val=$`echo $ac_var`
- case $ac_val in
- [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+if test -n "$ac_unrecognized_opts"; then
+ case $enable_option_checking in
+ no) ;;
+ fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
+ *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
esac
-done
+fi
-# Be sure to have absolute paths.
-for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
- localstatedir libdir includedir oldincludedir infodir mandir
+# Check all directory arguments for consistency.
+for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
+ datadir sysconfdir sharedstatedir localstatedir includedir \
+ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+ libdir localedir mandir
do
- eval ac_val=$`echo $ac_var`
+ eval ac_val=\$$ac_var
+ # Remove trailing slashes.
+ case $ac_val in
+ */ )
+ ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+ eval $ac_var=\$ac_val;;
+ esac
+ # Be sure to have absolute directory names.
case $ac_val in
- [\\/$]* | ?:[\\/]* ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+ [\\/$]* | ?:[\\/]* ) continue;;
+ NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
esac
+ as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done
# There might be people who depend on the old broken behavior: `$host'
@@ -688,8 +1245,6 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used." >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@@ -701,74 +1256,72 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias-
test "$silent" = yes && exec 6>/dev/null
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+ as_fn_error $? "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+ as_fn_error $? "pwd does not report name of working directory"
+
+
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
- # Try the directory containing this script, then its parent.
- ac_confdir=`(dirname "$0") 2>/dev/null ||
-$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$0" : 'X\(//\)[^/]' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$0" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ # Try the directory containing this script, then the parent directory.
+ ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_myself" : 'X\(//\)[^/]' \| \
+ X"$as_myself" : 'X\(//\)$' \| \
+ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
srcdir=$ac_confdir
- if test ! -r $srcdir/$ac_unique_file; then
+ if test ! -r "$srcdir/$ac_unique_file"; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
- { (exit 1); exit 1; }; }
- else
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
- { (exit 1); exit 1; }; }
- fi
-fi
-(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
- { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
- { (exit 1); exit 1; }; }
-srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
-ac_env_build_alias_set=${build_alias+set}
-ac_env_build_alias_value=$build_alias
-ac_cv_env_build_alias_set=${build_alias+set}
-ac_cv_env_build_alias_value=$build_alias
-ac_env_host_alias_set=${host_alias+set}
-ac_env_host_alias_value=$host_alias
-ac_cv_env_host_alias_set=${host_alias+set}
-ac_cv_env_host_alias_value=$host_alias
-ac_env_target_alias_set=${target_alias+set}
-ac_env_target_alias_value=$target_alias
-ac_cv_env_target_alias_set=${target_alias+set}
-ac_cv_env_target_alias_value=$target_alias
-ac_env_CC_set=${CC+set}
-ac_env_CC_value=$CC
-ac_cv_env_CC_set=${CC+set}
-ac_cv_env_CC_value=$CC
-ac_env_CFLAGS_set=${CFLAGS+set}
-ac_env_CFLAGS_value=$CFLAGS
-ac_cv_env_CFLAGS_set=${CFLAGS+set}
-ac_cv_env_CFLAGS_value=$CFLAGS
-ac_env_LDFLAGS_set=${LDFLAGS+set}
-ac_env_LDFLAGS_value=$LDFLAGS
-ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
-ac_cv_env_LDFLAGS_value=$LDFLAGS
-ac_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_env_CPPFLAGS_value=$CPPFLAGS
-ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_cv_env_CPPFLAGS_value=$CPPFLAGS
-ac_env_CPP_set=${CPP+set}
-ac_env_CPP_value=$CPP
-ac_cv_env_CPP_set=${CPP+set}
-ac_cv_env_CPP_value=$CPP
+if test ! -r "$srcdir/$ac_unique_file"; then
+ test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+ as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
+ pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+ srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+ eval ac_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_env_${ac_var}_value=\$${ac_var}
+ eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
#
# Report the --help message.
@@ -777,7 +1330,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures tcl 8.6 to adapt to many kinds of systems.
+\`configure' configures tcl 8.7 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -791,20 +1344,17 @@ Configuration:
--help=short display options specific to this package
--help=recursive display the short help of all the included packages
-V, --version display version information and exit
- -q, --quiet, --silent do not print \`checking...' messages
+ -q, --quiet, --silent do not print \`checking ...' messages
--cache-file=FILE cache test results in FILE [disabled]
-C, --config-cache alias for \`--cache-file=config.cache'
-n, --no-create do not create output files
--srcdir=DIR find the sources in DIR [configure dir or \`..']
-_ACEOF
-
- cat <<_ACEOF
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
+ [$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
+ [PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
@@ -814,18 +1364,25 @@ for instance \`--prefix=\$HOME'.
For better control, use the options below.
Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --datadir=DIR read-only architecture-independent data [PREFIX/share]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --infodir=DIR info documentation [PREFIX/info]
- --mandir=DIR man documentation [PREFIX/man]
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
+ --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
+ --infodir=DIR info documentation [DATAROOTDIR/info]
+ --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
+ --mandir=DIR man documentation [DATAROOTDIR/man]
+ --docdir=DIR documentation root [DATAROOTDIR/doc/tcl]
+ --htmldir=DIR html documentation [DOCDIR]
+ --dvidir=DIR dvi documentation [DOCDIR]
+ --pdfdir=DIR pdf documentation [DOCDIR]
+ --psdir=DIR ps documentation [DOCDIR]
_ACEOF
cat <<\_ACEOF
@@ -834,11 +1391,12 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of tcl 8.6:";;
+ short | recursive ) echo "Configuration of tcl 8.7:";;
esac
cat <<\_ACEOF
Optional Features:
+ --disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
--enable-man-symlinks use symlinks for the manpages (default: off)
@@ -848,7 +1406,6 @@ Optional Features:
use STRING as a suffix to manpage file names
(default: no, tcl if enabled without
specifying STRING)
- --enable-threads build with threads (default: on)
--enable-shared build and link with shared libraries (default: on)
--enable-64bit enable 64bit support (default: off)
--enable-64bit-vis enable 64bit Sparc VIS support (default: off)
@@ -861,6 +1418,7 @@ Optional Features:
startup, otherwise use old heuristic (default: on)
--enable-dll-unloading enable the 'unload' command (default: on)
--enable-dtrace build with DTrace support (default: off)
+ --enable-zipfs build with Zipfs support (default: on)
--enable-framework package shared libraries in MacOSX frameworks
(default: off)
@@ -876,128 +1434,606 @@ Some influential environment variables:
CFLAGS C compiler flags
LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
nonstandard directory <lib dir>
- CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
- headers in a nonstandard directory <include dir>
+ LIBS libraries to pass to the linker, e.g. -l<library>
+ CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
+ you have headers in a nonstandard directory <include dir>
CPP C preprocessor
Use these variables to override the choices made by `configure' or to help
it to find libraries and programs with nonstandard names/locations.
+Report bugs to the package provider.
_ACEOF
+ac_status=$?
fi
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
- ac_popdir=`pwd`
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d $ac_dir || continue
+ test -d "$ac_dir" ||
+ { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+ continue
ac_builddir=.
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
- cd $ac_dir
- # Check for guested configure; otherwise get Cygnus style configure.
- if test -f $ac_srcdir/configure.gnu; then
- echo
- $SHELL $ac_srcdir/configure.gnu --help=recursive
- elif test -f $ac_srcdir/configure; then
- echo
- $SHELL $ac_srcdir/configure --help=recursive
- elif test -f $ac_srcdir/configure.ac ||
- test -f $ac_srcdir/configure.in; then
- echo
- $ac_configure --help
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+ cd "$ac_dir" || { ac_status=$?; continue; }
+ # Check for guested configure.
+ if test -f "$ac_srcdir/configure.gnu"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+ elif test -f "$ac_srcdir/configure"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure" --help=recursive
else
- echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
- fi
- cd $ac_popdir
+ $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi || ac_status=$?
+ cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
-test -n "$ac_init_help" && exit 0
+test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-tcl configure 8.6
-generated by GNU Autoconf 2.59
+tcl configure 8.7
+generated by GNU Autoconf 2.69
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
- exit 0
+ exit
fi
-exec 5>config.log
-cat >&5 <<_ACEOF
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext
+ if { { ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compile") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext conftest$ac_exeext
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest$ac_exeext && {
+ test "$cross_compiling" = yes ||
+ test -x conftest$ac_exeext
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+ # interfere with the next link command; also delete a directory that is
+ # left behind by Apple's compiler. We do this before executing the actions.
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } > conftest.i && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists, giving a warning if it cannot be compiled using
+# the include files in INCLUDES and setting the cache variable VAR
+# accordingly.
+ac_fn_c_check_header_mongrel ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if eval \${$3+:} false; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+else
+ # Is the header compilable?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5
+$as_echo_n "checking $2 usability... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_header_compiler=yes
+else
+ ac_header_compiler=no
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5
+$as_echo "$ac_header_compiler" >&6; }
+
+# Is the header present?
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5
+$as_echo_n "checking $2 presence... " >&6; }
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <$2>
+_ACEOF
+if ac_fn_c_try_cpp "$LINENO"; then :
+ ac_header_preproc=yes
+else
+ ac_header_preproc=no
+fi
+rm -f conftest.err conftest.i conftest.$ac_ext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5
+$as_echo "$ac_header_preproc" >&6; }
+
+# So? What about this header?
+case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #((
+ yes:no: )
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5
+$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+ ;;
+ no:yes:* )
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5
+$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5
+$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5
+$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5
+$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5
+$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;}
+ ;;
+esac
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ eval "$3=\$ac_header_compiler"
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+fi
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_mongrel
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+ { { case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_try") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: program exited with status $ac_status" >&5
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=$ac_status
+fi
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_compile
+
+# ac_fn_c_check_func LINENO FUNC VAR
+# ----------------------------------
+# Tests whether FUNC exists, setting the cache variable VAR accordingly
+ac_fn_c_check_func ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+/* Define $2 to an innocuous variant, in case <limits.h> declares $2.
+ For example, HP-UX 11i <limits.h> declares gettimeofday. */
+#define $2 innocuous_$2
+
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $2 (); below.
+ Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
+ <limits.h> exists even on freestanding compilers. */
+
+#ifdef __STDC__
+# include <limits.h>
+#else
+# include <assert.h>
+#endif
+
+#undef $2
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
+#ifdef __cplusplus
+extern "C"
+#endif
+char $2 ();
+/* 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_$2 || defined __stub___$2
+choke me
+#endif
+
+int
+main ()
+{
+return $2 ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_func
+
+# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
+# ---------------------------------------------
+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
+# accordingly.
+ac_fn_c_check_decl ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ as_decl_name=`echo $2|sed 's/ *(.*//'`
+ as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
+$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+#ifndef $as_decl_name
+#ifdef __cplusplus
+ (void) $as_decl_use;
+#else
+ (void) $as_decl_name;
+#endif
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_decl
+
+# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
+# -------------------------------------------
+# Tests whether TYPE exists after having included INCLUDES, setting cache
+# variable VAR accordingly.
+ac_fn_c_check_type ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ eval "$3=no"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+if (sizeof ($2))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+if (sizeof (($2)))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+ eval "$3=yes"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_type
+
+# ac_fn_c_check_member LINENO AGGR MEMBER VAR INCLUDES
+# ----------------------------------------------------
+# Tries to find if the field MEMBER exists in type AGGR, after including
+# INCLUDES, setting cache variable VAR accordingly.
+ac_fn_c_check_member ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5
+$as_echo_n "checking for $2.$3... " >&6; }
+if eval \${$4+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$5
+int
+main ()
+{
+static $2 ac_aggr;
+if (sizeof ac_aggr.$3)
+return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$4=yes"
+else
+ eval "$4=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$4
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_member
+cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by tcl $as_me 8.6, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+It was created by tcl $as_me 8.7, which was
+generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
_ACEOF
+exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
@@ -1016,7 +2052,7 @@ uname -v = `(uname -v) 2>/dev/null || echo unknown`
/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
-hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`
/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
@@ -1028,8 +2064,9 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- echo "PATH: $as_dir"
-done
+ $as_echo "PATH: $as_dir"
+ done
+IFS=$as_save_IFS
} >&5
@@ -1051,7 +2088,6 @@ _ACEOF
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
-ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
@@ -1062,13 +2098,13 @@ do
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
continue ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*)
+ ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
- 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
2)
- ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ as_fn_append ac_configure_args1 " '$ac_arg'"
if test $ac_must_keep_next = true; then
ac_must_keep_next=false # Got value, back to normal.
else
@@ -1084,104 +2120,115 @@ do
-* ) ac_must_keep_next=true ;;
esac
fi
- ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
- # Get rid of the leading space.
- ac_sep=" "
+ as_fn_append ac_configure_args " '$ac_arg'"
;;
esac
done
done
-$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
-$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
# would cause problems or look ugly.
-# WARNING: Be sure not to use single quotes in there, as some shells,
-# such as our DU 5.0 friend, will then `close' the trap.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
# Save into config.log some information that might help in debugging.
{
echo
- cat <<\_ASBOX
-## ---------------- ##
+ $as_echo "## ---------------- ##
## Cache variables. ##
-## ---------------- ##
-_ASBOX
+## ---------------- ##"
echo
# The following way of writing the cache mishandles newlines in values,
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
+ esac ;;
+ esac
+ done
(set) 2>&1 |
- case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
+ case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
sed -n \
- "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
- ;;
+ "s/'\''/'\''\\\\'\'''\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+ ;; #(
*)
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-}
+ esac |
+ sort
+)
echo
- cat <<\_ASBOX
-## ----------------- ##
+ $as_echo "## ----------------- ##
## Output variables. ##
-## ----------------- ##
-_ASBOX
+## ----------------- ##"
echo
for ac_var in $ac_subst_vars
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
if test -n "$ac_subst_files"; then
- cat <<\_ASBOX
-## ------------- ##
-## Output files. ##
-## ------------- ##
-_ASBOX
+ $as_echo "## ------------------- ##
+## File substitutions. ##
+## ------------------- ##"
echo
for ac_var in $ac_subst_files
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
fi
if test -s confdefs.h; then
- cat <<\_ASBOX
-## ----------- ##
+ $as_echo "## ----------- ##
## confdefs.h. ##
-## ----------- ##
-_ASBOX
+## ----------- ##"
echo
- sed "/^$/d" confdefs.h | sort
+ cat confdefs.h
echo
fi
test "$ac_signal" != 0 &&
- echo "$as_me: caught signal $ac_signal"
- echo "$as_me: exit $exit_status"
+ $as_echo "$as_me: caught signal $ac_signal"
+ $as_echo "$as_me: exit $exit_status"
} >&5
- rm -f core *.core &&
- rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ rm -f core *.core core.conftest.* &&
+ rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
- ' 0
+' 0
for ac_signal in 1 2 13 15; do
- trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+ trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo >confdefs.h
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
# Predefined preprocessor variables.
@@ -1189,112 +2236,137 @@ cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
# Let the site file select an alternate cache file if it wants to.
-# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+ # We do not want a PATH search for config.site.
+ case $CONFIG_SITE in #((
+ -*) ac_site_file1=./$CONFIG_SITE;;
+ */*) ac_site_file1=$CONFIG_SITE;;
+ *) ac_site_file1=./$CONFIG_SITE;;
+ esac
+elif test "x$prefix" != xNONE; then
+ ac_site_file1=$prefix/share/config.site
+ ac_site_file2=$prefix/etc/config.site
+else
+ ac_site_file1=$ac_default_prefix/share/config.site
+ ac_site_file2=$ac_default_prefix/etc/config.site
fi
-for ac_site_file in $CONFIG_SITE; do
- if test -r "$ac_site_file"; then
- { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
-echo "$as_me: loading site script $ac_site_file" >&6;}
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+ test "x$ac_site_file" = xNONE && continue
+ if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
sed 's/^/| /' "$ac_site_file" >&5
- . "$ac_site_file"
+ . "$ac_site_file" \
+ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "failed to load site script $ac_site_file
+See \`config.log' for more details" "$LINENO" 5; }
fi
done
if test -r "$cache_file"; then
- # Some versions of bash will fail to source /dev/null (special
- # files actually), so we avoid doing that.
- if test -f "$cache_file"; then
- { echo "$as_me:$LINENO: loading cache $cache_file" >&5
-echo "$as_me: loading cache $cache_file" >&6;}
+ # Some versions of bash will fail to source /dev/null (special files
+ # actually), so we avoid doing that. DJGPP emulates it as a regular file.
+ if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
- [\\/]* | ?:[\\/]* ) . $cache_file;;
- *) . ./$cache_file;;
+ [\\/]* | ?:[\\/]* ) . "$cache_file";;
+ *) . "./$cache_file";;
esac
fi
else
- { echo "$as_me:$LINENO: creating cache $cache_file" >&5
-echo "$as_me: creating cache $cache_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
-for ac_var in `(set) 2>&1 |
- sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+for ac_var in $ac_precious_vars; do
eval ac_old_set=\$ac_cv_env_${ac_var}_set
eval ac_new_set=\$ac_env_${ac_var}_set
- eval ac_old_val="\$ac_cv_env_${ac_var}_value"
- eval ac_new_val="\$ac_env_${ac_var}_value"
+ eval ac_old_val=\$ac_cv_env_${ac_var}_value
+ eval ac_new_val=\$ac_env_${ac_var}_value
case $ac_old_set,$ac_new_set in
set,)
- { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
ac_cache_corrupted=: ;;
,set)
- { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
ac_cache_corrupted=: ;;
,);;
*)
if test "x$ac_old_val" != "x$ac_new_val"; then
- { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
-echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
- { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
-echo "$as_me: former value: $ac_old_val" >&2;}
- { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
-echo "$as_me: current value: $ac_new_val" >&2;}
- ac_cache_corrupted=:
+ # differences in whitespace do not lead to failure.
+ ac_old_val_w=`echo x $ac_old_val`
+ ac_new_val_w=`echo x $ac_new_val`
+ if test "$ac_old_val_w" != "$ac_new_val_w"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ ac_cache_corrupted=:
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+ eval $ac_var=\$ac_old_val
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5
+$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5
+$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}
fi;;
esac
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
*" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
- *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) as_fn_append ac_configure_args " '$ac_arg'" ;;
esac
fi
done
if $ac_cache_corrupted; then
- { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
-echo "$as_me: error: changes in the environment can compromise the build" >&2;}
- { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
-echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
- { (exit 1); exit 1; }; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -1307,35 +2379,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-TCL_VERSION=8.6
+TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".9"
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
@@ -1382,62 +2429,60 @@ TCL_SRC_DIR="`cd "$srcdir"/..; pwd`"
#------------------------------------------------------------------------
- echo "$as_me:$LINENO: checking whether to use symlinks for manpages" >&5
-echo $ECHO_N "checking whether to use symlinks for manpages... $ECHO_C" >&6
- # 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" && MAN_FLAGS="$MAN_FLAGS --symlinks"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use symlinks for manpages" >&5
+$as_echo_n "checking whether to use symlinks for manpages... " >&6; }
+ # Check whether --enable-man-symlinks was given.
+if test "${enable_man_symlinks+set}" = set; then :
+ enableval=$enable_man_symlinks; test "$enableval" != "no" && MAN_FLAGS="$MAN_FLAGS --symlinks"
else
enableval="no"
-fi;
- echo "$as_me:$LINENO: result: $enableval" >&5
-echo "${ECHO_T}$enableval" >&6
-
- echo "$as_me:$LINENO: checking whether to compress the manpages" >&5
-echo $ECHO_N "checking whether to compress the manpages... $ECHO_C" >&6
- # Check whether --enable-man-compression or --disable-man-compression was given.
-if test "${enable_man_compression+set}" = set; then
- enableval="$enable_man_compression"
- case $enableval in
- yes) { { echo "$as_me:$LINENO: error: missing argument to --enable-man-compression" >&5
-echo "$as_me: error: missing argument to --enable-man-compression" >&2;}
- { (exit 1); exit 1; }; };;
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
+$as_echo "$enableval" >&6; }
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to compress the manpages" >&5
+$as_echo_n "checking whether to compress the manpages... " >&6; }
+ # Check whether --enable-man-compression was given.
+if test "${enable_man_compression+set}" = set; then :
+ enableval=$enable_man_compression; case $enableval in
+ yes) as_fn_error $? "missing argument to --enable-man-compression" "$LINENO" 5;;
no) ;;
*) MAN_FLAGS="$MAN_FLAGS --compress $enableval";;
esac
else
enableval="no"
-fi;
- echo "$as_me:$LINENO: result: $enableval" >&5
-echo "${ECHO_T}$enableval" >&6
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
+$as_echo "$enableval" >&6; }
if test "$enableval" != "no"; then
- echo "$as_me:$LINENO: checking for compressed file suffix" >&5
-echo $ECHO_N "checking for compressed file suffix... $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for compressed file suffix" >&5
+$as_echo_n "checking for compressed file suffix... " >&6; }
touch TeST
$enableval TeST
Z=`ls TeST* | sed 's/^....//'`
rm -f TeST*
MAN_FLAGS="$MAN_FLAGS --extension $Z"
- echo "$as_me:$LINENO: result: $Z" >&5
-echo "${ECHO_T}$Z" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $Z" >&5
+$as_echo "$Z" >&6; }
fi
- echo "$as_me:$LINENO: checking whether to add a package name suffix for the manpages" >&5
-echo $ECHO_N "checking whether to add a package name suffix for the manpages... $ECHO_C" >&6
- # Check whether --enable-man-suffix or --disable-man-suffix was given.
-if test "${enable_man_suffix+set}" = set; then
- enableval="$enable_man_suffix"
- case $enableval in
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to add a package name suffix for the manpages" >&5
+$as_echo_n "checking whether to add a package name suffix for the manpages... " >&6; }
+ # Check whether --enable-man-suffix was given.
+if test "${enable_man_suffix+set}" = set; then :
+ enableval=$enable_man_suffix; case $enableval in
yes) enableval="tcl" MAN_FLAGS="$MAN_FLAGS --suffix $enableval";;
no) ;;
*) MAN_FLAGS="$MAN_FLAGS --suffix $enableval";;
esac
else
enableval="no"
-fi;
- echo "$as_me:$LINENO: result: $enableval" >&5
-echo "${ECHO_T}$enableval" >&6
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $enableval" >&5
+$as_echo "$enableval" >&6; }
@@ -1460,10 +2505,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1473,35 +2518,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_CC"; then
ac_ct_CC=$CC
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -1511,39 +2558,50 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- CC=$ac_ct_CC
+ if test "x$ac_ct_CC" = x; then
+ CC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ CC=$ac_ct_CC
+ fi
else
CC="$ac_cv_prog_CC"
fi
if test -z "$CC"; then
- if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1553,77 +2611,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
-fi
-if test -z "$ac_cv_prog_CC"; then
- ac_ct_CC=$CC
- # Extract the first word of "cc", so it can be a program name with args.
-set dummy cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$ac_ct_CC"; then
- ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-ac_ct_CC=$ac_cv_prog_ac_ct_CC
-if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
- CC=$ac_ct_CC
-else
- CC="$ac_cv_prog_CC"
-fi
+ fi
fi
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 "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1634,18 +2652,19 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
@@ -1663,24 +2682,25 @@ fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$CC"; then
if test -n "$ac_tool_prefix"; then
- for ac_prog in cl
+ for ac_prog in cl.exe
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1690,39 +2710,41 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
test -n "$CC" && break
done
fi
if test -z "$CC"; then
ac_ct_CC=$CC
- for ac_prog in cl
+ for ac_prog in cl.exe
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -1732,66 +2754,78 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
test -n "$ac_ct_CC" && break
done
- CC=$ac_ct_CC
+ if test "x$ac_ct_CC" = x; then
+ CC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ CC=$ac_ct_CC
+ fi
fi
fi
-test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&5
-echo "$as_me: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
# Provide some information about the compiler.
-echo "$as_me:$LINENO:" \
- "checking for C compiler version" >&5
-ac_compiler=`set X $ac_compile; echo $2`
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
- (eval $ac_compiler --version </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
- (eval $ac_compiler -v </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
- (eval $ac_compiler -V </dev/null >&5) 2>&5
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+ { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
+ if test -s conftest.err; then
+ sed '10a\
+... rest of stderr output deleted ...
+ 10q' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ fi
+ rm -f conftest.er1 conftest.err
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+done
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -1803,112 +2837,108 @@ main ()
}
_ACEOF
ac_clean_files_save=$ac_clean_files
-ac_clean_files="$ac_clean_files a.out a.exe b.out"
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
-echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
-echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
-ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
-if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
- (eval $ac_link_default) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- # Find the output, starting from the most likely. This scheme is
-# not robust to junk in `.', hence go to wildcards (a.*) only as a last
-# resort.
-
-# Be careful to initialize this variable, since it used to be cached.
-# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
-ac_cv_exeext=
-# b.out is created by i960 compilers.
-for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+ * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+ esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link_default") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
+ # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile. We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
- ;;
- conftest.$ac_ext )
- # This is the source file.
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
;;
[ab].out )
# We found the default executable, but exeext='' is most
# certainly right.
break;;
*.* )
- ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- # FIXME: I believe we export ac_cv_exeext for Libtool,
- # but it would be cool to find out if it's true. Does anybody
- # maintain Libtool? --akim.
- export ac_cv_exeext
+ if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+ then :; else
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ fi
+ # We set ac_cv_exeext here because the later test for it is not
+ # safe: cross compilers may not add the suffix if given an `-o'
+ # argument, so we may need to know it at that point already.
+ # Even if this section looks crufty: it has the advantage of
+ # actually working.
break;;
* )
break;;
esac
done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
else
- echo "$as_me: failed program was:" >&5
+ ac_file=''
+fi
+if test -z "$ac_file"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
-See \`config.log' for more details." >&5
-echo "$as_me: error: C compiler cannot create executables
-See \`config.log' for more details." >&2;}
- { (exit 77); exit 77; }; }
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "C compiler cannot create executables
+See \`config.log' for more details" "$LINENO" 5; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
fi
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
ac_exeext=$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_file" >&5
-echo "${ECHO_T}$ac_file" >&6
-# Check the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether the C compiler works" >&5
-echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
-# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
-# If not cross compiling, check that we can run a simple program.
-if test "$cross_compiling" != yes; then
- if { ac_try='./$ac_file'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- cross_compiling=no
- else
- if test "$cross_compiling" = maybe; then
- cross_compiling=yes
- else
- { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot run C compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
- fi
- fi
-fi
-echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
-
-rm -f a.out a.exe conftest$ac_cv_exeext b.out
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
-# Check the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
-echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
-echo "$as_me:$LINENO: result: $cross_compiling" >&5
-echo "${ECHO_T}$cross_compiling" >&6
-
-echo "$as_me:$LINENO: checking for suffix of executables" >&5
-echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
# If both `conftest.exe' and `conftest' are `present' (well, observable)
# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
# work properly (i.e., refer to `conftest.exe'), while it won't with
@@ -1916,38 +2946,90 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
for ac_file in conftest.exe conftest conftest.*; do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
*.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- export ac_cv_exeext
break;;
* ) break;;
esac
done
else
- { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details" "$LINENO" 5; }
fi
-
-rm -f conftest$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
-echo "${ECHO_T}$ac_cv_exeext" >&6
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
-echo "$as_me:$LINENO: checking for suffix of object files" >&5
-echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
-if test "${ac_cv_objext+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdio.h>
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+ ;
+ return 0;
+}
_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+ { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+ if { ac_try='./conftest$ac_cv_exeext'
+ { { case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_try") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details" "$LINENO" 5; }
+ fi
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if ${ac_cv_objext+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -1959,45 +3041,46 @@ main ()
}
_ACEOF
rm -f conftest.o conftest.obj
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compile") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
+ for ac_file in conftest.o conftest.obj conftest.*; do
+ test -f "$ac_file" || continue;
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
*) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
break;;
esac
done
else
- echo "$as_me: failed program was:" >&5
+ $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details" "$LINENO" 5; }
fi
-
rm -f conftest.$ac_cv_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
-echo "${ECHO_T}$ac_cv_objext" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
-echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
-if test "${ac_cv_c_compiler_gnu+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -2011,55 +3094,34 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
-GCC=`test $ac_compiler_gnu = yes && echo yes`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+ GCC=yes
+else
+ GCC=
+fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
-CFLAGS="-g"
-echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
-echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_g+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_save_c_werror_flag=$ac_c_werror_flag
+ ac_c_werror_flag=yes
+ ac_cv_prog_cc_g=no
+ CFLAGS="-g"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -2070,39 +3132,49 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ CFLAGS=""
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-ac_cv_prog_cc_g=no
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+ ac_c_werror_flag=$ac_save_c_werror_flag
+ CFLAGS="-g"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_prog_cc_g=yes
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ac_c_werror_flag=$ac_save_c_werror_flag
fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; then
CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
@@ -2118,23 +3190,18 @@ else
CFLAGS=
fi
fi
-echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
-echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- ac_cv_prog_cc_stdc=no
+ ac_cv_prog_cc_c89=no
ac_save_CC=$CC
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@@ -2157,12 +3224,17 @@ static char *f (char * (*g) (char **, int), char **p, ...)
/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
function prototypes and stuff, but not '\xHH' hex character constants.
These don't provoke an error unfortunately, instead are silently treated
- as 'x'. The following induces an error, until -std1 is added to get
+ as 'x'. The following induces an error, until -std is added to get
proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
array size at least. It's necessary to write '\x00'==0 to get something
- that's true only with -std1. */
+ that's true only with -std. */
int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+ inside strings and character constants. */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
int test (int i, double x);
struct s1 {int (*f) (int a);};
struct s2 {int (*f) (double a);};
@@ -2177,205 +3249,37 @@ return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
return 0;
}
_ACEOF
-# Don't try gcc -ansi; that turns off useful extensions and
-# breaks some systems' header files.
-# AIX -qlanglvl=ansi
-# Ultrix and OSF/1 -std1
-# HP-UX 10.20 and later -Ae
-# HP-UX older versions -Aa -D_HPUX_SOURCE
-# SVR4 -Xc -D__EXTENSIONS__
-for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
- rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_prog_cc_stdc=$ac_arg
-break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
+ if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_prog_cc_c89=$ac_arg
fi
-rm -f conftest.err conftest.$ac_objext
+rm -f core conftest.err conftest.$ac_objext
+ test "x$ac_cv_prog_cc_c89" != "xno" && break
done
-rm -f conftest.$ac_ext conftest.$ac_objext
+rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
-
-case "x$ac_cv_prog_cc_stdc" in
- x|xno)
- echo "$as_me:$LINENO: result: none needed" >&5
-echo "${ECHO_T}none needed" >&6 ;;
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+ x)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+ xno)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
*)
- echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
- CC="$CC $ac_cv_prog_cc_stdc" ;;
+ CC="$CC $ac_cv_prog_cc_c89"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
+if test "x$ac_cv_prog_cc_c89" != xno; then :
-# Some people use a C++ compiler to compile C. Since we use `exit',
-# in C++ we need to declare it. In case someone uses the same compiler
-# for both compiling C and C++ we need to have the C++ compiler decide
-# the declaration of exit, since it's the most demanding environment.
-cat >conftest.$ac_ext <<_ACEOF
-#ifndef __cplusplus
- choke me
-#endif
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- for ac_declaration in \
- '' \
- 'extern "C" void std::exit (int) throw (); using std::exit;' \
- 'extern "C" void std::exit (int); using std::exit;' \
- 'extern "C" void exit (int) throw ();' \
- 'extern "C" void exit (int);' \
- 'void exit (int);'
-do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_declaration
-#include <stdlib.h>
-int
-main ()
-{
-exit (42);
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-continue
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_declaration
-int
-main ()
-{
-exit (42);
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-done
-rm -f conftest*
-if test -n "$ac_declaration"; then
- echo '#ifdef __cplusplus' >>confdefs.h
- echo $ac_declaration >>confdefs.h
- echo '#endif' >>confdefs.h
-fi
-
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -2383,18 +3287,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking for inline" >&5
-echo $ECHO_N "checking for inline... $ECHO_C" >&6
-if test "${ac_cv_c_inline+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5
+$as_echo_n "checking for inline... " >&6; }
+if ${ac_cv_c_inline+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_cv_c_inline=no
for ac_kw in inline __inline__ __inline; do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifndef __cplusplus
typedef int foo_t;
@@ -2403,41 +3303,16 @@ $ac_kw foo_t foo () {return 0; }
#endif
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_c_inline=$ac_kw; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_c_inline=$ac_kw
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$ac_cv_c_inline" != no && break
done
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5
-echo "${ECHO_T}$ac_cv_c_inline" >&6
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5
+$as_echo "$ac_cv_c_inline" >&6; }
case $ac_cv_c_inline in
inline | yes) ;;
@@ -2455,6 +3330,7 @@ _ACEOF
esac
+
#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files. Special notes:
# - stdlib.h doesn't define strtol, strtoul, or
@@ -2469,15 +3345,15 @@ ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
-echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
fi
if test -z "$CPP"; then
- if test "${ac_cv_prog_CPP+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${ac_cv_prog_CPP+:} false; then :
+ $as_echo_n "(cached) " >&6
else
# Double quotes because CPP needs to be expanded
for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
@@ -2491,11 +3367,7 @@ do
# <limits.h> exists even on freestanding compilers.
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp. "Syntax error" is here to catch this case.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __STDC__
# include <limits.h>
@@ -2504,78 +3376,34 @@ cat >>conftest.$ac_ext <<_ACEOF
#endif
Syntax error
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_cpp "$LINENO"; then :
+else
# Broken: fails on valid input.
continue
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
- # OK, works on sane cases. Now check whether non-existent headers
+ # OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ac_nonexistent.h>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+if ac_fn_c_try_cpp "$LINENO"; then :
# Broken: success on invalid input.
continue
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
# Passes both tests.
ac_preproc_ok=:
break
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
break
fi
@@ -2587,8 +3415,8 @@ fi
else
ac_cv_prog_CPP=$CPP
fi
-echo "$as_me:$LINENO: result: $CPP" >&5
-echo "${ECHO_T}$CPP" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
@@ -2598,11 +3426,7 @@ do
# <limits.h> exists even on freestanding compilers.
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp. "Syntax error" is here to catch this case.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __STDC__
# include <limits.h>
@@ -2611,85 +3435,40 @@ cat >>conftest.$ac_ext <<_ACEOF
#endif
Syntax error
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_cpp "$LINENO"; then :
+else
# Broken: fails on valid input.
continue
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
- # OK, works on sane cases. Now check whether non-existent headers
+ # OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ac_nonexistent.h>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+if ac_fn_c_try_cpp "$LINENO"; then :
# Broken: success on invalid input.
continue
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
# Passes both tests.
ac_preproc_ok=:
break
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then
- :
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
else
- { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." >&5
-echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
fi
ac_ext=c
@@ -2699,31 +3478,142 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking for egrep" >&5
-echo $ECHO_N "checking for egrep... $ECHO_C" >&6
-if test "${ac_cv_prog_egrep+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if ${ac_cv_path_GREP+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if echo a | (grep -E '(a|b)') >/dev/null 2>&1
- then ac_cv_prog_egrep='grep -E'
- else ac_cv_prog_egrep='egrep'
+ if test -z "$GREP"; then
+ ac_path_GREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in grep ggrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+ as_fn_executable_p "$ac_path_GREP" || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+ # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'GREP' >> "conftest.nl"
+ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_GREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_GREP="$ac_path_GREP"
+ ac_path_GREP_max=$ac_count
fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_GREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_GREP"; then
+ as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_GREP=$GREP
+fi
+
fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
-echo "${ECHO_T}$ac_cv_prog_egrep" >&6
- EGREP=$ac_cv_prog_egrep
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
-echo "$as_me:$LINENO: checking for ANSI C header files" >&5
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
-if test "${ac_cv_header_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if ${ac_cv_path_EGREP+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+ then ac_cv_path_EGREP="$GREP -E"
+ else
+ if test -z "$EGREP"; then
+ ac_path_EGREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in egrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+ as_fn_executable_p "$ac_path_EGREP" || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+ # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'EGREP' >> "conftest.nl"
+ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_EGREP="$ac_path_EGREP"
+ ac_path_EGREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_EGREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_EGREP"; then
+ as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_EGREP=$EGREP
+fi
+
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
#include <stdarg.h>
@@ -2738,51 +3628,23 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_header_stdc=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_header_stdc=no
+ ac_cv_header_stdc=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <string.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "memchr" >/dev/null 2>&1; then
- :
+ $EGREP "memchr" >/dev/null 2>&1; then :
+
else
ac_cv_header_stdc=no
fi
@@ -2792,18 +3654,14 @@ 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 <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "free" >/dev/null 2>&1; then
- :
+ $EGREP "free" >/dev/null 2>&1; then :
+
else
ac_cv_header_stdc=no
fi
@@ -2813,16 +3671,13 @@ fi
if test $ac_cv_header_stdc = yes; then
# /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
:
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ctype.h>
+#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
@@ -2842,109 +3697,39 @@ main ()
for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i))
|| toupper (i) != TOUPPER (i))
- exit(2);
- exit (0);
+ return 2;
+ return 0;
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_run "$LINENO"; then :
-( exit $ac_status )
-ac_cv_header_stdc=no
+else
+ ac_cv_header_stdc=no
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
-echo "${ECHO_T}$ac_cv_header_stdc" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define STDC_HEADERS 1
-_ACEOF
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
fi
# On IRIX 5.3, sys/types and inttypes.h are conflicting.
-
-
-
-
-
-
-
-
-
for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
inttypes.h stdint.h unistd.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_Header=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_Header=no"
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
fi
@@ -2953,17 +3738,13 @@ done
- echo "$as_me:$LINENO: checking dirent.h" >&5
-echo $ECHO_N "checking dirent.h... $ECHO_C" >&6
-if test "${tcl_cv_dirent_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking dirent.h" >&5
+$as_echo_n "checking dirent.h... " >&6; }
+if ${tcl_cv_dirent_h+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <dirent.h>
@@ -2993,535 +3774,65 @@ closedir(d);
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_dirent_h=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_dirent_h=no
+ tcl_cv_dirent_h=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_dirent_h" >&5
-echo "${ECHO_T}$tcl_cv_dirent_h" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_dirent_h" >&5
+$as_echo "$tcl_cv_dirent_h" >&6; }
if test $tcl_cv_dirent_h = no; then
-cat >>confdefs.h <<\_ACEOF
-#define NO_DIRENT_H 1
-_ACEOF
+$as_echo "#define NO_DIRENT_H 1" >>confdefs.h
fi
- if test "${ac_cv_header_float_h+set}" = set; then
- echo "$as_me:$LINENO: checking for float.h" >&5
-echo $ECHO_N "checking for float.h... $ECHO_C" >&6
-if test "${ac_cv_header_float_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5
-echo "${ECHO_T}$ac_cv_header_float_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking float.h usability" >&5
-echo $ECHO_N "checking float.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <float.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking float.h presence" >&5
-echo $ECHO_N "checking float.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <float.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: float.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: float.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: float.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: float.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: float.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: float.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: float.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: float.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: float.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: float.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: float.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: float.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: float.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for float.h" >&5
-echo $ECHO_N "checking for float.h... $ECHO_C" >&6
-if test "${ac_cv_header_float_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_float_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_float_h" >&5
-echo "${ECHO_T}$ac_cv_header_float_h" >&6
-
-fi
-if test $ac_cv_header_float_h = yes; then
- :
-else
-
-cat >>confdefs.h <<\_ACEOF
-#define NO_FLOAT_H 1
-_ACEOF
-
-fi
-
-
- if test "${ac_cv_header_values_h+set}" = set; then
- echo "$as_me:$LINENO: checking for values.h" >&5
-echo $ECHO_N "checking for values.h... $ECHO_C" >&6
-if test "${ac_cv_header_values_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5
-echo "${ECHO_T}$ac_cv_header_values_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking values.h usability" >&5
-echo $ECHO_N "checking values.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <values.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking values.h presence" >&5
-echo $ECHO_N "checking values.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <values.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: values.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: values.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: values.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: values.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: values.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: values.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: values.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: values.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: values.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: values.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: values.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: values.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: values.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for values.h" >&5
-echo $ECHO_N "checking for values.h... $ECHO_C" >&6
-if test "${ac_cv_header_values_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_values_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_values_h" >&5
-echo "${ECHO_T}$ac_cv_header_values_h" >&6
-
-fi
-if test $ac_cv_header_values_h = yes; then
- :
-else
-
-cat >>confdefs.h <<\_ACEOF
-#define NO_VALUES_H 1
-_ACEOF
-
-fi
-
-
- if test "${ac_cv_header_stdlib_h+set}" = set; then
- echo "$as_me:$LINENO: checking for stdlib.h" >&5
-echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6
-if test "${ac_cv_header_stdlib_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5
-echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking stdlib.h usability" >&5
-echo $ECHO_N "checking stdlib.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <stdlib.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking stdlib.h presence" >&5
-echo $ECHO_N "checking stdlib.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <stdlib.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: stdlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: stdlib.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: stdlib.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: stdlib.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: stdlib.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: stdlib.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: stdlib.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: stdlib.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: stdlib.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: stdlib.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: stdlib.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: stdlib.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: stdlib.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for stdlib.h" >&5
-echo $ECHO_N "checking for stdlib.h... $ECHO_C" >&6
-if test "${ac_cv_header_stdlib_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_stdlib_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdlib_h" >&5
-echo "${ECHO_T}$ac_cv_header_stdlib_h" >&6
-
-fi
-if test $ac_cv_header_stdlib_h = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default"
+if test "x$ac_cv_header_stdlib_h" = xyes; then :
tcl_ok=1
else
tcl_ok=0
fi
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "strtol" >/dev/null 2>&1; then
- :
+ $EGREP "strtol" >/dev/null 2>&1; then :
+
else
tcl_ok=0
fi
rm -f conftest*
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "strtoul" >/dev/null 2>&1; then
- :
+ $EGREP "strtoul" >/dev/null 2>&1; then :
+
else
tcl_ok=0
fi
rm -f conftest*
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "strtod" >/dev/null 2>&1; then
- :
+ $EGREP "strtod" >/dev/null 2>&1; then :
+
else
tcl_ok=0
fi
@@ -3529,184 +3840,38 @@ rm -f conftest*
if test $tcl_ok = 0; then
-cat >>confdefs.h <<\_ACEOF
-#define NO_STDLIB_H 1
-_ACEOF
+$as_echo "#define NO_STDLIB_H 1" >>confdefs.h
fi
- if test "${ac_cv_header_string_h+set}" = set; then
- echo "$as_me:$LINENO: checking for string.h" >&5
-echo $ECHO_N "checking for string.h... $ECHO_C" >&6
-if test "${ac_cv_header_string_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5
-echo "${ECHO_T}$ac_cv_header_string_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking string.h usability" >&5
-echo $ECHO_N "checking string.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <string.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking string.h presence" >&5
-echo $ECHO_N "checking string.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <string.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: string.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: string.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: string.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: string.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: string.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: string.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: string.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: string.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: string.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: string.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: string.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: string.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: string.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for string.h" >&5
-echo $ECHO_N "checking for string.h... $ECHO_C" >&6
-if test "${ac_cv_header_string_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_string_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_string_h" >&5
-echo "${ECHO_T}$ac_cv_header_string_h" >&6
-
-fi
-if test $ac_cv_header_string_h = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "string.h" "ac_cv_header_string_h" "$ac_includes_default"
+if test "x$ac_cv_header_string_h" = xyes; then :
tcl_ok=1
else
tcl_ok=0
fi
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <string.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "strstr" >/dev/null 2>&1; then
- :
+ $EGREP "strstr" >/dev/null 2>&1; then :
+
else
tcl_ok=0
fi
rm -f conftest*
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <string.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "strerror" >/dev/null 2>&1; then
- :
+ $EGREP "strerror" >/dev/null 2>&1; then :
+
else
tcl_ok=0
fi
@@ -3718,454 +3883,38 @@ rm -f conftest*
if test $tcl_ok = 0; then
-cat >>confdefs.h <<\_ACEOF
-#define NO_STRING_H 1
-_ACEOF
+$as_echo "#define NO_STRING_H 1" >>confdefs.h
fi
- if test "${ac_cv_header_sys_wait_h+set}" = set; then
- echo "$as_me:$LINENO: checking for sys/wait.h" >&5
-echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6
-if test "${ac_cv_header_sys_wait_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5
-echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking sys/wait.h usability" >&5
-echo $ECHO_N "checking sys/wait.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <sys/wait.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/wait.h" "ac_cv_header_sys_wait_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_wait_h" = xyes; then :
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking sys/wait.h presence" >&5
-echo $ECHO_N "checking sys/wait.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <sys/wait.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: sys/wait.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: sys/wait.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: sys/wait.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: sys/wait.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: sys/wait.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: sys/wait.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: sys/wait.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: sys/wait.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for sys/wait.h" >&5
-echo $ECHO_N "checking for sys/wait.h... $ECHO_C" >&6
-if test "${ac_cv_header_sys_wait_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_sys_wait_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_sys_wait_h" >&5
-echo "${ECHO_T}$ac_cv_header_sys_wait_h" >&6
+$as_echo "#define NO_SYS_WAIT_H 1" >>confdefs.h
fi
-if test $ac_cv_header_sys_wait_h = yes; then
- :
-else
-
-cat >>confdefs.h <<\_ACEOF
-#define NO_SYS_WAIT_H 1
-_ACEOF
-
-fi
-
-
- if test "${ac_cv_header_dlfcn_h+set}" = set; then
- echo "$as_me:$LINENO: checking for dlfcn.h" >&5
-echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6
-if test "${ac_cv_header_dlfcn_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5
-echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking dlfcn.h usability" >&5
-echo $ECHO_N "checking dlfcn.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <dlfcn.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking dlfcn.h presence" >&5
-echo $ECHO_N "checking dlfcn.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <dlfcn.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: dlfcn.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: dlfcn.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: dlfcn.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: dlfcn.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: dlfcn.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: dlfcn.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: dlfcn.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: dlfcn.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for dlfcn.h" >&5
-echo $ECHO_N "checking for dlfcn.h... $ECHO_C" >&6
-if test "${ac_cv_header_dlfcn_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_dlfcn_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_dlfcn_h" >&5
-echo "${ECHO_T}$ac_cv_header_dlfcn_h" >&6
+ ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default"
+if test "x$ac_cv_header_dlfcn_h" = xyes; then :
-fi
-if test $ac_cv_header_dlfcn_h = yes; then
- :
else
-cat >>confdefs.h <<\_ACEOF
-#define NO_DLFCN_H 1
-_ACEOF
+$as_echo "#define NO_DLFCN_H 1" >>confdefs.h
fi
# OS/390 lacks sys/param.h (and doesn't need it, by chance).
-
-for ac_header in sys/param.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ for ac_header in sys/param.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/param.h" "ac_cv_header_sys_param_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_param_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_SYS_PARAM_H 1
_ACEOF
fi
@@ -4186,18 +3935,14 @@ done
#------------------------------------------------------------------------
if test -z "$no_pipe" && test -n "$GCC"; then
- echo "$as_me:$LINENO: checking if the compiler understands -pipe" >&5
-echo $ECHO_N "checking if the compiler understands -pipe... $ECHO_C" >&6
-if test "${tcl_cv_cc_pipe+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if the compiler understands -pipe" >&5
+$as_echo_n "checking if the compiler understands -pipe... " >&6; }
+if ${tcl_cv_cc_pipe+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -pipe"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -4208,614 +3953,32 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_cc_pipe=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_pipe=no
+ tcl_cv_cc_pipe=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_pipe" >&5
-echo "${ECHO_T}$tcl_cv_cc_pipe" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_pipe" >&5
+$as_echo "$tcl_cv_cc_pipe" >&6; }
if test $tcl_cv_cc_pipe = yes; then
CFLAGS="$CFLAGS -pipe"
fi
fi
#------------------------------------------------------------------------
-# Threads support
+# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------
- # Check whether --enable-threads or --disable-threads was given.
-if test "${enable_threads+set}" = set; then
- enableval="$enable_threads"
- tcl_ok=$enableval
-else
- tcl_ok=yes
-fi;
-
- if test "${TCL_THREADS}" = 1; then
- tcl_threaded_core=1;
- fi
-
- if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then
- TCL_THREADS=1
- # USE_THREAD_ALLOC tells us to try the special thread-based
- # allocator that significantly reduces lock contention
-
-cat >>confdefs.h <<\_ACEOF
-#define USE_THREAD_ALLOC 1
-_ACEOF
-
-
-cat >>confdefs.h <<\_ACEOF
-#define _REENTRANT 1
-_ACEOF
-
- if test "`uname -s`" = "SunOS" ; then
-
-cat >>confdefs.h <<\_ACEOF
-#define _POSIX_PTHREAD_SEMANTICS 1
-_ACEOF
-
- fi
-
-cat >>confdefs.h <<\_ACEOF
-#define _THREAD_SAFE 1
-_ACEOF
-
- echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthread" >&5
-echo $ECHO_N "checking for pthread_mutex_init in -lpthread... $ECHO_C" >&6
-if test "${ac_cv_lib_pthread_pthread_mutex_init+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpthread $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char pthread_mutex_init ();
-int
-main ()
-{
-pthread_mutex_init ();
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_pthread_pthread_mutex_init=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_pthread_pthread_mutex_init=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5
-echo "${ECHO_T}$ac_cv_lib_pthread_pthread_mutex_init" >&6
-if test $ac_cv_lib_pthread_pthread_mutex_init = yes; then
- tcl_ok=yes
-else
- tcl_ok=no
-fi
-
- if test "$tcl_ok" = "no"; then
- # Check a little harder for __pthread_mutex_init in the same
- # library, as some systems hide it there until pthread.h is
- # defined. We could alternatively do an AC_TRY_COMPILE with
- # pthread.h, but that will work with libpthread really doesn't
- # exist, like AIX 4.2. [Bug: 4359]
- echo "$as_me:$LINENO: checking for __pthread_mutex_init in -lpthread" >&5
-echo $ECHO_N "checking for __pthread_mutex_init in -lpthread... $ECHO_C" >&6
-if test "${ac_cv_lib_pthread___pthread_mutex_init+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpthread $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char __pthread_mutex_init ();
-int
-main ()
-{
-__pthread_mutex_init ();
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_pthread___pthread_mutex_init=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_pthread___pthread_mutex_init=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5
-echo "${ECHO_T}$ac_cv_lib_pthread___pthread_mutex_init" >&6
-if test $ac_cv_lib_pthread___pthread_mutex_init = yes; then
- tcl_ok=yes
-else
- tcl_ok=no
-fi
-
- fi
-
- if test "$tcl_ok" = "yes"; then
- # The space is needed
- THREADS_LIBS=" -lpthread"
- else
- echo "$as_me:$LINENO: checking for pthread_mutex_init in -lpthreads" >&5
-echo $ECHO_N "checking for pthread_mutex_init in -lpthreads... $ECHO_C" >&6
-if test "${ac_cv_lib_pthreads_pthread_mutex_init+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lpthreads $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char pthread_mutex_init ();
-int
-main ()
-{
-pthread_mutex_init ();
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_pthreads_pthread_mutex_init=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_pthreads_pthread_mutex_init=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5
-echo "${ECHO_T}$ac_cv_lib_pthreads_pthread_mutex_init" >&6
-if test $ac_cv_lib_pthreads_pthread_mutex_init = yes; then
- tcl_ok=yes
-else
- tcl_ok=no
-fi
-
- if test "$tcl_ok" = "yes"; then
- # The space is needed
- THREADS_LIBS=" -lpthreads"
- else
- echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc" >&5
-echo $ECHO_N "checking for pthread_mutex_init in -lc... $ECHO_C" >&6
-if test "${ac_cv_lib_c_pthread_mutex_init+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lc $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char pthread_mutex_init ();
-int
-main ()
-{
-pthread_mutex_init ();
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_c_pthread_mutex_init=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_c_pthread_mutex_init=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_c_pthread_mutex_init" >&5
-echo "${ECHO_T}$ac_cv_lib_c_pthread_mutex_init" >&6
-if test $ac_cv_lib_c_pthread_mutex_init = yes; then
- tcl_ok=yes
-else
- tcl_ok=no
-fi
-
- if test "$tcl_ok" = "no"; then
- echo "$as_me:$LINENO: checking for pthread_mutex_init in -lc_r" >&5
-echo $ECHO_N "checking for pthread_mutex_init in -lc_r... $ECHO_C" >&6
-if test "${ac_cv_lib_c_r_pthread_mutex_init+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_check_lib_save_LIBS=$LIBS
-LIBS="-lc_r $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char pthread_mutex_init ();
-int
-main ()
-{
-pthread_mutex_init ();
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_c_r_pthread_mutex_init=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_c_r_pthread_mutex_init=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-LIBS=$ac_check_lib_save_LIBS
-fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5
-echo "${ECHO_T}$ac_cv_lib_c_r_pthread_mutex_init" >&6
-if test $ac_cv_lib_c_r_pthread_mutex_init = yes; then
- tcl_ok=yes
-else
- tcl_ok=no
+# Check whether --with-encoding was given.
+if test "${with_encoding+set}" = set; then :
+ withval=$with_encoding; with_tcencoding=${withval}
fi
- if test "$tcl_ok" = "yes"; then
- # The space is needed
- THREADS_LIBS=" -pthread"
- else
- TCL_THREADS=0
- { echo "$as_me:$LINENO: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&5
-echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must disable thread support or edit the LIBS in the Makefile..." >&2;}
- fi
- fi
- fi
- fi
-
- # Does the pthread-implementation provide
- # 'pthread_attr_setstacksize' ?
-
- ac_saved_libs=$LIBS
- LIBS="$LIBS $THREADS_LIBS"
-
-
-for ac_func in pthread_attr_setstacksize pthread_atfork
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
- cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
- LIBS=$ac_saved_libs
- else
- TCL_THREADS=0
- fi
- # Do checking message here to not mess up interleaved configure output
- echo "$as_me:$LINENO: checking for building with threads" >&5
-echo $ECHO_N "checking for building with threads... $ECHO_C" >&6
- if test "${TCL_THREADS}" = 1; then
-
-cat >>confdefs.h <<\_ACEOF
-#define TCL_THREADS 1
-_ACEOF
-
- if test "${tcl_threaded_core}" = 1; then
- echo "$as_me:$LINENO: result: yes (threaded core)" >&5
-echo "${ECHO_T}yes (threaded core)" >&6
- else
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
- fi
- else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
- fi
-
-
-
-
-#------------------------------------------------------------------------
-# Embedded configuration information, encoding to use for the values, TIP #59
-#------------------------------------------------------------------------
-
-
-
-# Check whether --with-encoding or --without-encoding was given.
-if test "${with_encoding+set}" = set; then
- withval="$with_encoding"
- with_tcencoding=${withval}
-fi;
if test x"${with_tcencoding}" != x ; then
@@ -4825,9 +3988,7 @@ _ACEOF
else
-cat >>confdefs.h <<\_ACEOF
-#define TCL_CFGVAL_ENCODING "iso8859-1"
-_ACEOF
+$as_echo "#define TCL_CFGVAL_ENCODING \"iso8859-1\"" >>confdefs.h
fi
@@ -4842,97 +4003,8 @@ _ACEOF
# already in libc.a. Set compiler flags accordingly.
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for sin" >&5
-echo $ECHO_N "checking for sin... $ECHO_C" >&6
-if test "${ac_cv_func_sin+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define sin to an innocuous variant, in case <limits.h> declares sin.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define sin innocuous_sin
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char sin (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef sin
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char sin ();
-/* 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_sin) || defined (__stub___sin)
-choke me
-#else
-char (*f) () = sin;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != sin;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_sin=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_sin=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_sin" >&5
-echo "${ECHO_T}$ac_cv_func_sin" >&6
-if test $ac_cv_func_sin = yes; then
+ ac_fn_c_check_func "$LINENO" "sin" "ac_cv_func_sin"
+if test "x$ac_cv_func_sin" = xyes; then :
MATH_LIBS=""
else
MATH_LIBS="-lm"
@@ -4944,211 +4016,45 @@ fi
# needs net/errno.h to define the socket-related error codes.
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for main in -linet" >&5
-echo $ECHO_N "checking for main in -linet... $ECHO_C" >&6
-if test "${ac_cv_lib_inet_main+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -linet" >&5
+$as_echo_n "checking for main in -linet... " >&6; }
+if ${ac_cv_lib_inet_main+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-linet $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
main ()
{
-main ();
+return main ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_inet_main=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_inet_main=no
+ ac_cv_lib_inet_main=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_inet_main" >&5
-echo "${ECHO_T}$ac_cv_lib_inet_main" >&6
-if test $ac_cv_lib_inet_main = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_main" >&5
+$as_echo "$ac_cv_lib_inet_main" >&6; }
+if test "x$ac_cv_lib_inet_main" = xyes; then :
LIBS="$LIBS -linet"
fi
- if test "${ac_cv_header_net_errno_h+set}" = set; then
- echo "$as_me:$LINENO: checking for net/errno.h" >&5
-echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6
-if test "${ac_cv_header_net_errno_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5
-echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking net/errno.h usability" >&5
-echo $ECHO_N "checking net/errno.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <net/errno.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ ac_fn_c_check_header_mongrel "$LINENO" "net/errno.h" "ac_cv_header_net_errno_h" "$ac_includes_default"
+if test "x$ac_cv_header_net_errno_h" = xyes; then :
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-# Is the header present?
-echo "$as_me:$LINENO: checking net/errno.h presence" >&5
-echo $ECHO_N "checking net/errno.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <net/errno.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: net/errno.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: net/errno.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: net/errno.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: net/errno.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: net/errno.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: net/errno.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: net/errno.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: net/errno.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: net/errno.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: net/errno.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: net/errno.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: net/errno.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: net/errno.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for net/errno.h" >&5
-echo $ECHO_N "checking for net/errno.h... $ECHO_C" >&6
-if test "${ac_cv_header_net_errno_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_net_errno_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_net_errno_h" >&5
-echo "${ECHO_T}$ac_cv_header_net_errno_h" >&6
-
-fi
-if test $ac_cv_header_net_errno_h = yes; then
-
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NET_ERRNO_H 1
-_ACEOF
+$as_echo "#define HAVE_NET_ERRNO_H 1" >>confdefs.h
fi
@@ -5173,530 +4079,400 @@ fi
#--------------------------------------------------------------------
tcl_checkBoth=0
- echo "$as_me:$LINENO: checking for connect" >&5
-echo $ECHO_N "checking for connect... $ECHO_C" >&6
-if test "${ac_cv_func_connect+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ ac_fn_c_check_func "$LINENO" "connect" "ac_cv_func_connect"
+if test "x$ac_cv_func_connect" = xyes; then :
+ tcl_checkSocket=0
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define connect to an innocuous variant, in case <limits.h> declares connect.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define connect innocuous_connect
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char connect (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+ tcl_checkSocket=1
+fi
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
+ if test "$tcl_checkSocket" = 1; then
+ ac_fn_c_check_func "$LINENO" "setsockopt" "ac_cv_func_setsockopt"
+if test "x$ac_cv_func_setsockopt" = xyes; then :
-#undef connect
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for setsockopt in -lsocket" >&5
+$as_echo_n "checking for setsockopt in -lsocket... " >&6; }
+if ${ac_cv_lib_socket_setsockopt+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lsocket $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
-char connect ();
-/* 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_connect) || defined (__stub___connect)
-choke me
-#else
-char (*f) () = connect;
-#endif
#ifdef __cplusplus
-}
+extern "C"
#endif
-
+char setsockopt ();
int
main ()
{
-return f != connect;
+return setsockopt ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_connect=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_socket_setsockopt=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_connect=no
+ ac_cv_lib_socket_setsockopt=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_connect" >&5
-echo "${ECHO_T}$ac_cv_func_connect" >&6
-if test $ac_cv_func_connect = yes; then
- tcl_checkSocket=0
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_setsockopt" >&5
+$as_echo "$ac_cv_lib_socket_setsockopt" >&6; }
+if test "x$ac_cv_lib_socket_setsockopt" = xyes; then :
+ LIBS="$LIBS -lsocket"
else
- tcl_checkSocket=1
+ tcl_checkBoth=1
fi
- if test "$tcl_checkSocket" = 1; then
- echo "$as_me:$LINENO: checking for setsockopt" >&5
-echo $ECHO_N "checking for setsockopt... $ECHO_C" >&6
-if test "${ac_cv_func_setsockopt+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define setsockopt to an innocuous variant, in case <limits.h> declares setsockopt.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define setsockopt innocuous_setsockopt
+fi
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char setsockopt (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ ac_fn_c_check_func "$LINENO" "accept" "ac_cv_func_accept"
+if test "x$ac_cv_func_accept" = xyes; then :
+ tcl_checkNsl=0
+else
+ LIBS=$tk_oldLibs
+fi
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
+ fi
+ ac_fn_c_check_func "$LINENO" "gethostbyname" "ac_cv_func_gethostbyname"
+if test "x$ac_cv_func_gethostbyname" = xyes; then :
-#undef setsockopt
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname in -lnsl" >&5
+$as_echo_n "checking for gethostbyname in -lnsl... " >&6; }
+if ${ac_cv_lib_nsl_gethostbyname+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lnsl $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
-{
#endif
-/* We use char because int might match the return type of a gcc2
+char gethostbyname ();
+int
+main ()
+{
+return gethostbyname ();
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_nsl_gethostbyname=yes
+else
+ ac_cv_lib_nsl_gethostbyname=no
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_nsl_gethostbyname" >&5
+$as_echo "$ac_cv_lib_nsl_gethostbyname" >&6; }
+if test "x$ac_cv_lib_nsl_gethostbyname" = xyes; then :
+ LIBS="$LIBS -lnsl"
+fi
+
+fi
+
+
+
+$as_echo "#define _REENTRANT 1" >>confdefs.h
+
+
+$as_echo "#define _THREAD_SAFE 1" >>confdefs.h
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthread" >&5
+$as_echo_n "checking for pthread_mutex_init in -lpthread... " >&6; }
+if ${ac_cv_lib_pthread_pthread_mutex_init+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpthread $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
-char setsockopt ();
-/* 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
-char (*f) () = setsockopt;
-#endif
#ifdef __cplusplus
-}
+extern "C"
#endif
-
+char pthread_mutex_init ();
int
main ()
{
-return f != setsockopt;
+return pthread_mutex_init ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_setsockopt=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_pthread_pthread_mutex_init=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_setsockopt=no
+ ac_cv_lib_pthread_pthread_mutex_init=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_setsockopt" >&5
-echo "${ECHO_T}$ac_cv_func_setsockopt" >&6
-if test $ac_cv_func_setsockopt = yes; then
- :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_mutex_init" >&5
+$as_echo "$ac_cv_lib_pthread_pthread_mutex_init" >&6; }
+if test "x$ac_cv_lib_pthread_pthread_mutex_init" = xyes; then :
+ tcl_ok=yes
else
- echo "$as_me:$LINENO: checking for setsockopt in -lsocket" >&5
-echo $ECHO_N "checking for setsockopt in -lsocket... $ECHO_C" >&6
-if test "${ac_cv_lib_socket_setsockopt+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "no"; then
+ # Check a little harder for __pthread_mutex_init in the same
+ # library, as some systems hide it there until pthread.h is
+ # defined. We could alternatively do an AC_TRY_COMPILE with
+ # pthread.h, but that will work with libpthread really doesn't
+ # exist, like AIX 4.2. [Bug: 4359]
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __pthread_mutex_init in -lpthread" >&5
+$as_echo_n "checking for __pthread_mutex_init in -lpthread... " >&6; }
+if ${ac_cv_lib_pthread___pthread_mutex_init+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lsocket $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+LIBS="-lpthread $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char setsockopt ();
+char __pthread_mutex_init ();
int
main ()
{
-setsockopt ();
+return __pthread_mutex_init ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_socket_setsockopt=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_pthread___pthread_mutex_init=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_socket_setsockopt=no
+ ac_cv_lib_pthread___pthread_mutex_init=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_socket_setsockopt" >&5
-echo "${ECHO_T}$ac_cv_lib_socket_setsockopt" >&6
-if test $ac_cv_lib_socket_setsockopt = yes; then
- LIBS="$LIBS -lsocket"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread___pthread_mutex_init" >&5
+$as_echo "$ac_cv_lib_pthread___pthread_mutex_init" >&6; }
+if test "x$ac_cv_lib_pthread___pthread_mutex_init" = xyes; then :
+ tcl_ok=yes
else
- tcl_checkBoth=1
-fi
-
+ tcl_ok=no
fi
fi
- if test "$tcl_checkBoth" = 1; then
- tk_oldLibs=$LIBS
- LIBS="$LIBS -lsocket -lnsl"
- echo "$as_me:$LINENO: checking for accept" >&5
-echo $ECHO_N "checking for accept... $ECHO_C" >&6
-if test "${ac_cv_func_accept+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthread"
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lpthreads" >&5
+$as_echo_n "checking for pthread_mutex_init in -lpthreads... " >&6; }
+if ${ac_cv_lib_pthreads_pthread_mutex_init+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lpthreads $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Define accept to an innocuous variant, in case <limits.h> declares accept.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define accept innocuous_accept
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char accept (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef accept
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
-char accept ();
-/* 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_accept) || defined (__stub___accept)
-choke me
-#else
-char (*f) () = accept;
-#endif
#ifdef __cplusplus
-}
+extern "C"
#endif
-
+char pthread_mutex_init ();
int
main ()
{
-return f != accept;
+return pthread_mutex_init ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_accept=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_pthreads_pthread_mutex_init=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_accept=no
+ ac_cv_lib_pthreads_pthread_mutex_init=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_accept" >&5
-echo "${ECHO_T}$ac_cv_func_accept" >&6
-if test $ac_cv_func_accept = yes; then
- tcl_checkNsl=0
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_pthread_mutex_init" >&5
+$as_echo "$ac_cv_lib_pthreads_pthread_mutex_init" >&6; }
+if test "x$ac_cv_lib_pthreads_pthread_mutex_init" = xyes; then :
+ _ok=yes
else
- LIBS=$tk_oldLibs
+ tcl_ok=no
fi
- fi
- echo "$as_me:$LINENO: checking for gethostbyname" >&5
-echo $ECHO_N "checking for gethostbyname... $ECHO_C" >&6
-if test "${ac_cv_func_gethostbyname+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthreads"
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc" >&5
+$as_echo_n "checking for pthread_mutex_init in -lc... " >&6; }
+if ${ac_cv_lib_c_pthread_mutex_init+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ ac_check_lib_save_LIBS=$LIBS
+LIBS="-lc $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Define gethostbyname to an innocuous variant, in case <limits.h> declares gethostbyname.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define gethostbyname innocuous_gethostbyname
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char gethostbyname (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef gethostbyname
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
-char gethostbyname ();
-/* 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_gethostbyname) || defined (__stub___gethostbyname)
-choke me
-#else
-char (*f) () = gethostbyname;
-#endif
#ifdef __cplusplus
-}
+extern "C"
#endif
-
+char pthread_mutex_init ();
int
main ()
{
-return f != gethostbyname;
+return pthread_mutex_init ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_gethostbyname=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_c_pthread_mutex_init=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_gethostbyname=no
+ ac_cv_lib_c_pthread_mutex_init=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname" >&5
-echo "${ECHO_T}$ac_cv_func_gethostbyname" >&6
-if test $ac_cv_func_gethostbyname = yes; then
- :
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_pthread_mutex_init" >&5
+$as_echo "$ac_cv_lib_c_pthread_mutex_init" >&6; }
+if test "x$ac_cv_lib_c_pthread_mutex_init" = xyes; then :
+ tcl_ok=yes
else
- echo "$as_me:$LINENO: checking for gethostbyname in -lnsl" >&5
-echo $ECHO_N "checking for gethostbyname in -lnsl... $ECHO_C" >&6
-if test "${ac_cv_lib_nsl_gethostbyname+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "no"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_mutex_init in -lc_r" >&5
+$as_echo_n "checking for pthread_mutex_init in -lc_r... " >&6; }
+if ${ac_cv_lib_c_r_pthread_mutex_init+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
-LIBS="-lnsl $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+LIBS="-lc_r $LIBS"
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gethostbyname ();
+char pthread_mutex_init ();
int
main ()
{
-gethostbyname ();
+return pthread_mutex_init ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_lib_nsl_gethostbyname=yes
+if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_lib_c_r_pthread_mutex_init=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_nsl_gethostbyname=no
+ ac_cv_lib_c_r_pthread_mutex_init=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_nsl_gethostbyname" >&5
-echo "${ECHO_T}$ac_cv_lib_nsl_gethostbyname" >&6
-if test $ac_cv_lib_nsl_gethostbyname = yes; then
- LIBS="$LIBS -lnsl"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_r_pthread_mutex_init" >&5
+$as_echo "$ac_cv_lib_c_r_pthread_mutex_init" >&6; }
+if test "x$ac_cv_lib_c_r_pthread_mutex_init" = xyes; then :
+ tcl_ok=yes
+else
+ tcl_ok=no
+fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -pthread"
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile..." >&5
+$as_echo "$as_me: WARNING: Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile..." >&2;}
+ fi
+ fi
+ fi
+ fi
+
+ # Does the pthread-implementation provide
+ # 'pthread_attr_setstacksize' ?
+
+ ac_saved_libs=$LIBS
+ LIBS="$LIBS $THREADS_LIBS"
+ for ac_func in pthread_attr_setstacksize pthread_atfork
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
+_ACEOF
+
fi
+done
+
+ LIBS=$ac_saved_libs
+ # TIP #509
+ ac_fn_c_check_decl "$LINENO" "PTHREAD_MUTEX_RECURSIVE" "ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" "#include <pthread.h>
+"
+if test "x$ac_cv_have_decl_PTHREAD_MUTEX_RECURSIVE" = xyes; then :
+ ac_have_decl=1
+else
+ ac_have_decl=0
+fi
+
+cat >>confdefs.h <<_ACEOF
+#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE $ac_have_decl
+_ACEOF
+if test $ac_have_decl = 1; then :
+ tcl_ok=yes
+else
+ tcl_ok=no
fi
@@ -5705,15 +4481,15 @@ fi
LIBS="$LIBS$THREADS_LIBS"
- echo "$as_me:$LINENO: checking how to build libraries" >&5
-echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6
- # Check whether --enable-shared or --disable-shared was given.
-if test "${enable_shared+set}" = set; then
- enableval="$enable_shared"
- tcl_ok=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
+$as_echo_n "checking how to build libraries... " >&6; }
+ # Check whether --enable-shared was given.
+if test "${enable_shared+set}" = set; then :
+ enableval=$enable_shared; tcl_ok=$enableval
else
tcl_ok=yes
-fi;
+fi
+
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
@@ -5723,21 +4499,20 @@ fi;
fi
if test "$tcl_ok" = "yes" ; then
- echo "$as_me:$LINENO: result: shared" >&5
-echo "${ECHO_T}shared" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5
+$as_echo "shared" >&6; }
SHARED_BUILD=1
else
- echo "$as_me:$LINENO: result: static" >&5
-echo "${ECHO_T}static" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
+$as_echo "static" >&6; }
SHARED_BUILD=0
-cat >>confdefs.h <<\_ACEOF
-#define STATIC_BUILD 1
-_ACEOF
+$as_echo "#define STATIC_BUILD 1" >>confdefs.h
fi
+
#--------------------------------------------------------------------
# Look for a native installed tclsh binary (if available)
# If one cannot be found then use the binary we build (fails for
@@ -5745,10 +4520,10 @@ _ACEOF
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for tclsh" >&5
-echo $ECHO_N "checking for tclsh... $ECHO_C" >&6
- if test "${ac_cv_path_tclsh+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
+$as_echo_n "checking for tclsh... " >&6; }
+ if ${ac_cv_path_tclsh+:} false; then :
+ $as_echo_n "(cached) " >&6
else
search_path=`echo ${PATH} | sed -e 's/:/ /g'`
@@ -5769,13 +4544,13 @@ fi
if test -f "$ac_cv_path_tclsh" ; then
TCLSH_PROG="$ac_cv_path_tclsh"
- echo "$as_me:$LINENO: result: $TCLSH_PROG" >&5
-echo "${ECHO_T}$TCLSH_PROG" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
+$as_echo "$TCLSH_PROG" >&6; }
else
# It is not an error if an installed version of Tcl can't be located.
TCLSH_PROG=""
- echo "$as_me:$LINENO: result: No tclsh found on PATH" >&5
-echo "${ECHO_T}No tclsh found on PATH" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
+$as_echo "No tclsh found on PATH" >&6; }
fi
@@ -5788,204 +4563,13 @@ fi
#------------------------------------------------------------------------
zlib_ok=yes
-if test "${ac_cv_header_zlib_h+set}" = set; then
- echo "$as_me:$LINENO: checking for zlib.h" >&5
-echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6
-if test "${ac_cv_header_zlib_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5
-echo "${ECHO_T}$ac_cv_header_zlib_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking zlib.h usability" >&5
-echo $ECHO_N "checking zlib.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <zlib.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_header_mongrel "$LINENO" "zlib.h" "ac_cv_header_zlib_h" "$ac_includes_default"
+if test "x$ac_cv_header_zlib_h" = xyes; then :
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
+ ac_fn_c_check_type "$LINENO" "gz_header" "ac_cv_type_gz_header" "#include <zlib.h>
+"
+if test "x$ac_cv_type_gz_header" = xyes; then :
-# Is the header present?
-echo "$as_me:$LINENO: checking zlib.h presence" >&5
-echo $ECHO_N "checking zlib.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <zlib.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: zlib.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: zlib.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: zlib.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: zlib.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: zlib.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: zlib.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: zlib.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: zlib.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: zlib.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: zlib.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: zlib.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: zlib.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: zlib.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for zlib.h" >&5
-echo $ECHO_N "checking for zlib.h... $ECHO_C" >&6
-if test "${ac_cv_header_zlib_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_zlib_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_zlib_h" >&5
-echo "${ECHO_T}$ac_cv_header_zlib_h" >&6
-
-fi
-if test $ac_cv_header_zlib_h = yes; then
-
- echo "$as_me:$LINENO: checking for gz_header" >&5
-echo $ECHO_N "checking for gz_header... $ECHO_C" >&6
-if test "${ac_cv_type_gz_header+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <zlib.h>
-
-int
-main ()
-{
-if ((gz_header *) 0)
- return 0;
-if (sizeof (gz_header))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_gz_header=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_gz_header=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_gz_header" >&5
-echo "${ECHO_T}$ac_cv_type_gz_header" >&6
-if test $ac_cv_type_gz_header = yes; then
- :
else
zlib_ok=no
fi
@@ -5996,131 +4580,61 @@ else
fi
-if test $zlib_ok = yes; then
+if test $zlib_ok = yes; then :
- echo "$as_me:$LINENO: checking for library containing deflateSetHeader" >&5
-echo $ECHO_N "checking for library containing deflateSetHeader... $ECHO_C" >&6
-if test "${ac_cv_search_deflateSetHeader+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing deflateSetHeader" >&5
+$as_echo_n "checking for library containing deflateSetHeader... " >&6; }
+if ${ac_cv_search_deflateSetHeader+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_func_search_save_LIBS=$LIBS
-ac_cv_search_deflateSetHeader=no
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char deflateSetHeader ();
int
main ()
{
-deflateSetHeader ();
+return deflateSetHeader ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_search_deflateSetHeader="none required"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-if test "$ac_cv_search_deflateSetHeader" = no; then
- for ac_lib in z; do
+for ac_lib in '' z; do
+ if test -z "$ac_lib"; then
+ ac_res="none required"
+ else
+ ac_res=-l$ac_lib
LIBS="-l$ac_lib $ac_func_search_save_LIBS"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
+ fi
+ if ac_fn_c_try_link "$LINENO"; then :
+ ac_cv_search_deflateSetHeader=$ac_res
+fi
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext
+ if ${ac_cv_search_deflateSetHeader+:} false; then :
+ break
+fi
+done
+if ${ac_cv_search_deflateSetHeader+:} false; then :
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char deflateSetHeader ();
-int
-main ()
-{
-deflateSetHeader ();
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_search_deflateSetHeader="-l$ac_lib"
-break
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- done
+ ac_cv_search_deflateSetHeader=no
fi
+rm conftest.$ac_ext
LIBS=$ac_func_search_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_search_deflateSetHeader" >&5
-echo "${ECHO_T}$ac_cv_search_deflateSetHeader" >&6
-if test "$ac_cv_search_deflateSetHeader" != no; then
- test "$ac_cv_search_deflateSetHeader" = "none required" || LIBS="$ac_cv_search_deflateSetHeader $LIBS"
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_search_deflateSetHeader" >&5
+$as_echo "$ac_cv_search_deflateSetHeader" >&6; }
+ac_res=$ac_cv_search_deflateSetHeader
+if test "$ac_res" != no; then :
+ test "$ac_res" = "none required" || LIBS="$ac_res $LIBS"
else
@@ -6129,8 +4643,7 @@ else
fi
fi
-
-if test $zlib_ok = no; then
+if test $zlib_ok = no; then :
ZLIB_OBJS=\${ZLIB_OBJS}
@@ -6141,10 +4654,7 @@ if test $zlib_ok = no; then
fi
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_ZLIB 1
-_ACEOF
+$as_echo "#define HAVE_ZLIB 1" >>confdefs.h
#--------------------------------------------------------------------
@@ -6156,10 +4666,10 @@ _ACEOF
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ac_tool_prefix}ranlib; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_RANLIB+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RANLIB+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$RANLIB"; then
ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
@@ -6169,35 +4679,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
RANLIB=$ac_cv_prog_RANLIB
if test -n "$RANLIB"; then
- echo "$as_me:$LINENO: result: $RANLIB" >&5
-echo "${ECHO_T}$RANLIB" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
+$as_echo "$RANLIB" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_RANLIB"; then
ac_ct_RANLIB=$RANLIB
# Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_RANLIB"; then
ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
@@ -6207,28 +4719,38 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_RANLIB="ranlib"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
- test -z "$ac_cv_prog_ac_ct_RANLIB" && ac_cv_prog_ac_ct_RANLIB=":"
fi
fi
ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
if test -n "$ac_ct_RANLIB"; then
- echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
-echo "${ECHO_T}$ac_ct_RANLIB" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
+$as_echo "$ac_ct_RANLIB" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- RANLIB=$ac_ct_RANLIB
+ if test "x$ac_ct_RANLIB" = x; then
+ RANLIB=":"
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ RANLIB=$ac_ct_RANLIB
+ fi
else
RANLIB="$ac_cv_prog_RANLIB"
fi
@@ -6237,52 +4759,47 @@ fi
# Step 0.a: Enable 64 bit support?
- echo "$as_me:$LINENO: checking if 64bit support is requested" >&5
-echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6
- # Check whether --enable-64bit or --disable-64bit was given.
-if test "${enable_64bit+set}" = set; then
- enableval="$enable_64bit"
- do64bit=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
+$as_echo_n "checking if 64bit support is requested... " >&6; }
+ # Check whether --enable-64bit was given.
+if test "${enable_64bit+set}" = set; then :
+ enableval=$enable_64bit; do64bit=$enableval
else
do64bit=no
-fi;
- echo "$as_me:$LINENO: result: $do64bit" >&5
-echo "${ECHO_T}$do64bit" >&6
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
+$as_echo "$do64bit" >&6; }
# Step 0.b: Enable Solaris 64 bit VIS support?
- echo "$as_me:$LINENO: checking if 64bit Sparc VIS support is requested" >&5
-echo $ECHO_N "checking if 64bit Sparc VIS support is requested... $ECHO_C" >&6
- # Check whether --enable-64bit-vis or --disable-64bit-vis was given.
-if test "${enable_64bit_vis+set}" = set; then
- enableval="$enable_64bit_vis"
- do64bitVIS=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit Sparc VIS support is requested" >&5
+$as_echo_n "checking if 64bit Sparc VIS support is requested... " >&6; }
+ # Check whether --enable-64bit-vis was given.
+if test "${enable_64bit_vis+set}" = set; then :
+ enableval=$enable_64bit_vis; do64bitVIS=$enableval
else
do64bitVIS=no
-fi;
- echo "$as_me:$LINENO: result: $do64bitVIS" >&5
-echo "${ECHO_T}$do64bitVIS" >&6
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bitVIS" >&5
+$as_echo "$do64bitVIS" >&6; }
# Force 64bit on with VIS
- if test "$do64bitVIS" = "yes"; then
+ if test "$do64bitVIS" = "yes"; then :
do64bit=yes
fi
-
# Step 0.c: Check if visibility support is available. Do this here so
# that platform specific alternatives can be used below if this fails.
- echo "$as_me:$LINENO: checking if compiler supports visibility \"hidden\"" >&5
-echo $ECHO_N "checking if compiler supports visibility \"hidden\"... $ECHO_C" >&6
-if test "${tcl_cv_cc_visibility_hidden+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler supports visibility \"hidden\"" >&5
+$as_echo_n "checking if compiler supports visibility \"hidden\"... " >&6; }
+if ${tcl_cv_cc_visibility_hidden+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
extern __attribute__((__visibility__("hidden"))) void f(void);
@@ -6295,96 +4812,61 @@ f();
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_cc_visibility_hidden=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_visibility_hidden=no
+ tcl_cv_cc_visibility_hidden=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_visibility_hidden" >&5
-echo "${ECHO_T}$tcl_cv_cc_visibility_hidden" >&6
- if test $tcl_cv_cc_visibility_hidden = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_visibility_hidden" >&5
+$as_echo "$tcl_cv_cc_visibility_hidden" >&6; }
+ if test $tcl_cv_cc_visibility_hidden = yes; then :
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE extern __attribute__((__visibility__("hidden")))
-_ACEOF
+$as_echo "#define MODULE_SCOPE extern __attribute__((__visibility__(\"hidden\")))" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_HIDDEN 1
-_ACEOF
+$as_echo "#define HAVE_HIDDEN 1" >>confdefs.h
fi
-
# Step 0.d: Disable -rpath support?
- echo "$as_me:$LINENO: checking if rpath support is requested" >&5
-echo $ECHO_N "checking if rpath support is requested... $ECHO_C" >&6
- # Check whether --enable-rpath or --disable-rpath was given.
-if test "${enable_rpath+set}" = set; then
- enableval="$enable_rpath"
- doRpath=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if rpath support is requested" >&5
+$as_echo_n "checking if rpath support is requested... " >&6; }
+ # Check whether --enable-rpath was given.
+if test "${enable_rpath+set}" = set; then :
+ enableval=$enable_rpath; doRpath=$enableval
else
doRpath=yes
-fi;
- echo "$as_me:$LINENO: result: $doRpath" >&5
-echo "${ECHO_T}$doRpath" >&6
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $doRpath" >&5
+$as_echo "$doRpath" >&6; }
# Step 1: set the variable "system" to hold the name and version number
# for the system.
- echo "$as_me:$LINENO: checking system version" >&5
-echo $ECHO_N "checking system version... $ECHO_C" >&6
-if test "${tcl_cv_sys_version+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5
+$as_echo_n "checking system version... " >&6; }
+if ${tcl_cv_sys_version+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test -f /usr/lib/NextStep/software_version; then
- tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+ if test "${TEA_PLATFORM}" = "windows" ; then
+ tcl_cv_sys_version=windows
else
tcl_cv_sys_version=`uname -s`-`uname -r`
if test "$?" -ne 0 ; then
- { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5
-echo "$as_me: WARNING: can't find uname command" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5
+$as_echo "$as_me: WARNING: can't find uname command" >&2;}
tcl_cv_sys_version=unknown
else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid`
- fi
if test "`uname -s`" = "AIX" ; then
tcl_cv_sys_version=AIX-`uname -v`.`uname -r`
fi
@@ -6392,79 +4874,51 @@ echo "$as_me: WARNING: can't find uname command" >&2;}
fi
fi
-echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5
-echo "${ECHO_T}$tcl_cv_sys_version" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5
+$as_echo "$tcl_cv_sys_version" >&6; }
system=$tcl_cv_sys_version
# Step 2: check for existence of -ldl library. This is needed because
# Linux can use either -ldl or -ldld for dynamic loading.
- echo "$as_me:$LINENO: checking for dlopen in -ldl" >&5
-echo $ECHO_N "checking for dlopen in -ldl... $ECHO_C" >&6
-if test "${ac_cv_lib_dl_dlopen+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5
+$as_echo_n "checking for dlopen in -ldl... " >&6; }
+if ${ac_cv_lib_dl_dlopen+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldl $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char dlopen ();
int
main ()
{
-dlopen ();
+return dlopen ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dl_dlopen=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_dl_dlopen=no
+ ac_cv_lib_dl_dlopen=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_dl_dlopen" >&5
-echo "${ECHO_T}$ac_cv_lib_dl_dlopen" >&6
-if test $ac_cv_lib_dl_dlopen = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5
+$as_echo "$ac_cv_lib_dl_dlopen" >&6; }
+if test "x$ac_cv_lib_dl_dlopen" = xyes; then :
have_dl=yes
else
have_dl=no
@@ -6490,10 +4944,10 @@ fi
ECHO_VERSION='`echo ${VERSION}`'
TCL_LIB_VERSIONS_OK=ok
CFLAGS_DEBUG=-g
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
CFLAGS_OPTIMIZE=-O2
- CFLAGS_WARNING="-Wall"
+ CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
else
@@ -6501,14 +4955,13 @@ else
CFLAGS_WARNING=""
fi
-
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
set dummy ${ac_tool_prefix}ar; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_AR+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AR+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$AR"; then
ac_cv_prog_AR="$AR" # Let the user override the test.
@@ -6518,35 +4971,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AR="${ac_tool_prefix}ar"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
AR=$ac_cv_prog_AR
if test -n "$AR"; then
- echo "$as_me:$LINENO: result: $AR" >&5
-echo "${ECHO_T}$AR" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
+$as_echo "$AR" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_AR"; then
ac_ct_AR=$AR
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_AR+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_AR"; then
ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
@@ -6556,27 +5011,38 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_AR="ar"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_AR=$ac_cv_prog_ac_ct_AR
if test -n "$ac_ct_AR"; then
- echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
-echo "${ECHO_T}$ac_ct_AR" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
+$as_echo "$ac_ct_AR" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- AR=$ac_ct_AR
+ if test "x$ac_ct_AR" = x; then
+ AR=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ AR=$ac_ct_AR
+ fi
else
AR="$ac_cv_prog_AR"
fi
@@ -6586,15 +5052,12 @@ fi
PLAT_OBJS=""
PLAT_SRCS=""
LDAIX_SRC=""
- if test "x${SHLIB_VERSION}" = x; then
- SHLIB_VERSION=".1.0"
-else
- SHLIB_VERSION=".${SHLIB_VERSION}"
+ if test "x${SHLIB_VERSION}" = x; then :
+ SHLIB_VERSION="1.0"
fi
-
case $system in
AIX-*)
- if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then
+ if test "$GCC" != "yes"; then :
# AIX requires the _r compiler when gcc isn't being used
case "${CC}" in
@@ -6606,11 +5069,10 @@ fi
CC=`echo "$CC" | sed -e 's/^\([^ ]*\)/\1_r/'`
;;
esac
- echo "$as_me:$LINENO: result: Using $CC for compiling with threads" >&5
-echo "${ECHO_T}Using $CC for compiling with threads" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using $CC for compiling with threads" >&5
+$as_echo "Using $CC for compiling with threads" >&6; }
fi
-
LIBS="$LIBS -lc"
SHLIB_CFLAGS=""
SHLIB_SUFFIX=".so"
@@ -6623,12 +5085,12 @@ fi
LDAIX_SRC='$(UNIX_DIR)/ldAix'
# Check to enable 64-bit flags for compiler/linker
- if test "$do64bit" = yes; then
+ if test "$do64bit" = yes; then :
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5
-echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5
+$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;}
else
@@ -6641,17 +5103,15 @@ else
fi
-
fi
-
- if test "`uname -m`" = ia64; then
+ if test "`uname -m`" = ia64; then :
# AIX-5 uses ELF style dynamic libraries on IA-64, but not PPC
SHLIB_LD="/usr/ccs/bin/ld -G -z text"
# AIX-5 has dl* in libc.so
DL_LIBS=""
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
@@ -6660,12 +5120,11 @@ else
CC_SEARCH_FLAGS='-R${LIB_RUNTIME_DIR}'
fi
-
LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
else
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
SHLIB_LD='${CC} -shared -Wl,-bexpall'
@@ -6675,14 +5134,12 @@ else
LDFLAGS="$LDFLAGS -brtl"
fi
-
SHLIB_LD="${SHLIB_LD} ${SHLIB_LD_FLAGS}"
DL_LIBS="-ldl"
CC_SEARCH_FLAGS='-L${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
fi
-
;;
BeOS*)
SHLIB_CFLAGS="-fPIC"
@@ -6696,71 +5153,43 @@ fi
# -lsocket, even if the network functions are in -lnet which
# is always linked to, for compatibility.
#-----------------------------------------------------------
- echo "$as_me:$LINENO: checking for inet_ntoa in -lbind" >&5
-echo $ECHO_N "checking for inet_ntoa in -lbind... $ECHO_C" >&6
-if test "${ac_cv_lib_bind_inet_ntoa+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lbind" >&5
+$as_echo_n "checking for inet_ntoa in -lbind... " >&6; }
+if ${ac_cv_lib_bind_inet_ntoa+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lbind $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char inet_ntoa ();
int
main ()
{
-inet_ntoa ();
+return inet_ntoa ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_bind_inet_ntoa=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_bind_inet_ntoa=no
+ ac_cv_lib_bind_inet_ntoa=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_bind_inet_ntoa" >&5
-echo "${ECHO_T}$ac_cv_lib_bind_inet_ntoa" >&6
-if test $ac_cv_lib_bind_inet_ntoa = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_bind_inet_ntoa" >&5
+$as_echo "$ac_cv_lib_bind_inet_ntoa" >&6; }
+if test "x$ac_cv_lib_bind_inet_ntoa" = xyes; then :
LIBS="$LIBS -lbind -lsocket"
fi
@@ -6784,7 +5213,7 @@ fi
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- CYGWIN_*|MINGW32*)
+ CYGWIN_*)
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
@@ -6797,16 +5226,12 @@ fi
TCL_NEEDS_EXP_FILE=1
TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,--out-implib,\$@.a"
- echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
-echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
-if test "${ac_cv_cygwin+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Cygwin version of gcc" >&5
+$as_echo_n "checking for Cygwin version of gcc... " >&6; }
+if ${ac_cv_cygwin+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __CYGWIN__
@@ -6821,49 +5246,18 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_cygwin=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_cygwin=yes
+ ac_cv_cygwin=yes
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
-echo "${ECHO_T}$ac_cv_cygwin" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
+$as_echo "$ac_cv_cygwin" >&6; }
if test "$ac_cv_cygwin" = "no"; then
- { { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5
-echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;}
- { (exit 1); exit 1; }; }
- fi
- if test "x${TCL_THREADS}" = "x0"; then
- { { echo "$as_me:$LINENO: error: CYGWIN compile is only supported with --enable-threads" >&5
-echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5
fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
@@ -6893,71 +5287,43 @@ echo "$as_me: error: CYGWIN compile is only supported with --enable-threads" >&2
SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
DL_OBJS="tclLoadDl.o"
DL_LIBS="-lroot"
- echo "$as_me:$LINENO: checking for inet_ntoa in -lnetwork" >&5
-echo $ECHO_N "checking for inet_ntoa in -lnetwork... $ECHO_C" >&6
-if test "${ac_cv_lib_network_inet_ntoa+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inet_ntoa in -lnetwork" >&5
+$as_echo_n "checking for inet_ntoa in -lnetwork... " >&6; }
+if ${ac_cv_lib_network_inet_ntoa+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lnetwork $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char inet_ntoa ();
int
main ()
{
-inet_ntoa ();
+return inet_ntoa ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_network_inet_ntoa=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_network_inet_ntoa=no
+ ac_cv_lib_network_inet_ntoa=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_network_inet_ntoa" >&5
-echo "${ECHO_T}$ac_cv_lib_network_inet_ntoa" >&6
-if test $ac_cv_lib_network_inet_ntoa = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_network_inet_ntoa" >&5
+$as_echo "$ac_cv_lib_network_inet_ntoa" >&6; }
+if test "x$ac_cv_lib_network_inet_ntoa" = xyes; then :
LIBS="$LIBS -lnetwork"
fi
@@ -6965,18 +5331,14 @@ fi
HP-UX-*.11.*)
# Use updated header definitions where possible
-cat >>confdefs.h <<\_ACEOF
-#define _XOPEN_SOURCE_EXTENDED 1
-_ACEOF
+$as_echo "#define _XOPEN_SOURCE_EXTENDED 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define _XOPEN_SOURCE 1
-_ACEOF
+$as_echo "#define _XOPEN_SOURCE 1" >>confdefs.h
LIBS="$LIBS -lxnet" # Use the XOPEN network library
- if test "`uname -m`" = ia64; then
+ if test "`uname -m`" = ia64; then :
SHLIB_SUFFIX=".so"
@@ -6985,78 +5347,49 @@ else
SHLIB_SUFFIX=".sl"
fi
-
- echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5
-echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6
-if test "${ac_cv_lib_dld_shl_load+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
+$as_echo_n "checking for shl_load in -ldld... " >&6; }
+if ${ac_cv_lib_dld_shl_load+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldld $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char shl_load ();
int
main ()
{
-shl_load ();
+return shl_load ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dld_shl_load=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_dld_shl_load=no
+ ac_cv_lib_dld_shl_load=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5
-echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6
-if test $ac_cv_lib_dld_shl_load = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
+$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
+if test "x$ac_cv_lib_dld_shl_load" = xyes; then :
tcl_ok=yes
else
tcl_ok=no
fi
- if test "$tcl_ok" = yes; then
+ if test "$tcl_ok" = yes; then :
SHLIB_CFLAGS="+z"
SHLIB_LD="ld -b"
@@ -7068,8 +5401,7 @@ fi
LD_LIBRARY_PATH_VAR="SHLIB_PATH"
fi
-
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
SHLIB_LD='${CC} -shared'
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
@@ -7080,30 +5412,28 @@ else
fi
-
# Users may want PA-RISC 1.1/2.0 portable code - needs HP cc
#CFLAGS="$CFLAGS +DAportable"
# Check to enable 64-bit flags for compiler/linker
- if test "$do64bit" = "yes"; then
+ if test "$do64bit" = "yes"; then :
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
case `${CC} -dumpmachine` in
hppa64*)
# 64-bit gcc in use. Fix flags for GNU ld.
do64bit_ok=yes
SHLIB_LD='${CC} -shared'
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
-
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
;;
*)
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5
-echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5
+$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;}
;;
esac
@@ -7115,82 +5445,52 @@ else
fi
-
-fi
- ;;
+fi ;;
HP-UX-*.08.*|HP-UX-*.09.*|HP-UX-*.10.*)
SHLIB_SUFFIX=".sl"
- echo "$as_me:$LINENO: checking for shl_load in -ldld" >&5
-echo $ECHO_N "checking for shl_load in -ldld... $ECHO_C" >&6
-if test "${ac_cv_lib_dld_shl_load+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for shl_load in -ldld" >&5
+$as_echo_n "checking for shl_load in -ldld... " >&6; }
+if ${ac_cv_lib_dld_shl_load+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-ldld $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char shl_load ();
int
main ()
{
-shl_load ();
+return shl_load ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_dld_shl_load=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_dld_shl_load=no
+ ac_cv_lib_dld_shl_load=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_dld_shl_load" >&5
-echo "${ECHO_T}$ac_cv_lib_dld_shl_load" >&6
-if test $ac_cv_lib_dld_shl_load = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dld_shl_load" >&5
+$as_echo "$ac_cv_lib_dld_shl_load" >&6; }
+if test "x$ac_cv_lib_dld_shl_load" = xyes; then :
tcl_ok=yes
else
tcl_ok=no
fi
- if test "$tcl_ok" = yes; then
+ if test "$tcl_ok" = yes; then :
SHLIB_CFLAGS="+z"
SHLIB_LD="ld -b"
@@ -7202,28 +5502,24 @@ fi
LD_SEARCH_FLAGS='+s +b ${LIB_RUNTIME_DIR}:.'
LD_LIBRARY_PATH_VAR="SHLIB_PATH"
-fi
- ;;
+fi ;;
IRIX-5.*)
SHLIB_CFLAGS=""
SHLIB_LD="ld -shared -rdata_shared"
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- case $LIBOBJS in
- "mkstemp.$ac_objext" | \
- *" mkstemp.$ac_objext" | \
- "mkstemp.$ac_objext "* | \
+ case " $LIBOBJS " in
*" mkstemp.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
+ ;;
esac
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
fi
-
;;
IRIX-6.*)
SHLIB_CFLAGS=""
@@ -7231,21 +5527,18 @@ fi
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- case $LIBOBJS in
- "mkstemp.$ac_objext" | \
- *" mkstemp.$ac_objext" | \
- "mkstemp.$ac_objext "* | \
+ case " $LIBOBJS " in
*" mkstemp.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
+ ;;
esac
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
fi
-
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
CFLAGS="$CFLAGS -mabi=n32"
LDFLAGS="$LDFLAGS -mabi=n32"
@@ -7264,7 +5557,6 @@ else
LDFLAGS="$LDFLAGS -n32"
fi
-
;;
IRIX64-6.*)
SHLIB_CFLAGS=""
@@ -7272,29 +5564,26 @@ fi
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- case $LIBOBJS in
- "mkstemp.$ac_objext" | \
- *" mkstemp.$ac_objext" | \
- "mkstemp.$ac_objext "* | \
+ case " $LIBOBJS " in
*" mkstemp.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
+ ;;
esac
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
fi
-
# Check to enable 64-bit flags for compiler/linker
- if test "$do64bit" = yes; then
+ if test "$do64bit" = yes; then :
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported by gcc" >&5
-echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported by gcc" >&5
+$as_echo "$as_me: WARNING: 64bit mode not supported by gcc" >&2;}
else
@@ -7305,9 +5594,7 @@ else
fi
-
fi
-
;;
Linux*|GNU*|NetBSD-Debian)
SHLIB_CFLAGS="-fPIC"
@@ -7323,31 +5610,25 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
-
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- if test "`uname -m`" = "alpha"; then
+ if test "`uname -m`" = "alpha"; then :
CFLAGS="$CFLAGS -mieee"
fi
+ if test $do64bit = yes; then :
- if test $do64bit = yes; then
-
- echo "$as_me:$LINENO: checking if compiler accepts -m64 flag" >&5
-echo $ECHO_N "checking if compiler accepts -m64 flag... $ECHO_C" >&6
-if test "${tcl_cv_cc_m64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -m64 flag" >&5
+$as_echo_n "checking if compiler accepts -m64 flag... " >&6; }
+if ${tcl_cv_cc_m64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS
CFLAGS="$CFLAGS -m64"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7358,62 +5639,35 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_cc_m64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_m64=no
+ tcl_cv_cc_m64=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_m64" >&5
-echo "${ECHO_T}$tcl_cv_cc_m64" >&6
- if test $tcl_cv_cc_m64 = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_m64" >&5
+$as_echo "$tcl_cv_cc_m64" >&6; }
+ if test $tcl_cv_cc_m64 = yes; then :
CFLAGS="$CFLAGS -m64"
do64bit_ok=yes
fi
-
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"${USE_COMPAT}" != x; then
+ if test x"${USE_COMPAT}" != x; then :
CFLAGS="$CFLAGS -fno-inline"
fi
-
;;
Lynx*)
SHLIB_CFLAGS="-fPIC"
@@ -7423,33 +5677,11 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS="-mshared -ldl"
LD_FLAGS="-Wl,--export-dynamic"
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
-
- ;;
- MP-RAS-02*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD='${CC} -G'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- MP-RAS-*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD='${CC} -G'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LDFLAGS="$LDFLAGS -Wl,-Bexport"
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
;;
OpenBSD-*)
arch=`arch -s`
@@ -7465,24 +5697,18 @@ fi
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
-
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
LDFLAGS="-Wl,-export-dynamic"
CFLAGS_OPTIMIZE="-O2"
- if test "${TCL_THREADS}" = "1"; then
-
- # On OpenBSD: Compile with -pthread
- # Don't link with -lpthread
- LIBS=`echo $LIBS | sed s/-lpthread//`
- CFLAGS="$CFLAGS -pthread"
-
-fi
-
+ # On OpenBSD: Compile with -pthread
+ # Don't link with -lpthread
+ LIBS=`echo $LIBS | sed s/-lpthread//`
+ CFLAGS="$CFLAGS -pthread"
# OpenBSD doesn't do version numbers with dots.
UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
TCL_LIB_VERSIONS_OK=nodots
@@ -7495,21 +5721,15 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS="$LDFLAGS -export-dynamic"
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
-
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- if test "${TCL_THREADS}" = "1"; then
-
- # The -pthread needs to go in the CFLAGS, not LIBS
- LIBS=`echo $LIBS | sed s/-pthread//`
- CFLAGS="$CFLAGS -pthread"
- LDFLAGS="$LDFLAGS -pthread"
-
-fi
-
+ # The -pthread needs to go in the CFLAGS, not LIBS
+ LIBS=`echo $LIBS | sed s/-pthread//`
+ CFLAGS="$CFLAGS -pthread"
+ LDFLAGS="$LDFLAGS -pthread"
;;
DragonFly-*|FreeBSD-*)
# This configuration from FreeBSD Ports.
@@ -7520,20 +5740,15 @@ fi
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
LDFLAGS=""
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
-
- if test "${TCL_THREADS}" = "1"; then
-
- # The -pthread needs to go in the LDFLAGS, not LIBS
- LIBS=`echo $LIBS | sed s/-pthread//`
- CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
- LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
-fi
-
+ # The -pthread needs to go in the LDFLAGS, not LIBS
+ LIBS=`echo $LIBS | sed s/-pthread//`
+ CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+ LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
case $system in
FreeBSD-3.*)
# Version numbers are dot-stripped by system policy.
@@ -7556,23 +5771,19 @@ fi
CFLAGS="`echo " ${CFLAGS}" | \
awk 'BEGIN {FS=" +-";ORS=" "}; {for (i=2;i<=NF;i++) \
if (!($i~/^(isysroot|mmacosx-version-min)/)) print "-"$i}'`"
- if test $do64bit = yes; then
+ if test $do64bit = yes; then :
case `arch` in
ppc)
- echo "$as_me:$LINENO: checking if compiler accepts -arch ppc64 flag" >&5
-echo $ECHO_N "checking if compiler accepts -arch ppc64 flag... $ECHO_C" >&6
-if test "${tcl_cv_cc_arch_ppc64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch ppc64 flag" >&5
+$as_echo_n "checking if compiler accepts -arch ppc64 flag... " >&6; }
+if ${tcl_cv_cc_arch_ppc64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS
CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7583,62 +5794,33 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_cc_arch_ppc64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_arch_ppc64=no
+ tcl_cv_cc_arch_ppc64=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_ppc64" >&5
-echo "${ECHO_T}$tcl_cv_cc_arch_ppc64" >&6
- if test $tcl_cv_cc_arch_ppc64 = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_ppc64" >&5
+$as_echo "$tcl_cv_cc_arch_ppc64" >&6; }
+ if test $tcl_cv_cc_arch_ppc64 = yes; then :
CFLAGS="$CFLAGS -arch ppc64 -mpowerpc64 -mcpu=G5"
do64bit_ok=yes
-fi
-;;
+fi;;
i386)
- echo "$as_me:$LINENO: checking if compiler accepts -arch x86_64 flag" >&5
-echo $ECHO_N "checking if compiler accepts -arch x86_64 flag... $ECHO_C" >&6
-if test "${tcl_cv_cc_arch_x86_64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if compiler accepts -arch x86_64 flag" >&5
+$as_echo_n "checking if compiler accepts -arch x86_64 flag... " >&6; }
+if ${tcl_cv_cc_arch_x86_64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS
CFLAGS="$CFLAGS -arch x86_64"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7649,79 +5831,48 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_cc_arch_x86_64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_arch_x86_64=no
+ tcl_cv_cc_arch_x86_64=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_arch_x86_64" >&5
-echo "${ECHO_T}$tcl_cv_cc_arch_x86_64" >&6
- if test $tcl_cv_cc_arch_x86_64 = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_arch_x86_64" >&5
+$as_echo "$tcl_cv_cc_arch_x86_64" >&6; }
+ if test $tcl_cv_cc_arch_x86_64 = yes; then :
CFLAGS="$CFLAGS -arch x86_64"
do64bit_ok=yes
-fi
-;;
+fi;;
*)
- { echo "$as_me:$LINENO: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5
-echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&5
+$as_echo "$as_me: WARNING: Don't know how enable 64-bit on architecture \`arch\`" >&2;};;
esac
else
# Check for combined 32-bit and 64-bit fat build
if echo "$CFLAGS " |grep -E -q -- '-arch (ppc64|x86_64) ' \
- && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then
+ && echo "$CFLAGS " |grep -E -q -- '-arch (ppc|i386) '; then :
fat_32_64=yes
fi
-
fi
-
SHLIB_LD='${CC} -dynamiclib ${CFLAGS} ${LDFLAGS}'
- echo "$as_me:$LINENO: checking if ld accepts -single_module flag" >&5
-echo $ECHO_N "checking if ld accepts -single_module flag... $ECHO_C" >&6
-if test "${tcl_cv_ld_single_module+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -single_module flag" >&5
+$as_echo_n "checking if ld accepts -single_module flag... " >&6; }
+if ${tcl_cv_ld_single_module+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_ldflags=$LDFLAGS
LDFLAGS="$LDFLAGS -dynamiclib -Wl,-single_module"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7732,64 +5883,35 @@ int i;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_ld_single_module=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_ld_single_module=no
+ tcl_cv_ld_single_module=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LDFLAGS=$hold_ldflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_ld_single_module" >&5
-echo "${ECHO_T}$tcl_cv_ld_single_module" >&6
- if test $tcl_cv_ld_single_module = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_single_module" >&5
+$as_echo "$tcl_cv_ld_single_module" >&6; }
+ if test $tcl_cv_ld_single_module = yes; then :
SHLIB_LD="${SHLIB_LD} -Wl,-single_module"
fi
-
SHLIB_SUFFIX=".dylib"
DL_OBJS="tclLoadDyld.o"
DL_LIBS=""
LDFLAGS="$LDFLAGS -headerpad_max_install_names"
- echo "$as_me:$LINENO: checking if ld accepts -search_paths_first flag" >&5
-echo $ECHO_N "checking if ld accepts -search_paths_first flag... $ECHO_C" >&6
-if test "${tcl_cv_ld_search_paths_first+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if ld accepts -search_paths_first flag" >&5
+$as_echo_n "checking if ld accepts -search_paths_first flag... " >&6; }
+if ${tcl_cv_ld_search_paths_first+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_ldflags=$LDFLAGS
LDFLAGS="$LDFLAGS -Wl,-search_paths_first"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -7800,88 +5922,58 @@ int i;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_ld_search_paths_first=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_ld_search_paths_first=no
+ tcl_cv_ld_search_paths_first=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LDFLAGS=$hold_ldflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_ld_search_paths_first" >&5
-echo "${ECHO_T}$tcl_cv_ld_search_paths_first" >&6
- if test $tcl_cv_ld_search_paths_first = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_search_paths_first" >&5
+$as_echo "$tcl_cv_ld_search_paths_first" >&6; }
+ if test $tcl_cv_ld_search_paths_first = yes; then :
LDFLAGS="$LDFLAGS -Wl,-search_paths_first"
fi
+ if test "$tcl_cv_cc_visibility_hidden" != yes; then :
- if test "$tcl_cv_cc_visibility_hidden" != yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE __private_extern__
-_ACEOF
+$as_echo "#define MODULE_SCOPE __private_extern__" >>confdefs.h
fi
-
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
LD_LIBRARY_PATH_VAR="DYLD_LIBRARY_PATH"
-cat >>confdefs.h <<\_ACEOF
-#define MAC_OSX_TCL 1
-_ACEOF
+$as_echo "#define MAC_OSX_TCL 1" >>confdefs.h
PLAT_OBJS='${MAC_OSX_OBJS}'
PLAT_SRCS='${MAC_OSX_SRCS}'
- echo "$as_me:$LINENO: checking whether to use CoreFoundation" >&5
-echo $ECHO_N "checking whether to use CoreFoundation... $ECHO_C" >&6
- # Check whether --enable-corefoundation or --disable-corefoundation was given.
-if test "${enable_corefoundation+set}" = set; then
- enableval="$enable_corefoundation"
- tcl_corefoundation=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use CoreFoundation" >&5
+$as_echo_n "checking whether to use CoreFoundation... " >&6; }
+ # Check whether --enable-corefoundation was given.
+if test "${enable_corefoundation+set}" = set; then :
+ enableval=$enable_corefoundation; tcl_corefoundation=$enableval
else
tcl_corefoundation=yes
-fi;
- echo "$as_me:$LINENO: result: $tcl_corefoundation" >&5
-echo "${ECHO_T}$tcl_corefoundation" >&6
- if test $tcl_corefoundation = yes; then
+fi
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_corefoundation" >&5
+$as_echo "$tcl_corefoundation" >&6; }
+ if test $tcl_corefoundation = yes; then :
- echo "$as_me:$LINENO: checking for CoreFoundation.framework" >&5
-echo $ECHO_N "checking for CoreFoundation.framework... $ECHO_C" >&6
-if test "${tcl_cv_lib_corefoundation+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for CoreFoundation.framework" >&5
+$as_echo_n "checking for CoreFoundation.framework... " >&6; }
+if ${tcl_cv_lib_corefoundation+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_libs=$LIBS
- if test "$fat_32_64" = yes; then
+ if test "$fat_32_64" = yes; then :
for v in CFLAGS CPPFLAGS LDFLAGS; do
# On Tiger there is no 64-bit CF, so remove 64-bit
@@ -7891,13 +5983,8 @@ else
eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc64 / /g" -e "s/-arch x86_64 / /g"`"'
done
fi
-
LIBS="$LIBS -framework CoreFoundation"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <CoreFoundation/CoreFoundation.h>
int
@@ -7908,77 +5995,45 @@ CFBundleRef b = CFBundleGetMainBundle();
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_lib_corefoundation=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_lib_corefoundation=no
+ tcl_cv_lib_corefoundation=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
- if test "$fat_32_64" = yes; then
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
+ if test "$fat_32_64" = yes; then :
for v in CFLAGS CPPFLAGS LDFLAGS; do
eval $v'="$hold_'$v'"'
done
fi
-
LIBS=$hold_libs
fi
-echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation" >&5
-echo "${ECHO_T}$tcl_cv_lib_corefoundation" >&6
- if test $tcl_cv_lib_corefoundation = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation" >&5
+$as_echo "$tcl_cv_lib_corefoundation" >&6; }
+ if test $tcl_cv_lib_corefoundation = yes; then :
LIBS="$LIBS -framework CoreFoundation"
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_COREFOUNDATION 1
-_ACEOF
+$as_echo "#define HAVE_COREFOUNDATION 1" >>confdefs.h
else
tcl_corefoundation=no
fi
+ if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then :
- if test "$fat_32_64" = yes -a $tcl_corefoundation = yes; then
-
- echo "$as_me:$LINENO: checking for 64-bit CoreFoundation" >&5
-echo $ECHO_N "checking for 64-bit CoreFoundation... $ECHO_C" >&6
-if test "${tcl_cv_lib_corefoundation_64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit CoreFoundation" >&5
+$as_echo_n "checking for 64-bit CoreFoundation... " >&6; }
+if ${tcl_cv_lib_corefoundation_64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
for v in CFLAGS CPPFLAGS LDFLAGS; do
eval 'hold_'$v'="$'$v'";'$v'="`echo "$'$v' "|sed -e "s/-arch ppc / /g" -e "s/-arch i386 / /g"`"'
done
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <CoreFoundation/CoreFoundation.h>
int
@@ -7989,114 +6044,43 @@ CFBundleRef b = CFBundleGetMainBundle();
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_lib_corefoundation_64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_lib_corefoundation_64=no
+ tcl_cv_lib_corefoundation_64=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
for v in CFLAGS CPPFLAGS LDFLAGS; do
eval $v'="$hold_'$v'"'
done
fi
-echo "$as_me:$LINENO: result: $tcl_cv_lib_corefoundation_64" >&5
-echo "${ECHO_T}$tcl_cv_lib_corefoundation_64" >&6
- if test $tcl_cv_lib_corefoundation_64 = no; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_lib_corefoundation_64" >&5
+$as_echo "$tcl_cv_lib_corefoundation_64" >&6; }
+ if test $tcl_cv_lib_corefoundation_64 = no; then :
-cat >>confdefs.h <<\_ACEOF
-#define NO_COREFOUNDATION_64 1
-_ACEOF
+$as_echo "#define NO_COREFOUNDATION_64 1" >>confdefs.h
LDFLAGS="$LDFLAGS -Wl,-no_arch_warnings"
fi
-
fi
-
fi
-
- ;;
- NEXTSTEP-*)
- SHLIB_CFLAGS=""
- SHLIB_LD='${CC} -nostdlib -r'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadNext.o"
- DL_LIBS=""
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
;;
OS/390-*)
SHLIB_LD_LIBS=""
CFLAGS_OPTIMIZE="" # Optimizer is buggy
-cat >>confdefs.h <<\_ACEOF
-#define _OE_SOCKETS 1
-_ACEOF
-
- ;;
- OSF1-1.0|OSF1-1.1|OSF1-1.2)
- # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
- SHLIB_CFLAGS=""
- # Hack: make package name same as library name
- SHLIB_LD='ld -R -export :'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadOSF.o"
- DL_LIBS=""
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-1.*)
- # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
- SHLIB_CFLAGS="-fPIC"
- if test "$SHARED_BUILD" = 1; then
- SHLIB_LD="ld -shared"
-else
-
- SHLIB_LD="ld -non_shared"
-
-fi
+$as_echo "#define _OE_SOCKETS 1" >>confdefs.h
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
;;
OSF1-V*)
# Digital OSF/1
SHLIB_CFLAGS=""
- if test "$SHARED_BUILD" = 1; then
+ if test "$SHARED_BUILD" = 1; then :
SHLIB_LD='ld -shared -expect_unresolved "*"'
@@ -8105,43 +6089,34 @@ else
SHLIB_LD='ld -non_shared -expect_unresolved "*"'
fi
-
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS=""
- if test $doRpath = yes; then
+ if test $doRpath = yes; then :
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'
fi
-
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
CFLAGS="$CFLAGS -mieee"
else
CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"
fi
-
# see pthread_intro(3) for pthread support on osf1, k.furukawa
- if test "${TCL_THREADS}" = 1; then
-
- CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
- CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
- LIBS=`echo $LIBS | sed s/-lpthreads//`
- if test "$GCC" = yes; then
+ CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
+ CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ if test "$GCC" = yes; then :
- LIBS="$LIBS -lpthread -lmach -lexc"
+ LIBS="$LIBS -lpthread -lmach -lexc"
else
- CFLAGS="$CFLAGS -pthread"
- LDFLAGS="$LDFLAGS -pthread"
-
-fi
-
+ CFLAGS="$CFLAGS -pthread"
+ LDFLAGS="$LDFLAGS -pthread"
fi
-
;;
QNX-6*)
# QNX RTP
@@ -8160,7 +6135,7 @@ fi
# 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 "$GCC" = yes; then
+ if test "$GCC" = yes; then :
SHLIB_CFLAGS="-fPIC -melf"
LDFLAGS="$LDFLAGS -melf -Wl,-Bexport"
@@ -8171,7 +6146,6 @@ else
LDFLAGS="$LDFLAGS -belf -Wl,-Bexport"
fi
-
SHLIB_LD="ld -G"
SHLIB_LD_LIBS=""
SHLIB_SUFFIX=".so"
@@ -8180,35 +6154,6 @@ fi
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- SINIX*5.4*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD='${CC} -G'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- SunOS-4*)
- SHLIB_CFLAGS="-PIC"
- SHLIB_LD="ld"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- 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
- # requires an extra version number at the end of .so file names.
- # So, the library has to have a name like libtcl75.so.1.0
-
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}'
- UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
SunOS-5.[0-6])
# Careful to not let 5.10+ fall into this case
@@ -8216,21 +6161,17 @@ fi
# won't define thread-safe library routines.
-cat >>confdefs.h <<\_ACEOF
-#define _REENTRANT 1
-_ACEOF
+$as_echo "#define _REENTRANT 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define _POSIX_PTHREAD_SEMANTICS 1
-_ACEOF
+$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h
SHLIB_CFLAGS="-KPIC"
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
SHLIB_LD='${CC} -shared'
CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
@@ -8243,37 +6184,32 @@ else
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 <<\_ACEOF
-#define _REENTRANT 1
-_ACEOF
+$as_echo "#define _REENTRANT 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define _POSIX_PTHREAD_SEMANTICS 1
-_ACEOF
+$as_echo "#define _POSIX_PTHREAD_SEMANTICS 1" >>confdefs.h
SHLIB_CFLAGS="-KPIC"
# Check to enable 64-bit flags for compiler/linker
- if test "$do64bit" = yes; then
+ if test "$do64bit" = yes; then :
arch=`isainfo`
- if test "$arch" = "sparcv9 sparc"; then
+ if test "$arch" = "sparcv9 sparc"; then :
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
- if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then
+ if test "`${CC} -dumpversion | awk -F. '{print $1}'`" -lt 3; then :
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5
-echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&5
+$as_echo "$as_me: WARNING: 64bit mode not supported with GCC < 3.2 on $system" >&2;}
else
@@ -8284,11 +6220,10 @@ else
fi
-
else
do64bit_ok=yes
- if test "$do64bitVIS" = yes; then
+ if test "$do64bitVIS" = yes; then :
CFLAGS="$CFLAGS -xarch=v9a"
LDFLAGS_ARCH="-xarch=v9a"
@@ -8299,17 +6234,15 @@ else
LDFLAGS_ARCH="-xarch=v9"
fi
-
# Solaris 64 uses this as well
#LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH_64"
fi
-
else
- if test "$arch" = "amd64 i386"; then
+ if test "$arch" = "amd64 i386"; then :
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
case $system in
SunOS-5.1[1-9]*|SunOS-5.[2-9][0-9]*)
@@ -8317,8 +6250,8 @@ else
CFLAGS="$CFLAGS -m64"
LDFLAGS="$LDFLAGS -m64";;
*)
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported with GCC on $system" >&5
-echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};;
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported with GCC on $system" >&5
+$as_echo "$as_me: WARNING: 64bit mode not supported with GCC on $system" >&2;};;
esac
else
@@ -8335,169 +6268,32 @@ else
fi
-
else
- { echo "$as_me:$LINENO: WARNING: 64bit mode not supported for $arch" >&5
-echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit mode not supported for $arch" >&5
+$as_echo "$as_me: WARNING: 64bit mode not supported for $arch" >&2;}
fi
-
fi
-
fi
-
#--------------------------------------------------------------------
# On Solaris 5.x i386 with the sunpro compiler we need to link
# with sunmath to get floating point rounding control
#--------------------------------------------------------------------
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
use_sunmath=no
else
arch=`isainfo`
- echo "$as_me:$LINENO: checking whether to use -lsunmath for fp rounding control" >&5
-echo $ECHO_N "checking whether to use -lsunmath for fp rounding control... $ECHO_C" >&6
- if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use -lsunmath for fp rounding control" >&5
+$as_echo_n "checking whether to use -lsunmath for fp rounding control... " >&6; }
+ if test "$arch" = "amd64 i386" -o "$arch" = "i386"; then :
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
MATH_LIBS="-lsunmath $MATH_LIBS"
- if test "${ac_cv_header_sunmath_h+set}" = set; then
- echo "$as_me:$LINENO: checking for sunmath.h" >&5
-echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6
-if test "${ac_cv_header_sunmath_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5
-echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking sunmath.h usability" >&5
-echo $ECHO_N "checking sunmath.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <sunmath.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking sunmath.h presence" >&5
-echo $ECHO_N "checking sunmath.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <sunmath.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: sunmath.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: sunmath.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: sunmath.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: sunmath.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: sunmath.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: sunmath.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: sunmath.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: sunmath.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: sunmath.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: sunmath.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: sunmath.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: sunmath.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: sunmath.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for sunmath.h" >&5
-echo $ECHO_N "checking for sunmath.h... $ECHO_C" >&6
-if test "${ac_cv_header_sunmath_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_sunmath_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_sunmath_h" >&5
-echo "${ECHO_T}$ac_cv_header_sunmath_h" >&6
+ ac_fn_c_check_header_mongrel "$LINENO" "sunmath.h" "ac_cv_header_sunmath_h" "$ac_includes_default"
+if test "x$ac_cv_header_sunmath_h" = xyes; then :
fi
@@ -8506,26 +6302,24 @@ fi
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
use_sunmath=no
fi
-
fi
-
SHLIB_SUFFIX=".so"
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
- if test "$GCC" = yes; then
+ if test "$GCC" = yes; then :
SHLIB_LD='${CC} -shared'
CC_SEARCH_FLAGS='-Wl,-R,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- if test "$do64bit_ok" = yes; then
+ if test "$do64bit_ok" = yes; then :
- if test "$arch" = "sparcv9 sparc"; then
+ if test "$arch" = "sparcv9 sparc"; then :
# We need to specify -static-libgcc or we need to
# add the path to the sparv9 libgcc.
@@ -8536,26 +6330,22 @@ fi
#CC_SEARCH_FLAGS="${CC_SEARCH_FLAGS},-R,$v9gcclibdir"
else
- if test "$arch" = "amd64 i386"; then
+ if test "$arch" = "amd64 i386"; then :
SHLIB_LD="$SHLIB_LD -m64 -static-libgcc"
fi
-
fi
-
fi
-
else
- if test "$use_sunmath" = yes; then
+ if test "$use_sunmath" = yes; then :
textmode=textoff
else
textmode=text
fi
-
case $system in
SunOS-5.[1-9][0-9]*|SunOS-5.[7-9])
SHLIB_LD="\${CC} -G -z $textmode \${LDFLAGS}";;
@@ -8566,7 +6356,6 @@ fi
LD_SEARCH_FLAGS='-R ${LIB_RUNTIME_DIR}'
fi
-
;;
UNIX_SV* | UnixWare-5*)
SHLIB_CFLAGS="-KPIC"
@@ -8577,19 +6366,15 @@ fi
DL_LIBS="-ldl"
# Some UNIX_SV* systems (unixware 1.1.2 for example) have linkers
# that don't grok the -Bexport option. Test that it does.
- echo "$as_me:$LINENO: checking for ld accepts -Bexport flag" >&5
-echo $ECHO_N "checking for ld accepts -Bexport flag... $ECHO_C" >&6
-if test "${tcl_cv_ld_Bexport+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ld accepts -Bexport flag" >&5
+$as_echo_n "checking for ld accepts -Bexport flag... " >&6; }
+if ${tcl_cv_ld_Bexport+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_ldflags=$LDFLAGS
LDFLAGS="$LDFLAGS -Wl,-Bexport"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -8600,93 +6385,63 @@ int i;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_ld_Bexport=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_ld_Bexport=no
+ tcl_cv_ld_Bexport=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LDFLAGS=$hold_ldflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_ld_Bexport" >&5
-echo "${ECHO_T}$tcl_cv_ld_Bexport" >&6
- if test $tcl_cv_ld_Bexport = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_ld_Bexport" >&5
+$as_echo "$tcl_cv_ld_Bexport" >&6; }
+ if test $tcl_cv_ld_Bexport = yes; then :
LDFLAGS="$LDFLAGS -Wl,-Bexport"
fi
-
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
esac
- if test "$do64bit" = yes -a "$do64bit_ok" = no; then
+ if test "$do64bit" = yes -a "$do64bit_ok" = no; then :
- { echo "$as_me:$LINENO: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5
-echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 64bit support being disabled -- don't know magic for this platform" >&5
+$as_echo "$as_me: WARNING: 64bit support being disabled -- don't know magic for this platform" >&2;}
fi
+ if test "$do64bit" = yes -a "$do64bit_ok" = yes; then :
- if test "$do64bit" = yes -a "$do64bit_ok" = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_DO64BIT 1
-_ACEOF
+$as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h
fi
-
# Step 4: disable dynamic loading if requested via a command-line switch.
- # Check whether --enable-load or --disable-load was given.
-if test "${enable_load+set}" = set; then
- enableval="$enable_load"
- tcl_ok=$enableval
+ # Check whether --enable-load was given.
+if test "${enable_load+set}" = set; then :
+ enableval=$enable_load; tcl_ok=$enableval
else
tcl_ok=yes
-fi;
- if test "$tcl_ok" = no; then
- DL_OBJS=""
fi
+ if test "$tcl_ok" = no; then :
+ DL_OBJS=""
+fi
- if test "x$DL_OBJS" != x; then
+ if test "x$DL_OBJS" != x; then :
BUILD_DLTEST="\$(DLTEST_TARGETS)"
else
- { echo "$as_me:$LINENO: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5
-echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&5
+$as_echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libraries on this system." >&2;}
SHLIB_CFLAGS=""
SHLIB_LD=""
SHLIB_SUFFIX=""
@@ -8698,19 +6453,18 @@ echo "$as_me: WARNING: Can't figure out how to do dynamic loading or shared libr
BUILD_DLTEST=""
fi
-
LDFLAGS="$LDFLAGS $LDFLAGS_ARCH"
# If we're running gcc, then change the C flags for compiling shared
# libraries to the right flags for gcc, instead of those for the
# standard manufacturer compiler.
- if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then
+ if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then :
case $system in
AIX-*) ;;
BSD/OS*) ;;
- CYGWIN_*|MINGW32_*) ;;
+ CYGWIN_*) ;;
IRIX*) ;;
NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
Darwin-*) ;;
@@ -8719,35 +6473,29 @@ fi
esac
fi
+ if test "$tcl_cv_cc_visibility_hidden" != yes; then :
- if test "$tcl_cv_cc_visibility_hidden" != yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE extern
-_ACEOF
+$as_echo "#define MODULE_SCOPE extern" >>confdefs.h
fi
-
- if test "$SHARED_LIB_SUFFIX" = ""; then
+ if test "$SHARED_LIB_SUFFIX" = ""; then :
SHARED_LIB_SUFFIX='${VERSION}${SHLIB_SUFFIX}'
fi
-
- if test "$UNSHARED_LIB_SUFFIX" = ""; then
+ if test "$UNSHARED_LIB_SUFFIX" = ""; then :
UNSHARED_LIB_SUFFIX='${VERSION}.a'
fi
-
DLL_INSTALL_DIR="\$(LIB_INSTALL_DIR)"
- if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then
+ if test "${SHARED_BUILD}" = 1 -a "${SHLIB_SUFFIX}" != ""; then :
LIB_SUFFIX=${SHARED_LIB_SUFFIX}
MAKE_LIB='${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS}'
- if test "${SHLIB_SUFFIX}" = ".dll"; then
+ if test "${SHLIB_SUFFIX}" = ".dll"; then :
INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(BIN_INSTALL_DIR)/$(LIB_FILE)";if test -f $(LIB_FILE).a; then $(INSTALL_DATA) $(LIB_FILE).a "$(LIB_INSTALL_DIR)"; fi;'
DLL_INSTALL_DIR="\$(BIN_INSTALL_DIR)"
@@ -8758,12 +6506,11 @@ else
fi
-
else
LIB_SUFFIX=${UNSHARED_LIB_SUFFIX}
- if test "$RANLIB" = ""; then
+ if test "$RANLIB" = ""; then :
MAKE_LIB='$(STLIB_LD) $@ ${OBJS}'
@@ -8772,14 +6519,12 @@ else
MAKE_LIB='${STLIB_LD} $@ ${OBJS} ; ${RANLIB} $@'
fi
-
INSTALL_LIB='$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)"'
fi
-
# Stub lib does not depend on shared/static configuration
- if test "$RANLIB" = ""; then
+ if test "$RANLIB" = ""; then :
MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS}'
@@ -8788,33 +6533,27 @@ else
MAKE_STUB_LIB='${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@'
fi
-
INSTALL_STUB_LIB='$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)"'
# Define TCL_LIBS now that we know what DL_LIBS is.
# The trick here is that we don't want to change the value of TCL_LIBS if
# it is already set when tclConfig.sh had been loaded by Tk.
- if test "x${TCL_LIBS}" = x; then
+ if test "x${TCL_LIBS}" = x; then :
TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"
fi
-
# See if the compiler supports casting to a union type.
# This is used to stop gcc from printing a compiler
# warning when initializing a union member.
- echo "$as_me:$LINENO: checking for cast to union support" >&5
-echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
-if test "${tcl_cv_cast_to_union+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
+$as_echo_n "checking for cast to union support... " >&6; }
+if ${tcl_cv_cast_to_union+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -8828,45 +6567,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_cast_to_union=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cast_to_union=no
+ tcl_cv_cast_to_union=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
-echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
+$as_echo "$tcl_cv_cast_to_union" >&6; }
if test "$tcl_cv_cast_to_union" = "yes"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_CAST_TO_UNION 1
-_ACEOF
+$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
fi
@@ -8912,38 +6625,34 @@ _ACEOF
- echo "$as_me:$LINENO: checking for build with symbols" >&5
-echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6
- # Check whether --enable-symbols or --disable-symbols was given.
-if test "${enable_symbols+set}" = set; then
- enableval="$enable_symbols"
- tcl_ok=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
+$as_echo_n "checking for build with symbols... " >&6; }
+ # Check whether --enable-symbols was given.
+if test "${enable_symbols+set}" = set; then :
+ enableval=$enable_symbols; tcl_ok=$enableval
else
tcl_ok=no
-fi;
+fi
+
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
DBGX=""
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
-cat >>confdefs.h <<\_ACEOF
-#define NDEBUG 1
-_ACEOF
+$as_echo "#define NDEBUG 1" >>confdefs.h
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
-cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_OPTIMIZED 1
-_ACEOF
+$as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h
else
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
-echo "${ECHO_T}yes (standard debugging)" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
+$as_echo "yes (standard debugging)" >&6; }
fi
fi
@@ -8951,45 +6660,32 @@ echo "${ECHO_T}yes (standard debugging)" >&6
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_MEM_DEBUG 1
-_ACEOF
+$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h
fi
if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_COMPILE_DEBUG 1
-_ACEOF
+$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define TCL_COMPILE_STATS 1
-_ACEOF
+$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h
fi
if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
if test "$tcl_ok" = "all"; then
- echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5
-echo "${ECHO_T}enabled symbols mem compile debugging" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
+$as_echo "enabled symbols mem compile debugging" >&6; }
else
- echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5
-echo "${ECHO_T}enabled $tcl_ok debugging" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
+$as_echo "enabled $tcl_ok debugging" >&6; }
fi
fi
-cat >>confdefs.h <<\_ACEOF
-#define TCL_TOMMATH 1
-_ACEOF
-
-
-cat >>confdefs.h <<\_ACEOF
-#define MP_PREC 4
-_ACEOF
+$as_echo "#define MP_PREC 4" >>confdefs.h
#--------------------------------------------------------------------
@@ -8997,18 +6693,14 @@ _ACEOF
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for required early compiler flags" >&5
-echo $ECHO_N "checking for required early compiler flags... $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for required early compiler flags" >&5
+$as_echo_n "checking for required early compiler flags... " >&6; }
tcl_flags=""
- if test "${tcl_cv_flag__isoc99_source+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${tcl_cv_flag__isoc99_source+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
int
@@ -9019,38 +6711,10 @@ char *p = (char *)strtoll; char *q = (char *)strtoull;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_flag__isoc99_source=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define _ISOC99_SOURCE 1
#include <stdlib.h>
@@ -9062,58 +6726,28 @@ char *p = (char *)strtoll; char *q = (char *)strtoull;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_flag__isoc99_source=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_flag__isoc99_source=no
+ tcl_cv_flag__isoc99_source=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test "x${tcl_cv_flag__isoc99_source}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define _ISOC99_SOURCE 1
-_ACEOF
+$as_echo "#define _ISOC99_SOURCE 1" >>confdefs.h
tcl_flags="$tcl_flags _ISOC99_SOURCE"
fi
- if test "${tcl_cv_flag__largefile64_source+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${tcl_cv_flag__largefile64_source+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/stat.h>
int
@@ -9124,38 +6758,10 @@ struct stat64 buf; int i = stat64("/", &buf);
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_flag__largefile64_source=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define _LARGEFILE64_SOURCE 1
#include <sys/stat.h>
@@ -9167,58 +6773,28 @@ struct stat64 buf; int i = stat64("/", &buf);
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_flag__largefile64_source=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_flag__largefile64_source=no
+ tcl_cv_flag__largefile64_source=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test "x${tcl_cv_flag__largefile64_source}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define _LARGEFILE64_SOURCE 1
-_ACEOF
+$as_echo "#define _LARGEFILE64_SOURCE 1" >>confdefs.h
tcl_flags="$tcl_flags _LARGEFILE64_SOURCE"
fi
- if test "${tcl_cv_flag__largefile_source64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${tcl_cv_flag__largefile_source64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/stat.h>
int
@@ -9229,38 +6805,10 @@ char *p = (char *)open64;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_flag__largefile_source64=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define _LARGEFILE_SOURCE64 1
#include <sys/stat.h>
@@ -9272,72 +6820,42 @@ char *p = (char *)open64;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_flag__largefile_source64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_flag__largefile_source64=no
+ tcl_cv_flag__largefile_source64=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test "x${tcl_cv_flag__largefile_source64}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define _LARGEFILE_SOURCE64 1
-_ACEOF
+$as_echo "#define _LARGEFILE_SOURCE64 1" >>confdefs.h
tcl_flags="$tcl_flags _LARGEFILE_SOURCE64"
fi
if test "x${tcl_flags}" = "x" ; then
- echo "$as_me:$LINENO: result: none" >&5
-echo "${ECHO_T}none" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
+$as_echo "none" >&6; }
else
- echo "$as_me:$LINENO: result: ${tcl_flags}" >&5
-echo "${ECHO_T}${tcl_flags}" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_flags}" >&5
+$as_echo "${tcl_flags}" >&6; }
fi
- echo "$as_me:$LINENO: checking for 64-bit integer type" >&5
-echo $ECHO_N "checking for 64-bit integer type... $ECHO_C" >&6
- if test "${tcl_cv_type_64bit+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for 64-bit integer type" >&5
+$as_echo_n "checking for 64-bit integer type... " >&6; }
+ if ${tcl_cv_type_64bit+:} false; then :
+ $as_echo_n "(cached) " >&6
else
tcl_cv_type_64bit=none
# See if the compiler knows natively about __int64
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -9348,44 +6866,16 @@ __int64 value = (__int64) 0;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_type_64bit=__int64
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_type_64bit="long long"
+ tcl_type_64bit="long long"
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- # See if we should use long anyway Note that we substitute in the
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ # See if we could use long anyway Note that we substitute in the
# type that is our current guess for a 64-bit type inside this check
# program, so it should be modified only carefully...
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -9398,66 +6888,35 @@ switch (0) {
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_type_64bit=${tcl_type_64bit}
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test "${tcl_cv_type_64bit}" = none ; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_WIDE_INT_IS_LONG 1
-_ACEOF
+$as_echo "#define TCL_WIDE_INT_IS_LONG 1" >>confdefs.h
- echo "$as_me:$LINENO: result: using long" >&5
-echo "${ECHO_T}using long" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
cat >>confdefs.h <<_ACEOF
#define TCL_WIDE_INT_TYPE ${tcl_cv_type_64bit}
_ACEOF
- echo "$as_me:$LINENO: result: ${tcl_cv_type_64bit}" >&5
-echo "${ECHO_T}${tcl_cv_type_64bit}" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${tcl_cv_type_64bit}" >&5
+$as_echo "${tcl_cv_type_64bit}" >&6; }
# Now check for auxiliary declarations
- echo "$as_me:$LINENO: checking for struct dirent64" >&5
-echo $ECHO_N "checking for struct dirent64... $ECHO_C" >&6
-if test "${tcl_cv_struct_dirent64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct dirent64" >&5
+$as_echo_n "checking for struct dirent64... " >&6; }
+if ${tcl_cv_struct_dirent64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <dirent.h>
@@ -9469,58 +6928,28 @@ struct dirent64 p;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_struct_dirent64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_struct_dirent64=no
+ tcl_cv_struct_dirent64=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_struct_dirent64" >&5
-echo "${ECHO_T}$tcl_cv_struct_dirent64" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_dirent64" >&5
+$as_echo "$tcl_cv_struct_dirent64" >&6; }
if test "x${tcl_cv_struct_dirent64}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_STRUCT_DIRENT64 1
-_ACEOF
+$as_echo "#define HAVE_STRUCT_DIRENT64 1" >>confdefs.h
fi
- echo "$as_me:$LINENO: checking for DIR64" >&5
-echo $ECHO_N "checking for DIR64... $ECHO_C" >&6
-if test "${tcl_cv_DIR64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for DIR64" >&5
+$as_echo_n "checking for DIR64... " >&6; }
+if ${tcl_cv_DIR64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <dirent.h>
@@ -9533,58 +6962,28 @@ struct dirent64 *p; DIR64 d = opendir64(".");
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_DIR64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_DIR64=no
+ tcl_cv_DIR64=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_DIR64" >&5
-echo "${ECHO_T}$tcl_cv_DIR64" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_DIR64" >&5
+$as_echo "$tcl_cv_DIR64" >&6; }
if test "x${tcl_cv_DIR64}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_DIR64 1
-_ACEOF
+$as_echo "#define HAVE_DIR64 1" >>confdefs.h
fi
- echo "$as_me:$LINENO: checking for struct stat64" >&5
-echo $ECHO_N "checking for struct stat64... $ECHO_C" >&6
-if test "${tcl_cv_struct_stat64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct stat64" >&5
+$as_echo_n "checking for struct stat64... " >&6; }
+if ${tcl_cv_struct_stat64+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/stat.h>
int
@@ -9596,161 +6995,40 @@ struct stat64 p;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_struct_stat64=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_struct_stat64=no
+ tcl_cv_struct_stat64=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_struct_stat64" >&5
-echo "${ECHO_T}$tcl_cv_struct_stat64" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_struct_stat64" >&5
+$as_echo "$tcl_cv_struct_stat64" >&6; }
if test "x${tcl_cv_struct_stat64}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_STRUCT_STAT64 1
-_ACEOF
+$as_echo "#define HAVE_STRUCT_STAT64 1" >>confdefs.h
fi
-
-
-for ac_func in open64 lseek64
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+ for ac_func in open64 lseek64
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
done
- echo "$as_me:$LINENO: checking for off64_t" >&5
-echo $ECHO_N "checking for off64_t... $ECHO_C" >&6
- if test "${tcl_cv_type_off64_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for off64_t" >&5
+$as_echo_n "checking for off64_t... " >&6; }
+ if ${tcl_cv_type_off64_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
int
@@ -9762,51 +7040,25 @@ off64_t offset;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_type_off64_t=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_type_off64_t=no
+ tcl_cv_type_off64_t=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
if test "x${tcl_cv_type_off64_t}" = "xyes" && \
test "x${ac_cv_func_lseek64}" = "xyes" && \
test "x${ac_cv_func_open64}" = "xyes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_TYPE_OFF64_T 1
-_ACEOF
+$as_echo "#define HAVE_TYPE_OFF64_T 1" >>confdefs.h
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
fi
@@ -9816,235 +7068,229 @@ echo "${ECHO_T}no" >&6
# Tcl_UniChar strings to memcmp on big-endian systems.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking whether byte ordering is bigendian" >&5
-echo $ECHO_N "checking whether byte ordering is bigendian... $ECHO_C" >&6
-if test "${ac_cv_c_bigendian+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5
+$as_echo_n "checking whether byte ordering is bigendian... " >&6; }
+if ${ac_cv_c_bigendian+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- # See if sys/param.h defines the BYTE_ORDER macro.
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ ac_cv_c_bigendian=unknown
+ # See if we're dealing with a universal compiler.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#ifndef __APPLE_CC__
+ not a universal capable compiler
+ #endif
+ typedef int dummy;
+
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+ # Check for potential -arch flags. It is not universal unless
+ # there are at least two -arch flags with different values.
+ ac_arch=
+ ac_prev=
+ for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do
+ if test -n "$ac_prev"; then
+ case $ac_word in
+ i?86 | x86_64 | ppc | ppc64)
+ if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then
+ ac_arch=$ac_word
+ else
+ ac_cv_c_bigendian=universal
+ break
+ fi
+ ;;
+ esac
+ ac_prev=
+ elif test "x$ac_word" = "x-arch"; then
+ ac_prev=arch
+ fi
+ done
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ if test $ac_cv_c_bigendian = unknown; then
+ # See if sys/param.h defines the BYTE_ORDER macro.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
-#include <sys/param.h>
+ #include <sys/param.h>
int
main ()
{
-#if !BYTE_ORDER || !BIG_ENDIAN || !LITTLE_ENDIAN
- bogus endian macros
-#endif
+#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \
+ && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \
+ && LITTLE_ENDIAN)
+ bogus endian macros
+ #endif
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
# It does; now see whether it defined to BIG_ENDIAN or not.
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
-#include <sys/param.h>
+ #include <sys/param.h>
int
main ()
{
#if BYTE_ORDER != BIG_ENDIAN
- not big endian
-#endif
+ not big endian
+ #endif
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_c_bigendian=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_c_bigendian=no
+ ac_cv_c_bigendian=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+ if test $ac_cv_c_bigendian = unknown; then
+ # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris).
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <limits.h>
-# It does not; compile a test program.
-if test "$cross_compiling" = yes; then
- # try to guess the endianness by grepping values into an object file
- ac_cv_c_bigendian=unknown
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
+int
+main ()
+{
+#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN)
+ bogus endian macros
+ #endif
+
+ ;
+ return 0;
+}
_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ # It does; now see whether it defined to _BIG_ENDIAN or not.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-short ascii_mm[] = { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
-short ascii_ii[] = { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
-void _ascii () { char *s = (char *) ascii_mm; s = (char *) ascii_ii; }
-short ebcdic_ii[] = { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
-short ebcdic_mm[] = { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
-void _ebcdic () { char *s = (char *) ebcdic_mm; s = (char *) ebcdic_ii; }
+#include <limits.h>
+
int
main ()
{
- _ascii (); _ebcdic ();
+#ifndef _BIG_ENDIAN
+ not big endian
+ #endif
+
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- if grep BIGenDianSyS conftest.$ac_objext >/dev/null ; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_c_bigendian=yes
+else
+ ac_cv_c_bigendian=no
fi
-if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
- if test "$ac_cv_c_bigendian" = unknown; then
- ac_cv_c_bigendian=no
- else
- # finding both strings is unlikely to happen, but who knows?
- ac_cv_c_bigendian=unknown
- fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ fi
+ if test $ac_cv_c_bigendian = unknown; then
+ # Compile a test program.
+ if test "$cross_compiling" = yes; then :
+ # Try to guess by grepping values from an object file.
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+short int ascii_mm[] =
+ { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 };
+ short int ascii_ii[] =
+ { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 };
+ int use_ascii (int i) {
+ return ascii_mm[i] + ascii_ii[i];
+ }
+ short int ebcdic_ii[] =
+ { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 };
+ short int ebcdic_mm[] =
+ { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 };
+ int use_ebcdic (int i) {
+ return ebcdic_mm[i] + ebcdic_ii[i];
+ }
+ extern int foo;
+int
+main ()
+{
+return use_ascii (foo) == use_ebcdic (foo);
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then
+ ac_cv_c_bigendian=yes
+ fi
+ if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then
+ if test "$ac_cv_c_bigendian" = unknown; then
+ ac_cv_c_bigendian=no
+ else
+ # finding both strings is unlikely to happen, but who knows?
+ ac_cv_c_bigendian=unknown
+ fi
+ fi
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
+$ac_includes_default
int
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);
+
+ /* Are we little or big endian? From Harbison&Steele. */
+ union
+ {
+ long int l;
+ char c[sizeof (long int)];
+ } u;
+ u.l = 1;
+ return u.c[sizeof (long int) - 1] == 1;
+
+ ;
+ return 0;
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_run "$LINENO"; then :
ac_cv_c_bigendian=no
else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-ac_cv_c_bigendian=yes
-fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+ ac_cv_c_bigendian=yes
fi
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+
+ fi
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_bigendian" >&5
-echo "${ECHO_T}$ac_cv_c_bigendian" >&6
-case $ac_cv_c_bigendian in
- yes)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5
+$as_echo "$ac_cv_c_bigendian" >&6; }
+ case $ac_cv_c_bigendian in #(
+ yes)
+ $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h
+;; #(
+ no)
+ ;; #(
+ universal)
-cat >>confdefs.h <<\_ACEOF
-#define WORDS_BIGENDIAN 1
-_ACEOF
- ;;
- no)
- ;;
- *)
- { { echo "$as_me:$LINENO: error: unknown endianness
-presetting ac_cv_c_bigendian=no (or yes) will help" >&5
-echo "$as_me: error: unknown endianness
-presetting ac_cv_c_bigendian=no (or yes) will help" >&2;}
- { (exit 1); exit 1; }; } ;;
-esac
+$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h
+
+ ;; #(
+ *)
+ as_fn_error $? "unknown endianness
+ presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;;
+ esac
#--------------------------------------------------------------------
@@ -10053,110 +7299,17 @@ esac
#--------------------------------------------------------------------
# Check if Posix compliant getcwd exists, if not we'll use getwd.
-
for ac_func in getcwd
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+do :
+ ac_fn_c_check_func "$LINENO" "getcwd" "ac_cv_func_getcwd"
+if test "x$ac_cv_func_getcwd" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define HAVE_GETCWD 1
_ACEOF
else
-cat >>confdefs.h <<\_ACEOF
-#define USEGETWD 1
-_ACEOF
+$as_echo "#define USEGETWD 1" >>confdefs.h
fi
done
@@ -10164,731 +7317,121 @@ done
# 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_fn_c_check_func "$LINENO" "mkstemp" "ac_cv_func_mkstemp"
+if test "x$ac_cv_func_mkstemp" = xyes; then :
+ $as_echo "#define HAVE_MKSTEMP 1" >>confdefs.h
-
-
-
-for ac_func in mkstemp opendir strtol waitpid
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ case " $LIBOBJS " in
+ *" mkstemp.$ac_objext "* ) ;;
+ *) LIBOBJS="$LIBOBJS mkstemp.$ac_objext"
+ ;;
+esac
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
- cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
+
+ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir"
+if test "x$ac_cv_func_opendir" = xyes; then :
+ $as_echo "#define HAVE_OPENDIR 1" >>confdefs.h
else
- case $LIBOBJS in
- "$ac_func.$ac_objext" | \
- *" $ac_func.$ac_objext" | \
- "$ac_func.$ac_objext "* | \
- *" $ac_func.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS $ac_func.$ac_objext" ;;
+ case " $LIBOBJS " in
+ *" opendir.$ac_objext "* ) ;;
+ *) LIBOBJS="$LIBOBJS opendir.$ac_objext"
+ ;;
esac
fi
-done
+ac_fn_c_check_func "$LINENO" "strtol" "ac_cv_func_strtol"
+if test "x$ac_cv_func_strtol" = xyes; then :
+ $as_echo "#define HAVE_STRTOL 1" >>confdefs.h
-echo "$as_me:$LINENO: checking for strerror" >&5
-echo $ECHO_N "checking for strerror... $ECHO_C" >&6
-if test "${ac_cv_func_strerror+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define strerror to an innocuous variant, in case <limits.h> declares strerror.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define strerror innocuous_strerror
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strerror (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+ case " $LIBOBJS " in
+ *" strtol.$ac_objext "* ) ;;
+ *) LIBOBJS="$LIBOBJS strtol.$ac_objext"
+ ;;
+esac
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
+fi
-#undef strerror
+ac_fn_c_check_func "$LINENO" "waitpid" "ac_cv_func_waitpid"
+if test "x$ac_cv_func_waitpid" = xyes; then :
+ $as_echo "#define HAVE_WAITPID 1" >>confdefs.h
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char strerror ();
-/* 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_strerror) || defined (__stub___strerror)
-choke me
-#else
-char (*f) () = strerror;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != strerror;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_strerror=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ case " $LIBOBJS " in
+ *" waitpid.$ac_objext "* ) ;;
+ *) LIBOBJS="$LIBOBJS waitpid.$ac_objext"
+ ;;
+esac
-ac_cv_func_strerror=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_strerror" >&5
-echo "${ECHO_T}$ac_cv_func_strerror" >&6
-if test $ac_cv_func_strerror = yes; then
- :
-else
-cat >>confdefs.h <<\_ACEOF
-#define NO_STRERROR 1
-_ACEOF
-fi
+ac_fn_c_check_func "$LINENO" "strerror" "ac_cv_func_strerror"
+if test "x$ac_cv_func_strerror" = xyes; then :
-echo "$as_me:$LINENO: checking for getwd" >&5
-echo $ECHO_N "checking for getwd... $ECHO_C" >&6
-if test "${ac_cv_func_getwd+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define getwd to an innocuous variant, in case <limits.h> declares getwd.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define getwd innocuous_getwd
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char getwd (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
+$as_echo "#define NO_STRERROR 1" >>confdefs.h
-#undef getwd
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char getwd ();
-/* 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_getwd) || defined (__stub___getwd)
-choke me
-#else
-char (*f) () = getwd;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != getwd;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_getwd=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_getwd=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_getwd" >&5
-echo "${ECHO_T}$ac_cv_func_getwd" >&6
-if test $ac_cv_func_getwd = yes; then
- :
-else
-cat >>confdefs.h <<\_ACEOF
-#define NO_GETWD 1
-_ACEOF
+ac_fn_c_check_func "$LINENO" "getwd" "ac_cv_func_getwd"
+if test "x$ac_cv_func_getwd" = xyes; then :
-fi
-
-echo "$as_me:$LINENO: checking for wait3" >&5
-echo $ECHO_N "checking for wait3... $ECHO_C" >&6
-if test "${ac_cv_func_wait3+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define wait3 to an innocuous variant, in case <limits.h> declares wait3.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define wait3 innocuous_wait3
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char wait3 (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+$as_echo "#define NO_GETWD 1" >>confdefs.h
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef wait3
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char wait3 ();
-/* 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_wait3) || defined (__stub___wait3)
-choke me
-#else
-char (*f) () = wait3;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != wait3;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_wait3=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_wait3=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_wait3" >&5
-echo "${ECHO_T}$ac_cv_func_wait3" >&6
-if test $ac_cv_func_wait3 = yes; then
- :
-else
-cat >>confdefs.h <<\_ACEOF
-#define NO_WAIT3 1
-_ACEOF
-
-fi
+ac_fn_c_check_func "$LINENO" "wait3" "ac_cv_func_wait3"
+if test "x$ac_cv_func_wait3" = xyes; then :
-echo "$as_me:$LINENO: checking for uname" >&5
-echo $ECHO_N "checking for uname... $ECHO_C" >&6
-if test "${ac_cv_func_uname+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define uname to an innocuous variant, in case <limits.h> declares uname.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define uname innocuous_uname
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char uname (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+$as_echo "#define NO_WAIT3 1" >>confdefs.h
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef uname
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char uname ();
-/* 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_uname) || defined (__stub___uname)
-choke me
-#else
-char (*f) () = uname;
-#endif
-#ifdef __cplusplus
-}
-#endif
+fi
-int
-main ()
-{
-return f != uname;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_uname=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_func "$LINENO" "uname" "ac_cv_func_uname"
+if test "x$ac_cv_func_uname" = xyes; then :
-ac_cv_func_uname=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_uname" >&5
-echo "${ECHO_T}$ac_cv_func_uname" >&6
-if test $ac_cv_func_uname = yes; then
- :
else
-cat >>confdefs.h <<\_ACEOF
-#define NO_UNAME 1
-_ACEOF
+$as_echo "#define NO_UNAME 1" >>confdefs.h
fi
-if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
+if test "`uname -s`" = "Darwin" && \
test "`uname -r | awk -F. '{print $1}'`" -lt 7; then
# prior to Darwin 7, realpath is not threadsafe, so don't
# use it when threads are enabled, c.f. bug # 711232
ac_cv_func_realpath=no
fi
-echo "$as_me:$LINENO: checking for realpath" >&5
-echo $ECHO_N "checking for realpath... $ECHO_C" >&6
-if test "${ac_cv_func_realpath+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define realpath to an innocuous variant, in case <limits.h> declares realpath.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define realpath innocuous_realpath
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char realpath (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef realpath
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char realpath ();
-/* 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_realpath) || defined (__stub___realpath)
-choke me
-#else
-char (*f) () = realpath;
-#endif
-#ifdef __cplusplus
-}
-#endif
+ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath"
+if test "x$ac_cv_func_realpath" = xyes; then :
-int
-main ()
-{
-return f != realpath;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_realpath=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_func_realpath=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_realpath" >&5
-echo "${ECHO_T}$ac_cv_func_realpath" >&6
-if test $ac_cv_func_realpath = yes; then
- :
-else
-
-cat >>confdefs.h <<\_ACEOF
-#define NO_REALPATH 1
-_ACEOF
+$as_echo "#define NO_REALPATH 1" >>confdefs.h
fi
NEED_FAKE_RFC2553=0
-
-
-
-
-for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+ for ac_func in getnameinfo getaddrinfo freeaddrinfo gai_strerror
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
else
@@ -10896,69 +7439,14 @@ else
fi
done
- echo "$as_me:$LINENO: checking for struct addrinfo" >&5
-echo $ECHO_N "checking for struct addrinfo... $ECHO_C" >&6
-if test "${ac_cv_type_struct_addrinfo+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
+ ac_fn_c_check_type "$LINENO" "struct addrinfo" "ac_cv_type_struct_addrinfo" "
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
-
-int
-main ()
-{
-if ((struct addrinfo *) 0)
- return 0;
-if (sizeof (struct addrinfo))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_struct_addrinfo=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_struct_addrinfo=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_struct_addrinfo" >&5
-echo "${ECHO_T}$ac_cv_type_struct_addrinfo" >&6
-if test $ac_cv_type_struct_addrinfo = yes; then
+"
+if test "x$ac_cv_type_struct_addrinfo" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_ADDRINFO 1
@@ -10968,69 +7456,14 @@ _ACEOF
else
NEED_FAKE_RFC2553=1
fi
-echo "$as_me:$LINENO: checking for struct in6_addr" >&5
-echo $ECHO_N "checking for struct in6_addr... $ECHO_C" >&6
-if test "${ac_cv_type_struct_in6_addr+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
+ac_fn_c_check_type "$LINENO" "struct in6_addr" "ac_cv_type_struct_in6_addr" "
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
-
-int
-main ()
-{
-if ((struct in6_addr *) 0)
- return 0;
-if (sizeof (struct in6_addr))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_struct_in6_addr=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_struct_in6_addr=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_struct_in6_addr" >&5
-echo "${ECHO_T}$ac_cv_type_struct_in6_addr" >&6
-if test $ac_cv_type_struct_in6_addr = yes; then
+"
+if test "x$ac_cv_type_struct_in6_addr" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_IN6_ADDR 1
@@ -11040,69 +7473,14 @@ _ACEOF
else
NEED_FAKE_RFC2553=1
fi
-echo "$as_me:$LINENO: checking for struct sockaddr_in6" >&5
-echo $ECHO_N "checking for struct sockaddr_in6... $ECHO_C" >&6
-if test "${ac_cv_type_struct_sockaddr_in6+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
+ac_fn_c_check_type "$LINENO" "struct sockaddr_in6" "ac_cv_type_struct_sockaddr_in6" "
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
-
-int
-main ()
-{
-if ((struct sockaddr_in6 *) 0)
- return 0;
-if (sizeof (struct sockaddr_in6))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_struct_sockaddr_in6=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_struct_sockaddr_in6=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_in6" >&5
-echo "${ECHO_T}$ac_cv_type_struct_sockaddr_in6" >&6
-if test $ac_cv_type_struct_sockaddr_in6 = yes; then
+"
+if test "x$ac_cv_type_struct_sockaddr_in6" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_SOCKADDR_IN6 1
@@ -11112,69 +7490,14 @@ _ACEOF
else
NEED_FAKE_RFC2553=1
fi
-echo "$as_me:$LINENO: checking for struct sockaddr_storage" >&5
-echo $ECHO_N "checking for struct sockaddr_storage... $ECHO_C" >&6
-if test "${ac_cv_type_struct_sockaddr_storage+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-
+ac_fn_c_check_type "$LINENO" "struct sockaddr_storage" "ac_cv_type_struct_sockaddr_storage" "
#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <netdb.h>
-
-int
-main ()
-{
-if ((struct sockaddr_storage *) 0)
- return 0;
-if (sizeof (struct sockaddr_storage))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_struct_sockaddr_storage=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_struct_sockaddr_storage=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_struct_sockaddr_storage" >&5
-echo "${ECHO_T}$ac_cv_type_struct_sockaddr_storage" >&6
-if test $ac_cv_type_struct_sockaddr_storage = yes; then
+"
+if test "x$ac_cv_type_struct_sockaddr_storage" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_SOCKADDR_STORAGE 1
@@ -11187,108 +7510,18 @@ fi
if test "x$NEED_FAKE_RFC2553" = "x1"; then
-cat >>confdefs.h <<\_ACEOF
-#define NEED_FAKE_RFC2553 1
-_ACEOF
+$as_echo "#define NEED_FAKE_RFC2553 1" >>confdefs.h
- case $LIBOBJS in
- "fake-rfc2553.$ac_objext" | \
- *" fake-rfc2553.$ac_objext" | \
- "fake-rfc2553.$ac_objext "* | \
+ case " $LIBOBJS " in
*" fake-rfc2553.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS fake-rfc2553.$ac_objext"
+ ;;
esac
- echo "$as_me:$LINENO: checking for strlcpy" >&5
-echo $ECHO_N "checking for strlcpy... $ECHO_C" >&6
-if test "${ac_cv_func_strlcpy+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define strlcpy to an innocuous variant, in case <limits.h> declares strlcpy.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define strlcpy innocuous_strlcpy
+ ac_fn_c_check_func "$LINENO" "strlcpy" "ac_cv_func_strlcpy"
+if test "x$ac_cv_func_strlcpy" = xyes; then :
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strlcpy (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef strlcpy
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char strlcpy ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_strlcpy) || defined (__stub___strlcpy)
-choke me
-#else
-char (*f) () = strlcpy;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != strlcpy;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_strlcpy=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_strlcpy=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_strlcpy" >&5
-echo "${ECHO_T}$ac_cv_func_strlcpy" >&6
fi
@@ -11297,110 +7530,16 @@ fi
# Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------
-if test "${TCL_THREADS}" = 1; then
- echo "$as_me:$LINENO: checking for getpwuid_r" >&5
-echo $ECHO_N "checking for getpwuid_r... $ECHO_C" >&6
-if test "${ac_cv_func_getpwuid_r+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define getpwuid_r to an innocuous variant, in case <limits.h> declares getpwuid_r.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define getpwuid_r innocuous_getpwuid_r
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char getpwuid_r (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
+ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r"
+if test "x$ac_cv_func_getpwuid_r" = xyes; then :
-#undef getpwuid_r
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char getpwuid_r ();
-/* 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_getpwuid_r) || defined (__stub___getpwuid_r)
-choke me
-#else
-char (*f) () = getpwuid_r;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != getpwuid_r;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_getpwuid_r=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_getpwuid_r=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_getpwuid_r" >&5
-echo "${ECHO_T}$ac_cv_func_getpwuid_r" >&6
-if test $ac_cv_func_getpwuid_r = yes; then
-
- echo "$as_me:$LINENO: checking for getpwuid_r with 5 args" >&5
-echo $ECHO_N "checking for getpwuid_r with 5 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getpwuid_r_5+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5
+$as_echo_n "checking for getpwuid_r with 5 args... " >&6; }
+if ${tcl_cv_api_getpwuid_r_5+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -11421,58 +7560,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getpwuid_r_5=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getpwuid_r_5=no
+ tcl_cv_api_getpwuid_r_5=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_5" >&5
-echo "${ECHO_T}$tcl_cv_api_getpwuid_r_5" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_5" >&5
+$as_echo "$tcl_cv_api_getpwuid_r_5" >&6; }
tcl_ok=$tcl_cv_api_getpwuid_r_5
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETPWUID_R_5 1
-_ACEOF
+$as_echo "#define HAVE_GETPWUID_R_5 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for getpwuid_r with 4 args" >&5
-echo $ECHO_N "checking for getpwuid_r with 4 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getpwuid_r_4+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 4 args" >&5
+$as_echo_n "checking for getpwuid_r with 4 args... " >&6; }
+if ${tcl_cv_api_getpwuid_r_4+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -11493,161 +7602,40 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getpwuid_r_4=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getpwuid_r_4=no
+ tcl_cv_api_getpwuid_r_4=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getpwuid_r_4" >&5
-echo "${ECHO_T}$tcl_cv_api_getpwuid_r_4" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwuid_r_4" >&5
+$as_echo "$tcl_cv_api_getpwuid_r_4" >&6; }
tcl_ok=$tcl_cv_api_getpwuid_r_4
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETPWUID_R_4 1
-_ACEOF
+$as_echo "#define HAVE_GETPWUID_R_4 1" >>confdefs.h
fi
fi
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETPWUID_R 1
-_ACEOF
+$as_echo "#define HAVE_GETPWUID_R 1" >>confdefs.h
fi
fi
- echo "$as_me:$LINENO: checking for getpwnam_r" >&5
-echo $ECHO_N "checking for getpwnam_r... $ECHO_C" >&6
-if test "${ac_cv_func_getpwnam_r+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define getpwnam_r to an innocuous variant, in case <limits.h> declares getpwnam_r.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define getpwnam_r innocuous_getpwnam_r
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char getpwnam_r (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef getpwnam_r
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char getpwnam_r ();
-/* 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_getpwnam_r) || defined (__stub___getpwnam_r)
-choke me
-#else
-char (*f) () = getpwnam_r;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != getpwnam_r;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_getpwnam_r=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_getpwnam_r=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_getpwnam_r" >&5
-echo "${ECHO_T}$ac_cv_func_getpwnam_r" >&6
-if test $ac_cv_func_getpwnam_r = yes; then
+ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r"
+if test "x$ac_cv_func_getpwnam_r" = xyes; then :
- echo "$as_me:$LINENO: checking for getpwnam_r with 5 args" >&5
-echo $ECHO_N "checking for getpwnam_r with 5 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getpwnam_r_5+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5
+$as_echo_n "checking for getpwnam_r with 5 args... " >&6; }
+if ${tcl_cv_api_getpwnam_r_5+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -11668,58 +7656,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getpwnam_r_5=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getpwnam_r_5=no
+ tcl_cv_api_getpwnam_r_5=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_5" >&5
-echo "${ECHO_T}$tcl_cv_api_getpwnam_r_5" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_5" >&5
+$as_echo "$tcl_cv_api_getpwnam_r_5" >&6; }
tcl_ok=$tcl_cv_api_getpwnam_r_5
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETPWNAM_R_5 1
-_ACEOF
+$as_echo "#define HAVE_GETPWNAM_R_5 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for getpwnam_r with 4 args" >&5
-echo $ECHO_N "checking for getpwnam_r with 4 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getpwnam_r_4+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 4 args" >&5
+$as_echo_n "checking for getpwnam_r with 4 args... " >&6; }
+if ${tcl_cv_api_getpwnam_r_4+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -11740,161 +7698,40 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getpwnam_r_4=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getpwnam_r_4=no
+ tcl_cv_api_getpwnam_r_4=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getpwnam_r_4" >&5
-echo "${ECHO_T}$tcl_cv_api_getpwnam_r_4" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getpwnam_r_4" >&5
+$as_echo "$tcl_cv_api_getpwnam_r_4" >&6; }
tcl_ok=$tcl_cv_api_getpwnam_r_4
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETPWNAM_R_4 1
-_ACEOF
+$as_echo "#define HAVE_GETPWNAM_R_4 1" >>confdefs.h
fi
fi
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETPWNAM_R 1
-_ACEOF
+$as_echo "#define HAVE_GETPWNAM_R 1" >>confdefs.h
fi
fi
- echo "$as_me:$LINENO: checking for getgrgid_r" >&5
-echo $ECHO_N "checking for getgrgid_r... $ECHO_C" >&6
-if test "${ac_cv_func_getgrgid_r+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define getgrgid_r to an innocuous variant, in case <limits.h> declares getgrgid_r.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define getgrgid_r innocuous_getgrgid_r
+ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r"
+if test "x$ac_cv_func_getgrgid_r" = xyes; then :
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char getgrgid_r (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef getgrgid_r
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char getgrgid_r ();
-/* 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_getgrgid_r) || defined (__stub___getgrgid_r)
-choke me
-#else
-char (*f) () = getgrgid_r;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != getgrgid_r;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_getgrgid_r=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_getgrgid_r=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_getgrgid_r" >&5
-echo "${ECHO_T}$ac_cv_func_getgrgid_r" >&6
-if test $ac_cv_func_getgrgid_r = yes; then
-
- echo "$as_me:$LINENO: checking for getgrgid_r with 5 args" >&5
-echo $ECHO_N "checking for getgrgid_r with 5 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getgrgid_r_5+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5
+$as_echo_n "checking for getgrgid_r with 5 args... " >&6; }
+if ${tcl_cv_api_getgrgid_r_5+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -11915,58 +7752,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getgrgid_r_5=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getgrgid_r_5=no
+ tcl_cv_api_getgrgid_r_5=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_5" >&5
-echo "${ECHO_T}$tcl_cv_api_getgrgid_r_5" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_5" >&5
+$as_echo "$tcl_cv_api_getgrgid_r_5" >&6; }
tcl_ok=$tcl_cv_api_getgrgid_r_5
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETGRGID_R_5 1
-_ACEOF
+$as_echo "#define HAVE_GETGRGID_R_5 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for getgrgid_r with 4 args" >&5
-echo $ECHO_N "checking for getgrgid_r with 4 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getgrgid_r_4+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 4 args" >&5
+$as_echo_n "checking for getgrgid_r with 4 args... " >&6; }
+if ${tcl_cv_api_getgrgid_r_4+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -11987,161 +7794,40 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getgrgid_r_4=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getgrgid_r_4=no
+ tcl_cv_api_getgrgid_r_4=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getgrgid_r_4" >&5
-echo "${ECHO_T}$tcl_cv_api_getgrgid_r_4" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrgid_r_4" >&5
+$as_echo "$tcl_cv_api_getgrgid_r_4" >&6; }
tcl_ok=$tcl_cv_api_getgrgid_r_4
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETGRGID_R_4 1
-_ACEOF
+$as_echo "#define HAVE_GETGRGID_R_4 1" >>confdefs.h
fi
fi
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETGRGID_R 1
-_ACEOF
+$as_echo "#define HAVE_GETGRGID_R 1" >>confdefs.h
fi
fi
- echo "$as_me:$LINENO: checking for getgrnam_r" >&5
-echo $ECHO_N "checking for getgrnam_r... $ECHO_C" >&6
-if test "${ac_cv_func_getgrnam_r+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define getgrnam_r to an innocuous variant, in case <limits.h> declares getgrnam_r.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define getgrnam_r innocuous_getgrnam_r
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char getgrnam_r (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef getgrnam_r
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char getgrnam_r ();
-/* 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_getgrnam_r) || defined (__stub___getgrnam_r)
-choke me
-#else
-char (*f) () = getgrnam_r;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != getgrnam_r;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_getgrnam_r=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_getgrnam_r=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_getgrnam_r" >&5
-echo "${ECHO_T}$ac_cv_func_getgrnam_r" >&6
-if test $ac_cv_func_getgrnam_r = yes; then
+ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r"
+if test "x$ac_cv_func_getgrnam_r" = xyes; then :
- echo "$as_me:$LINENO: checking for getgrnam_r with 5 args" >&5
-echo $ECHO_N "checking for getgrnam_r with 5 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getgrnam_r_5+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5
+$as_echo_n "checking for getgrnam_r with 5 args... " >&6; }
+if ${tcl_cv_api_getgrnam_r_5+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -12162,58 +7848,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getgrnam_r_5=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getgrnam_r_5=no
+ tcl_cv_api_getgrnam_r_5=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_5" >&5
-echo "${ECHO_T}$tcl_cv_api_getgrnam_r_5" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_5" >&5
+$as_echo "$tcl_cv_api_getgrnam_r_5" >&6; }
tcl_ok=$tcl_cv_api_getgrnam_r_5
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETGRNAM_R_5 1
-_ACEOF
+$as_echo "#define HAVE_GETGRNAM_R_5 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for getgrnam_r with 4 args" >&5
-echo $ECHO_N "checking for getgrnam_r with 4 args... $ECHO_C" >&6
-if test "${tcl_cv_api_getgrnam_r_4+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 4 args" >&5
+$as_echo_n "checking for getgrnam_r with 4 args... " >&6; }
+if ${tcl_cv_api_getgrnam_r_4+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -12234,194 +7890,65 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_getgrnam_r_4=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_getgrnam_r_4=no
+ tcl_cv_api_getgrnam_r_4=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_getgrnam_r_4" >&5
-echo "${ECHO_T}$tcl_cv_api_getgrnam_r_4" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_getgrnam_r_4" >&5
+$as_echo "$tcl_cv_api_getgrnam_r_4" >&6; }
tcl_ok=$tcl_cv_api_getgrnam_r_4
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETGRNAM_R_4 1
-_ACEOF
+$as_echo "#define HAVE_GETGRNAM_R_4 1" >>confdefs.h
fi
fi
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETGRNAM_R 1
-_ACEOF
+$as_echo "#define HAVE_GETGRNAM_R 1" >>confdefs.h
fi
fi
- if test "`uname -s`" = "Darwin" && \
- test "`uname -r | awk -F. '{print $1}'`" -gt 5; then
- # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
- # are actually MT-safe as they always return pointers
- # from TSD instead of static storage.
+if test "`uname -s`" = "Darwin" && \
+ test "`uname -r | awk -F. '{print $1}'`" -gt 5; then
+ # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
+ # are actually MT-safe as they always return pointers
+ # from TSD instead of static storage.
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_MTSAFE_GETHOSTBYNAME 1
-_ACEOF
+$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_MTSAFE_GETHOSTBYADDR 1
-_ACEOF
+$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h
- elif test "`uname -s`" = "HP-UX" && \
- test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
- # Starting with HPUX 11.00 (we believe), gethostbyX
- # are actually MT-safe as they always return pointers
- # from TSD instead of static storage.
+elif test "`uname -s`" = "HP-UX" && \
+ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
+ # Starting with HPUX 11.00 (we believe), gethostbyX
+ # are actually MT-safe as they always return pointers
+ # from TSD instead of static storage.
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_MTSAFE_GETHOSTBYNAME 1
-_ACEOF
+$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_MTSAFE_GETHOSTBYADDR 1
-_ACEOF
+$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h
- else
- echo "$as_me:$LINENO: checking for gethostbyname_r" >&5
-echo $ECHO_N "checking for gethostbyname_r... $ECHO_C" >&6
-if test "${ac_cv_func_gethostbyname_r+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define gethostbyname_r to an innocuous variant, in case <limits.h> declares gethostbyname_r.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define gethostbyname_r innocuous_gethostbyname_r
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char gethostbyname_r (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+ ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r"
+if test "x$ac_cv_func_gethostbyname_r" = xyes; then :
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef gethostbyname_r
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gethostbyname_r ();
-/* 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_gethostbyname_r) || defined (__stub___gethostbyname_r)
-choke me
-#else
-char (*f) () = gethostbyname_r;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != gethostbyname_r;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_gethostbyname_r=yes
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5
+$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; }
+if ${tcl_cv_api_gethostbyname_r_6+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_func_gethostbyname_r=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyname_r" >&5
-echo "${ECHO_T}$ac_cv_func_gethostbyname_r" >&6
-if test $ac_cv_func_gethostbyname_r = yes; then
-
- echo "$as_me:$LINENO: checking for gethostbyname_r with 6 args" >&5
-echo $ECHO_N "checking for gethostbyname_r with 6 args... $ECHO_C" >&6
-if test "${tcl_cv_api_gethostbyname_r_6+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
-
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netdb.h>
@@ -12442,58 +7969,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_gethostbyname_r_6=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_gethostbyname_r_6=no
+ tcl_cv_api_gethostbyname_r_6=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_6" >&5
-echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_6" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_6" >&5
+$as_echo "$tcl_cv_api_gethostbyname_r_6" >&6; }
tcl_ok=$tcl_cv_api_gethostbyname_r_6
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYNAME_R_6 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYNAME_R_6 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for gethostbyname_r with 5 args" >&5
-echo $ECHO_N "checking for gethostbyname_r with 5 args... $ECHO_C" >&6
-if test "${tcl_cv_api_gethostbyname_r_5+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 5 args" >&5
+$as_echo_n "checking for gethostbyname_r with 5 args... " >&6; }
+if ${tcl_cv_api_gethostbyname_r_5+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netdb.h>
@@ -12514,58 +8011,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_gethostbyname_r_5=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_gethostbyname_r_5=no
+ tcl_cv_api_gethostbyname_r_5=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_5" >&5
-echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_5" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_5" >&5
+$as_echo "$tcl_cv_api_gethostbyname_r_5" >&6; }
tcl_ok=$tcl_cv_api_gethostbyname_r_5
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYNAME_R_5 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYNAME_R_5 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for gethostbyname_r with 3 args" >&5
-echo $ECHO_N "checking for gethostbyname_r with 3 args... $ECHO_C" >&6
-if test "${tcl_cv_api_gethostbyname_r_3+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 3 args" >&5
+$as_echo_n "checking for gethostbyname_r with 3 args... " >&6; }
+if ${tcl_cv_api_gethostbyname_r_3+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netdb.h>
@@ -12584,162 +8051,41 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_gethostbyname_r_3=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_gethostbyname_r_3=no
+ tcl_cv_api_gethostbyname_r_3=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyname_r_3" >&5
-echo "${ECHO_T}$tcl_cv_api_gethostbyname_r_3" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyname_r_3" >&5
+$as_echo "$tcl_cv_api_gethostbyname_r_3" >&6; }
tcl_ok=$tcl_cv_api_gethostbyname_r_3
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYNAME_R_3 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYNAME_R_3 1" >>confdefs.h
fi
fi
fi
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYNAME_R 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h
fi
fi
- echo "$as_me:$LINENO: checking for gethostbyaddr_r" >&5
-echo $ECHO_N "checking for gethostbyaddr_r... $ECHO_C" >&6
-if test "${ac_cv_func_gethostbyaddr_r+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define gethostbyaddr_r to an innocuous variant, in case <limits.h> declares gethostbyaddr_r.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define gethostbyaddr_r innocuous_gethostbyaddr_r
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char gethostbyaddr_r (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+ ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r"
+if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then :
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef gethostbyaddr_r
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gethostbyaddr_r ();
-/* 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_gethostbyaddr_r) || defined (__stub___gethostbyaddr_r)
-choke me
-#else
-char (*f) () = gethostbyaddr_r;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != gethostbyaddr_r;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_gethostbyaddr_r=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_gethostbyaddr_r=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_gethostbyaddr_r" >&5
-echo "${ECHO_T}$ac_cv_func_gethostbyaddr_r" >&6
-if test $ac_cv_func_gethostbyaddr_r = yes; then
-
- echo "$as_me:$LINENO: checking for gethostbyaddr_r with 7 args" >&5
-echo $ECHO_N "checking for gethostbyaddr_r with 7 args... $ECHO_C" >&6
-if test "${tcl_cv_api_gethostbyaddr_r_7+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5
+$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; }
+if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netdb.h>
@@ -12763,58 +8109,28 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_gethostbyaddr_r_7=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_gethostbyaddr_r_7=no
+ tcl_cv_api_gethostbyaddr_r_7=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_7" >&5
-echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_7" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_7" >&5
+$as_echo "$tcl_cv_api_gethostbyaddr_r_7" >&6; }
tcl_ok=$tcl_cv_api_gethostbyaddr_r_7
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYADDR_R_7 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYADDR_R_7 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for gethostbyaddr_r with 8 args" >&5
-echo $ECHO_N "checking for gethostbyaddr_r with 8 args... $ECHO_C" >&6
-if test "${tcl_cv_api_gethostbyaddr_r_8+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 8 args" >&5
+$as_echo_n "checking for gethostbyaddr_r with 8 args... " >&6; }
+if ${tcl_cv_api_gethostbyaddr_r_8+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <netdb.h>
@@ -12838,59 +8154,30 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_api_gethostbyaddr_r_8=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_gethostbyaddr_r_8=no
+ tcl_cv_api_gethostbyaddr_r_8=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_gethostbyaddr_r_8" >&5
-echo "${ECHO_T}$tcl_cv_api_gethostbyaddr_r_8" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_gethostbyaddr_r_8" >&5
+$as_echo "$tcl_cv_api_gethostbyaddr_r_8" >&6; }
tcl_ok=$tcl_cv_api_gethostbyaddr_r_8
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYADDR_R_8 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYADDR_R_8 1" >>confdefs.h
fi
fi
if test "$tcl_ok" = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_GETHOSTBYADDR_R 1
-_ACEOF
+$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h
fi
fi
- fi
fi
#---------------------------------------------------------------------------
@@ -12902,450 +8189,36 @@ fi
# sys/modem.h is needed on HP-UX.
#---------------------------------------------------------------------------
-
for ac_header in termios.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "termios.h" "ac_cv_header_termios_h" "$ac_includes_default"
+if test "x$ac_cv_header_termios_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_TERMIOS_H 1
_ACEOF
fi
done
-
for ac_header in sys/ioctl.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_ioctl_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_SYS_IOCTL_H 1
_ACEOF
fi
done
-
for ac_header in sys/modem.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/modem.h" "ac_cv_header_sys_modem_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_modem_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_SYS_MODEM_H 1
_ACEOF
fi
@@ -13363,17 +8236,13 @@ done
# special flag.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for fd_set in sys/types" >&5
-echo $ECHO_N "checking for fd_set in sys/types... $ECHO_C" >&6
-if test "${tcl_cv_type_fd_set+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_set in sys/types" >&5
+$as_echo_n "checking for fd_set in sys/types... " >&6; }
+if ${tcl_cv_type_fd_set+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
int
@@ -13384,58 +8253,30 @@ fd_set readMask, writeMask;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_type_fd_set=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_type_fd_set=no
+ tcl_cv_type_fd_set=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_type_fd_set" >&5
-echo "${ECHO_T}$tcl_cv_type_fd_set" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_fd_set" >&5
+$as_echo "$tcl_cv_type_fd_set" >&6; }
tcl_ok=$tcl_cv_type_fd_set
if test $tcl_ok = no; then
- echo "$as_me:$LINENO: checking for fd_mask in sys/select" >&5
-echo $ECHO_N "checking for fd_mask in sys/select... $ECHO_C" >&6
-if test "${tcl_cv_grep_fd_mask+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for fd_mask in sys/select" >&5
+$as_echo_n "checking for fd_mask in sys/select... " >&6; }
+if ${tcl_cv_grep_fd_mask+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/select.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "fd_mask" >/dev/null 2>&1; then
+ $EGREP "fd_mask" >/dev/null 2>&1; then :
tcl_cv_grep_fd_mask=present
else
tcl_cv_grep_fd_mask=missing
@@ -13443,190 +8284,118 @@ fi
rm -f conftest*
fi
-echo "$as_me:$LINENO: result: $tcl_cv_grep_fd_mask" >&5
-echo "${ECHO_T}$tcl_cv_grep_fd_mask" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_fd_mask" >&5
+$as_echo "$tcl_cv_grep_fd_mask" >&6; }
if test $tcl_cv_grep_fd_mask = present; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_SYS_SELECT_H 1
-_ACEOF
+$as_echo "#define HAVE_SYS_SELECT_H 1" >>confdefs.h
tcl_ok=yes
fi
fi
if test $tcl_ok = no; then
-cat >>confdefs.h <<\_ACEOF
-#define NO_FD_SET 1
-_ACEOF
+$as_echo "#define NO_FD_SET 1" >>confdefs.h
fi
-#------------------------------------------------------------------------------
-# Find out all about time handling differences.
-#------------------------------------------------------------------------------
+#------------------------------------------------------------------------
+# Options for the notifier. Checks for epoll(7) on Linux, and
+# kqueue(2) on {DragonFly,Free,Net,Open}BSD
+#------------------------------------------------------------------------
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for advanced notifier support" >&5
+$as_echo_n "checking for advanced notifier support... " >&6; }
+case x`uname -s` in
+ xLinux)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: epoll(7)" >&5
+$as_echo "epoll(7)" >&6; }
+ for ac_header in sys/epoll.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/epoll.h" "ac_cv_header_sys_epoll_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_epoll_h" = xyes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_SYS_EPOLL_H 1
+_ACEOF
+$as_echo "#define NOTIFIER_EPOLL 1" >>confdefs.h
-for ac_header in sys/time.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
+
+done
+
+ for ac_header in sys/eventfd.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/eventfd.h" "ac_cv_header_sys_eventfd_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_eventfd_h" = xyes; then :
+ cat >>confdefs.h <<_ACEOF
+#define HAVE_SYS_EVENTFD_H 1
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-ac_header_compiler=no
+$as_echo "#define HAVE_EVENTFD 1" >>confdefs.h
+
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
+done
+;;
+ xDragonFlyBSD|xFreeBSD|xNetBSD|xOpenBSD)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: kqueue(2)" >&5
+$as_echo "kqueue(2)" >&6; }
+ # Messy because we want to check if *all* the headers are present, and not
+ # just *any*
+ tcl_kqueue_headers=x
+ for ac_header in sys/types.h sys/event.h sys/time.h
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
+ cat >>confdefs.h <<_ACEOF
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
+ tcl_kqueue_headers=${tcl_kqueue_headers}y
fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
+done
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
+ if test $tcl_kqueue_headers = xyyy; then :
+
+
+$as_echo "#define NOTIFIER_KQUEUE 1" >>confdefs.h
+
+fi;;
+ xDarwin)
+ # Assume that we've got CoreFoundation present (checked elsewhere because
+ # of wider impact).
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: OSX" >&5
+$as_echo "OSX" >&6; };;
+ *)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
+$as_echo "none" >&6; };;
esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+#------------------------------------------------------------------------------
+# Find out all about time handling differences.
+#------------------------------------------------------------------------------
+
+
+ for ac_header in sys/time.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/time.h" "ac_cv_header_sys_time_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_time_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_SYS_TIME_H 1
_ACEOF
fi
done
- echo "$as_me:$LINENO: checking whether time.h and sys/time.h may both be included" >&5
-echo $ECHO_N "checking whether time.h and sys/time.h may both be included... $ECHO_C" >&6
-if test "${ac_cv_header_time+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5
+$as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; }
+if ${ac_cv_header_time+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <sys/time.h>
@@ -13641,164 +8410,42 @@ return 0;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_header_time=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_header_time=no
+ ac_cv_header_time=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_header_time" >&5
-echo "${ECHO_T}$ac_cv_header_time" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_time" >&5
+$as_echo "$ac_cv_header_time" >&6; }
if test $ac_cv_header_time = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define TIME_WITH_SYS_TIME 1
-_ACEOF
+$as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h
fi
-
-
-
-for ac_func in gmtime_r localtime_r mktime
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+ for ac_func in gmtime_r localtime_r mktime
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
done
- echo "$as_me:$LINENO: checking tm_tzadj in struct tm" >&5
-echo $ECHO_N "checking tm_tzadj in struct tm... $ECHO_C" >&6
-if test "${tcl_cv_member_tm_tzadj+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_tzadj in struct tm" >&5
+$as_echo_n "checking tm_tzadj in struct tm... " >&6; }
+if ${tcl_cv_member_tm_tzadj+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
int
@@ -13809,58 +8456,28 @@ struct tm tm; tm.tm_tzadj;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_member_tm_tzadj=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_member_tm_tzadj=no
+ tcl_cv_member_tm_tzadj=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_member_tm_tzadj" >&5
-echo "${ECHO_T}$tcl_cv_member_tm_tzadj" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_tzadj" >&5
+$as_echo "$tcl_cv_member_tm_tzadj" >&6; }
if test $tcl_cv_member_tm_tzadj = yes ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_TM_TZADJ 1
-_ACEOF
+$as_echo "#define HAVE_TM_TZADJ 1" >>confdefs.h
fi
- echo "$as_me:$LINENO: checking tm_gmtoff in struct tm" >&5
-echo $ECHO_N "checking tm_gmtoff in struct tm... $ECHO_C" >&6
-if test "${tcl_cv_member_tm_gmtoff+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking tm_gmtoff in struct tm" >&5
+$as_echo_n "checking tm_gmtoff in struct tm... " >&6; }
+if ${tcl_cv_member_tm_gmtoff+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
int
@@ -13871,44 +8488,18 @@ struct tm tm; tm.tm_gmtoff;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_member_tm_gmtoff=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_member_tm_gmtoff=no
+ tcl_cv_member_tm_gmtoff=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_member_tm_gmtoff" >&5
-echo "${ECHO_T}$tcl_cv_member_tm_gmtoff" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_member_tm_gmtoff" >&5
+$as_echo "$tcl_cv_member_tm_gmtoff" >&6; }
if test $tcl_cv_member_tm_gmtoff = yes ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_TM_GMTOFF 1
-_ACEOF
+$as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h
fi
@@ -13916,17 +8507,13 @@ _ACEOF
# Its important to include time.h in this check, as some systems
# (like convex) have timezone functions, etc.
#
- echo "$as_me:$LINENO: checking long timezone variable" >&5
-echo $ECHO_N "checking long timezone variable... $ECHO_C" >&6
-if test "${tcl_cv_timezone_long+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking long timezone variable" >&5
+$as_echo_n "checking long timezone variable... " >&6; }
+if ${tcl_cv_timezone_long+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
int
@@ -13939,60 +8526,30 @@ extern long timezone;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_timezone_long=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_timezone_long=no
+ tcl_cv_timezone_long=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_timezone_long" >&5
-echo "${ECHO_T}$tcl_cv_timezone_long" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_long" >&5
+$as_echo "$tcl_cv_timezone_long" >&6; }
if test $tcl_cv_timezone_long = yes ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_TIMEZONE_VAR 1
-_ACEOF
+$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h
else
#
# On some systems (eg IRIX 6.2), timezone is a time_t and not a long.
#
- echo "$as_me:$LINENO: checking time_t timezone variable" >&5
-echo $ECHO_N "checking time_t timezone variable... $ECHO_C" >&6
-if test "${tcl_cv_timezone_time+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking time_t timezone variable" >&5
+$as_echo_n "checking time_t timezone variable... " >&6; }
+if ${tcl_cv_timezone_time+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <time.h>
int
@@ -14005,44 +8562,18 @@ extern time_t timezone;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_timezone_time=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_timezone_time=no
+ tcl_cv_timezone_time=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_timezone_time" >&5
-echo "${ECHO_T}$tcl_cv_timezone_time" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_timezone_time" >&5
+$as_echo "$tcl_cv_timezone_time" >&6; }
if test $tcl_cv_timezone_time = yes ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_TIMEZONE_VAR 1
-_ACEOF
+$as_echo "#define HAVE_TIMEZONE_VAR 1" >>confdefs.h
fi
fi
@@ -14055,108 +8586,8 @@ _ACEOF
#--------------------------------------------------------------------
if test "$ac_cv_cygwin" != "yes"; then
- echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
-echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
-if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-static struct stat ac_aggr;
-if (ac_aggr.st_blocks)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_member_struct_stat_st_blocks=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-static struct stat ac_aggr;
-if (sizeof ac_aggr.st_blocks)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_member_struct_stat_st_blocks=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_member_struct_stat_st_blocks=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blocks" >&5
-echo "${ECHO_T}$ac_cv_member_struct_stat_st_blocks" >&6
-if test $ac_cv_member_struct_stat_st_blocks = yes; then
+ ac_fn_c_check_member "$LINENO" "struct stat" "st_blocks" "ac_cv_member_struct_stat_st_blocks" "$ac_includes_default"
+if test "x$ac_cv_member_struct_stat_st_blocks" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLOCKS 1
@@ -14164,108 +8595,8 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for struct stat.st_blksize" >&5
-echo $ECHO_N "checking for struct stat.st_blksize... $ECHO_C" >&6
-if test "${ac_cv_member_struct_stat_st_blksize+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-static struct stat ac_aggr;
-if (ac_aggr.st_blksize)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_member_struct_stat_st_blksize=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-static struct stat ac_aggr;
-if (sizeof ac_aggr.st_blksize)
-return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_member_struct_stat_st_blksize=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_member_struct_stat_st_blksize=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_member_struct_stat_st_blksize" >&5
-echo "${ECHO_T}$ac_cv_member_struct_stat_st_blksize" >&6
-if test $ac_cv_member_struct_stat_st_blksize = yes; then
+ac_fn_c_check_member "$LINENO" "struct stat" "st_blksize" "ac_cv_member_struct_stat_st_blksize" "$ac_includes_default"
+if test "x$ac_cv_member_struct_stat_st_blksize" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLKSIZE 1
@@ -14275,63 +8606,8 @@ _ACEOF
fi
fi
-echo "$as_me:$LINENO: checking for blkcnt_t" >&5
-echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6
-if test "${ac_cv_type_blkcnt_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((blkcnt_t *) 0)
- return 0;
-if (sizeof (blkcnt_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_blkcnt_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_blkcnt_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_blkcnt_t" >&5
-echo "${ECHO_T}$ac_cv_type_blkcnt_t" >&6
-if test $ac_cv_type_blkcnt_t = yes; then
+ac_fn_c_check_type "$LINENO" "blkcnt_t" "ac_cv_type_blkcnt_t" "$ac_includes_default"
+if test "x$ac_cv_type_blkcnt_t" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_BLKCNT_T 1
@@ -14340,103 +8616,12 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for fstatfs" >&5
-echo $ECHO_N "checking for fstatfs... $ECHO_C" >&6
-if test "${ac_cv_func_fstatfs+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define fstatfs to an innocuous variant, in case <limits.h> declares fstatfs.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define fstatfs innocuous_fstatfs
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char fstatfs (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef fstatfs
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char fstatfs ();
-/* 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_fstatfs) || defined (__stub___fstatfs)
-choke me
-#else
-char (*f) () = fstatfs;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != fstatfs;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_fstatfs=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_func "$LINENO" "fstatfs" "ac_cv_func_fstatfs"
+if test "x$ac_cv_func_fstatfs" = xyes; then :
-ac_cv_func_fstatfs=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_fstatfs" >&5
-echo "${ECHO_T}$ac_cv_func_fstatfs" >&6
-if test $ac_cv_func_fstatfs = yes; then
- :
else
-cat >>confdefs.h <<\_ACEOF
-#define NO_FSTATFS 1
-_ACEOF
+$as_echo "#define NO_FSTATFS 1" >>confdefs.h
fi
@@ -14446,19 +8631,15 @@ fi
# checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for working memcmp" >&5
-echo $ECHO_N "checking for working memcmp... $ECHO_C" >&6
-if test "${ac_cv_func_memcmp_working+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working memcmp" >&5
+$as_echo_n "checking for working memcmp... " >&6; }
+if ${ac_cv_func_memcmp_working+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
ac_cv_func_memcmp_working=no
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
@@ -14466,9 +8647,9 @@ main ()
{
/* Some versions of memcmp are not 8-bit clean. */
- char c0 = 0x40, c1 = 0x80, c2 = 0x81;
+ char c0 = '\100', c1 = '\200', c2 = '\201';
if (memcmp(&c0, &c2, 1) >= 0 || memcmp(&c1, &c2, 1) >= 0)
- exit (1);
+ return 1;
/* The Next x86 OpenStep bug shows up only when comparing 16 bytes
or more and with at least one buffer not starting on a 4-byte boundary.
@@ -14484,46 +8665,31 @@ main ()
strcpy (a, "--------01111111");
strcpy (b, "--------10000000");
if (memcmp (a, b, 16) >= 0)
- exit (1);
+ return 1;
}
- exit (0);
+ return 0;
}
;
return 0;
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_run "$LINENO"; then :
ac_cv_func_memcmp_working=yes
else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-ac_cv_func_memcmp_working=no
+ ac_cv_func_memcmp_working=no
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
-echo "$as_me:$LINENO: result: $ac_cv_func_memcmp_working" >&5
-echo "${ECHO_T}$ac_cv_func_memcmp_working" >&6
-test $ac_cv_func_memcmp_working = no && case $LIBOBJS in
- "memcmp.$ac_objext" | \
- *" memcmp.$ac_objext" | \
- "memcmp.$ac_objext "* | \
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_memcmp_working" >&5
+$as_echo "$ac_cv_func_memcmp_working" >&6; }
+test $ac_cv_func_memcmp_working = no && case " $LIBOBJS " in
*" memcmp.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS memcmp.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS memcmp.$ac_objext"
+ ;;
esac
@@ -14534,109 +8700,16 @@ esac
# compat/string.h}
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for memmove" >&5
-echo $ECHO_N "checking for memmove... $ECHO_C" >&6
-if test "${ac_cv_func_memmove+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define memmove to an innocuous variant, in case <limits.h> declares memmove.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define memmove innocuous_memmove
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char memmove (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef memmove
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char memmove ();
-/* 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_memmove) || defined (__stub___memmove)
-choke me
-#else
-char (*f) () = memmove;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != memmove;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_memmove=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_func "$LINENO" "memmove" "ac_cv_func_memmove"
+if test "x$ac_cv_func_memmove" = xyes; then :
-ac_cv_func_memmove=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_memmove" >&5
-echo "${ECHO_T}$ac_cv_func_memmove" >&6
-if test $ac_cv_func_memmove = yes; then
- :
else
-cat >>confdefs.h <<\_ACEOF
-#define NO_MEMMOVE 1
-_ACEOF
+$as_echo "#define NO_MEMMOVE 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define NO_STRING_H 1
-_ACEOF
+$as_echo "#define NO_STRING_H 1" >>confdefs.h
fi
@@ -14647,147 +8720,41 @@ fi
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for strstr" >&5
-echo $ECHO_N "checking for strstr... $ECHO_C" >&6
-if test "${ac_cv_func_strstr+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define strstr to an innocuous variant, in case <limits.h> declares strstr.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define strstr innocuous_strstr
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strstr (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef strstr
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char strstr ();
-/* 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_strstr) || defined (__stub___strstr)
-choke me
-#else
-char (*f) () = strstr;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != strstr;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_strstr=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_strstr=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_strstr" >&5
-echo "${ECHO_T}$ac_cv_func_strstr" >&6
-if test $ac_cv_func_strstr = yes; then
+ ac_fn_c_check_func "$LINENO" "strstr" "ac_cv_func_strstr"
+if test "x$ac_cv_func_strstr" = xyes; then :
tcl_ok=1
else
tcl_ok=0
fi
if test "$tcl_ok" = 1; then
- echo "$as_me:$LINENO: checking proper strstr implementation" >&5
-echo $ECHO_N "checking proper strstr implementation... $ECHO_C" >&6
-if test "${tcl_cv_strstr_unbroken+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strstr implementation" >&5
+$as_echo_n "checking proper strstr implementation... " >&6; }
+if ${tcl_cv_strstr_unbroken+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
tcl_cv_strstr_unbroken=unknown
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int main() {
extern int strstr();
exit(strstr("\0test", "test") ? 1 : 0);
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_run "$LINENO"; then :
tcl_cv_strstr_unbroken=ok
else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-tcl_cv_strstr_unbroken=broken
+ tcl_cv_strstr_unbroken=broken
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
-echo "$as_me:$LINENO: result: $tcl_cv_strstr_unbroken" >&5
-echo "${ECHO_T}$tcl_cv_strstr_unbroken" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strstr_unbroken" >&5
+$as_echo "$tcl_cv_strstr_unbroken" >&6; }
if test "$tcl_cv_strstr_unbroken" = "ok"; then
tcl_ok=1
else
@@ -14795,12 +8762,10 @@ echo "${ECHO_T}$tcl_cv_strstr_unbroken" >&6
fi
fi
if test "$tcl_ok" = 0; then
- case $LIBOBJS in
- "strstr.$ac_objext" | \
- *" strstr.$ac_objext" | \
- "strstr.$ac_objext "* | \
+ case " $LIBOBJS " in
*" strstr.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS strstr.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS strstr.$ac_objext"
+ ;;
esac
USE_COMPAT=1
@@ -14814,116 +8779,23 @@ esac
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for strtoul" >&5
-echo $ECHO_N "checking for strtoul... $ECHO_C" >&6
-if test "${ac_cv_func_strtoul+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define strtoul to an innocuous variant, in case <limits.h> declares strtoul.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define strtoul innocuous_strtoul
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strtoul (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef strtoul
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char strtoul ();
-/* 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_strtoul) || defined (__stub___strtoul)
-choke me
-#else
-char (*f) () = strtoul;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != strtoul;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_strtoul=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_strtoul=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_strtoul" >&5
-echo "${ECHO_T}$ac_cv_func_strtoul" >&6
-if test $ac_cv_func_strtoul = yes; then
+ ac_fn_c_check_func "$LINENO" "strtoul" "ac_cv_func_strtoul"
+if test "x$ac_cv_func_strtoul" = xyes; then :
tcl_ok=1
else
tcl_ok=0
fi
if test "$tcl_ok" = 1; then
- echo "$as_me:$LINENO: checking proper strtoul implementation" >&5
-echo $ECHO_N "checking proper strtoul implementation... $ECHO_C" >&6
-if test "${tcl_cv_strtoul_unbroken+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking proper strtoul implementation" >&5
+$as_echo_n "checking proper strtoul implementation... " >&6; }
+if ${tcl_cv_strtoul_unbroken+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
tcl_cv_strtoul_unbroken=unknown
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int main() {
extern int strtoul();
@@ -14931,31 +8803,18 @@ int main() {
exit(strtoul(string,&term,0) != 0 || term != string+1);
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_run "$LINENO"; then :
tcl_cv_strtoul_unbroken=ok
else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-tcl_cv_strtoul_unbroken=broken
+ tcl_cv_strtoul_unbroken=broken
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
-echo "$as_me:$LINENO: result: $tcl_cv_strtoul_unbroken" >&5
-echo "${ECHO_T}$tcl_cv_strtoul_unbroken" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_strtoul_unbroken" >&5
+$as_echo "$tcl_cv_strtoul_unbroken" >&6; }
if test "$tcl_cv_strtoul_unbroken" = "ok"; then
tcl_ok=1
else
@@ -14963,12 +8822,10 @@ echo "${ECHO_T}$tcl_cv_strtoul_unbroken" >&6
fi
fi
if test "$tcl_ok" = 0; then
- case $LIBOBJS in
- "strtoul.$ac_objext" | \
- *" strtoul.$ac_objext" | \
- "strtoul.$ac_objext "* | \
+ case " $LIBOBJS " in
*" strtoul.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS strtoul.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS strtoul.$ac_objext"
+ ;;
esac
USE_COMPAT=1
@@ -14980,64 +8837,9 @@ esac
# they don't exist.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for mode_t" >&5
-echo $ECHO_N "checking for mode_t... $ECHO_C" >&6
-if test "${ac_cv_type_mode_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((mode_t *) 0)
- return 0;
-if (sizeof (mode_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_mode_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_type "$LINENO" "mode_t" "ac_cv_type_mode_t" "$ac_includes_default"
+if test "x$ac_cv_type_mode_t" = xyes; then :
-ac_cv_type_mode_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_mode_t" >&5
-echo "${ECHO_T}$ac_cv_type_mode_t" >&6
-if test $ac_cv_type_mode_t = yes; then
- :
else
cat >>confdefs.h <<_ACEOF
@@ -15046,64 +8848,9 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for pid_t" >&5
-echo $ECHO_N "checking for pid_t... $ECHO_C" >&6
-if test "${ac_cv_type_pid_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((pid_t *) 0)
- return 0;
-if (sizeof (pid_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_pid_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default"
+if test "x$ac_cv_type_pid_t" = xyes; then :
-ac_cv_type_pid_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_pid_t" >&5
-echo "${ECHO_T}$ac_cv_type_pid_t" >&6
-if test $ac_cv_type_pid_t = yes; then
- :
else
cat >>confdefs.h <<_ACEOF
@@ -15112,88 +8859,29 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for size_t" >&5
-echo $ECHO_N "checking for size_t... $ECHO_C" >&6
-if test "${ac_cv_type_size_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((size_t *) 0)
- return 0;
-if (sizeof (size_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_size_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default"
+if test "x$ac_cv_type_size_t" = xyes; then :
-ac_cv_type_size_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_size_t" >&5
-echo "${ECHO_T}$ac_cv_type_size_t" >&6
-if test $ac_cv_type_size_t = yes; then
- :
else
cat >>confdefs.h <<_ACEOF
-#define size_t unsigned
+#define size_t unsigned int
_ACEOF
fi
-echo "$as_me:$LINENO: checking for uid_t in sys/types.h" >&5
-echo $ECHO_N "checking for uid_t in sys/types.h... $ECHO_C" >&6
-if test "${ac_cv_type_uid_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for uid_t in sys/types.h" >&5
+$as_echo_n "checking for uid_t in sys/types.h... " >&6; }
+if ${ac_cv_type_uid_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "uid_t" >/dev/null 2>&1; then
+ $EGREP "uid_t" >/dev/null 2>&1; then :
ac_cv_type_uid_t=yes
else
ac_cv_type_uid_t=no
@@ -15201,33 +8889,25 @@ fi
rm -f conftest*
fi
-echo "$as_me:$LINENO: result: $ac_cv_type_uid_t" >&5
-echo "${ECHO_T}$ac_cv_type_uid_t" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_uid_t" >&5
+$as_echo "$ac_cv_type_uid_t" >&6; }
if test $ac_cv_type_uid_t = no; then
-cat >>confdefs.h <<\_ACEOF
-#define uid_t int
-_ACEOF
+$as_echo "#define uid_t int" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define gid_t int
-_ACEOF
+$as_echo "#define gid_t int" >>confdefs.h
fi
-echo "$as_me:$LINENO: checking for socklen_t" >&5
-echo $ECHO_N "checking for socklen_t... $ECHO_C" >&6
-if test "${tcl_cv_type_socklen_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for socklen_t" >&5
+$as_echo_n "checking for socklen_t... " >&6; }
+if ${tcl_cv_type_socklen_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
@@ -15243,172 +8923,62 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_type_socklen_t=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_type_socklen_t=no
+ tcl_cv_type_socklen_t=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_type_socklen_t" >&5
-echo "${ECHO_T}$tcl_cv_type_socklen_t" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_type_socklen_t" >&5
+$as_echo "$tcl_cv_type_socklen_t" >&6; }
if test $tcl_cv_type_socklen_t = no; then
-cat >>confdefs.h <<\_ACEOF
-#define socklen_t int
-_ACEOF
+$as_echo "#define socklen_t int" >>confdefs.h
fi
-echo "$as_me:$LINENO: checking for intptr_t" >&5
-echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_intptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((intptr_t *) 0)
- return 0;
-if (sizeof (intptr_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_intptr_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
+if test "x$ac_cv_type_intptr_t" = xyes; then :
-ac_cv_type_intptr_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5
-echo "${ECHO_T}$ac_cv_type_intptr_t" >&6
-if test $ac_cv_type_intptr_t = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_INTPTR_T 1
-_ACEOF
+$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5
-echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6
-if test "${tcl_cv_intptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5
+$as_echo_n "checking for pointer-size signed integer type... " >&6; }
+if ${tcl_cv_intptr_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
for tcl_cv_intptr_t in "int" "long" "long long" none; do
if test "$tcl_cv_intptr_t" != none; then
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
-test_array [0] = 0
+test_array [0] = 0;
+return test_array [0];
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_ok=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_ok=no
+ tcl_ok=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
test "$tcl_ok" = yes && break; fi
done
fi
-echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5
-echo "${ECHO_T}$tcl_cv_intptr_t" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5
+$as_echo "$tcl_cv_intptr_t" >&6; }
if test "$tcl_cv_intptr_t" != none; then
cat >>confdefs.h <<_ACEOF
@@ -15419,132 +8989,48 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for uintptr_t" >&5
-echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_uintptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((uintptr_t *) 0)
- return 0;
-if (sizeof (uintptr_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_uintptr_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_uintptr_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
-echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
-if test $ac_cv_type_uintptr_t = yes; then
+ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
+if test "x$ac_cv_type_uintptr_t" = xyes; then :
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_UINTPTR_T 1
-_ACEOF
+$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5
-echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6
-if test "${tcl_cv_uintptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5
+$as_echo_n "checking for pointer-size unsigned integer type... " >&6; }
+if ${tcl_cv_uintptr_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
none; do
if test "$tcl_cv_uintptr_t" != none; then
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
-test_array [0] = 0
+test_array [0] = 0;
+return test_array [0];
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_ok=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_ok=no
+ tcl_ok=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
test "$tcl_ok" = yes && break; fi
done
fi
-echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5
-echo "${ECHO_T}$tcl_cv_uintptr_t" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5
+$as_echo "$tcl_cv_uintptr_t" >&6; }
if test "$tcl_cv_uintptr_t" != none; then
cat >>confdefs.h <<_ACEOF
@@ -15563,103 +9049,12 @@ fi
# provided. This version only works with V7-style directories.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for opendir" >&5
-echo $ECHO_N "checking for opendir... $ECHO_C" >&6
-if test "${ac_cv_func_opendir+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define opendir to an innocuous variant, in case <limits.h> declares opendir.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define opendir innocuous_opendir
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char opendir (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
+ac_fn_c_check_func "$LINENO" "opendir" "ac_cv_func_opendir"
+if test "x$ac_cv_func_opendir" = xyes; then :
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef opendir
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char opendir ();
-/* 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_opendir) || defined (__stub___opendir)
-choke me
-#else
-char (*f) () = opendir;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != opendir;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_opendir=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-ac_cv_func_opendir=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_opendir" >&5
-echo "${ECHO_T}$ac_cv_func_opendir" >&6
-if test $ac_cv_func_opendir = yes; then
- :
-else
-
-cat >>confdefs.h <<\_ACEOF
-#define USE_DIRENT2_H 1
-_ACEOF
+$as_echo "#define USE_DIRENT2_H 1" >>confdefs.h
fi
@@ -15672,17 +9067,13 @@ fi
# the trick.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking union wait" >&5
-echo $ECHO_N "checking union wait... $ECHO_C" >&6
-if test "${tcl_cv_union_wait+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking union wait" >&5
+$as_echo_n "checking union wait... " >&6; }
+if ${tcl_cv_union_wait+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/types.h>
#include <sys/wait.h>
@@ -15698,45 +9089,19 @@ WIFEXITED(x); /* Generates compiler error if WIFEXITED
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_union_wait=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_union_wait=no
+ tcl_cv_union_wait=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_union_wait" >&5
-echo "${ECHO_T}$tcl_cv_union_wait" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_union_wait" >&5
+$as_echo "$tcl_cv_union_wait" >&6; }
if test $tcl_cv_union_wait = no; then
-cat >>confdefs.h <<\_ACEOF
-#define NO_UNION_WAIT 1
-_ACEOF
+$as_echo "#define NO_UNION_WAIT 1" >>confdefs.h
fi
@@ -15746,168 +9111,51 @@ fi
# under Sequent Dynix it's in -linet.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for strncasecmp" >&5
-echo $ECHO_N "checking for strncasecmp... $ECHO_C" >&6
-if test "${ac_cv_func_strncasecmp+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define strncasecmp to an innocuous variant, in case <limits.h> declares strncasecmp.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define strncasecmp innocuous_strncasecmp
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char strncasecmp (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef strncasecmp
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char strncasecmp ();
-/* 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_strncasecmp) || defined (__stub___strncasecmp)
-choke me
-#else
-char (*f) () = strncasecmp;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != strncasecmp;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_strncasecmp=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_strncasecmp=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_strncasecmp" >&5
-echo "${ECHO_T}$ac_cv_func_strncasecmp" >&6
-if test $ac_cv_func_strncasecmp = yes; then
+ac_fn_c_check_func "$LINENO" "strncasecmp" "ac_cv_func_strncasecmp"
+if test "x$ac_cv_func_strncasecmp" = xyes; then :
tcl_ok=1
else
tcl_ok=0
fi
if test "$tcl_ok" = 0; then
- echo "$as_me:$LINENO: checking for strncasecmp in -lsocket" >&5
-echo $ECHO_N "checking for strncasecmp in -lsocket... $ECHO_C" >&6
-if test "${ac_cv_lib_socket_strncasecmp+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -lsocket" >&5
+$as_echo_n "checking for strncasecmp in -lsocket... " >&6; }
+if ${ac_cv_lib_socket_strncasecmp+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lsocket $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char strncasecmp ();
int
main ()
{
-strncasecmp ();
+return strncasecmp ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_socket_strncasecmp=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_socket_strncasecmp=no
+ ac_cv_lib_socket_strncasecmp=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_socket_strncasecmp" >&5
-echo "${ECHO_T}$ac_cv_lib_socket_strncasecmp" >&6
-if test $ac_cv_lib_socket_strncasecmp = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_socket_strncasecmp" >&5
+$as_echo "$ac_cv_lib_socket_strncasecmp" >&6; }
+if test "x$ac_cv_lib_socket_strncasecmp" = xyes; then :
tcl_ok=1
else
tcl_ok=0
@@ -15915,71 +9163,43 @@ fi
fi
if test "$tcl_ok" = 0; then
- echo "$as_me:$LINENO: checking for strncasecmp in -linet" >&5
-echo $ECHO_N "checking for strncasecmp in -linet... $ECHO_C" >&6
-if test "${ac_cv_lib_inet_strncasecmp+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for strncasecmp in -linet" >&5
+$as_echo_n "checking for strncasecmp in -linet... " >&6; }
+if ${ac_cv_lib_inet_strncasecmp+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-linet $LIBS"
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
-/* Override any gcc2 internal prototype to avoid an error. */
+/* Override any GCC internal prototype to avoid an error.
+ Use char because int might match the return type of a GCC
+ builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
char strncasecmp ();
int
main ()
{
-strncasecmp ();
+return strncasecmp ();
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_inet_strncasecmp=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_lib_inet_strncasecmp=no
+ ac_cv_lib_inet_strncasecmp=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
-echo "$as_me:$LINENO: result: $ac_cv_lib_inet_strncasecmp" >&5
-echo "${ECHO_T}$ac_cv_lib_inet_strncasecmp" >&6
-if test $ac_cv_lib_inet_strncasecmp = yes; then
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_inet_strncasecmp" >&5
+$as_echo "$ac_cv_lib_inet_strncasecmp" >&6; }
+if test "x$ac_cv_lib_inet_strncasecmp" = xyes; then :
tcl_ok=1
else
tcl_ok=0
@@ -15987,12 +9207,10 @@ fi
fi
if test "$tcl_ok" = 0; then
- case $LIBOBJS in
- "strncasecmp.$ac_objext" | \
- *" strncasecmp.$ac_objext" | \
- "strncasecmp.$ac_objext "* | \
+ case " $LIBOBJS " in
*" strncasecmp.$ac_objext "* ) ;;
- *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext" ;;
+ *) LIBOBJS="$LIBOBJS strncasecmp.$ac_objext"
+ ;;
esac
USE_COMPAT=1
@@ -16007,125 +9225,30 @@ fi
# declare it.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for gettimeofday" >&5
-echo $ECHO_N "checking for gettimeofday... $ECHO_C" >&6
-if test "${ac_cv_func_gettimeofday+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define gettimeofday to an innocuous variant, in case <limits.h> declares gettimeofday.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define gettimeofday innocuous_gettimeofday
+ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday"
+if test "x$ac_cv_func_gettimeofday" = xyes; then :
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char gettimeofday (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef gettimeofday
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char gettimeofday ();
-/* 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_gettimeofday) || defined (__stub___gettimeofday)
-choke me
-#else
-char (*f) () = gettimeofday;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != gettimeofday;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_func_gettimeofday=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_func_gettimeofday=no
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_func_gettimeofday" >&5
-echo "${ECHO_T}$ac_cv_func_gettimeofday" >&6
-if test $ac_cv_func_gettimeofday = yes; then
- :
else
-cat >>confdefs.h <<\_ACEOF
-#define NO_GETTOD 1
-_ACEOF
+$as_echo "#define NO_GETTOD 1" >>confdefs.h
fi
-echo "$as_me:$LINENO: checking for gettimeofday declaration" >&5
-echo $ECHO_N "checking for gettimeofday declaration... $ECHO_C" >&6
-if test "${tcl_cv_grep_gettimeofday+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gettimeofday declaration" >&5
+$as_echo_n "checking for gettimeofday declaration... " >&6; }
+if ${tcl_cv_grep_gettimeofday+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/time.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "gettimeofday" >/dev/null 2>&1; then
+ $EGREP "gettimeofday" >/dev/null 2>&1; then :
tcl_cv_grep_gettimeofday=present
else
tcl_cv_grep_gettimeofday=missing
@@ -16133,13 +9256,11 @@ fi
rm -f conftest*
fi
-echo "$as_me:$LINENO: result: $tcl_cv_grep_gettimeofday" >&5
-echo "${ECHO_T}$tcl_cv_grep_gettimeofday" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_grep_gettimeofday" >&5
+$as_echo "$tcl_cv_grep_gettimeofday" >&6; }
if test $tcl_cv_grep_gettimeofday = missing ; then
-cat >>confdefs.h <<\_ACEOF
-#define GETTOD_NOT_DECLARED 1
-_ACEOF
+$as_echo "#define GETTOD_NOT_DECLARED 1" >>confdefs.h
fi
@@ -16149,80 +9270,46 @@ fi
# properly generate sign-extended ints from character values.
#--------------------------------------------------------------------
-
-echo "$as_me:$LINENO: checking whether char is unsigned" >&5
-echo $ECHO_N "checking whether char is unsigned... $ECHO_C" >&6
-if test "${ac_cv_c_char_unsigned+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether char is unsigned" >&5
+$as_echo_n "checking whether char is unsigned... " >&6; }
+if ${ac_cv_c_char_unsigned+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(((char) -1) < 0)];
-test_array [0] = 0
+test_array [0] = 0;
+return test_array [0];
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_c_char_unsigned=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_c_char_unsigned=yes
+ ac_cv_c_char_unsigned=yes
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_char_unsigned" >&5
-echo "${ECHO_T}$ac_cv_c_char_unsigned" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_char_unsigned" >&5
+$as_echo "$ac_cv_c_char_unsigned" >&6; }
if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then
- cat >>confdefs.h <<\_ACEOF
-#define __CHAR_UNSIGNED__ 1
-_ACEOF
+ $as_echo "#define __CHAR_UNSIGNED__ 1" >>confdefs.h
fi
-echo "$as_me:$LINENO: checking signed char declarations" >&5
-echo $ECHO_N "checking signed char declarations... $ECHO_C" >&6
-if test "${tcl_cv_char_signed+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking signed char declarations" >&5
+$as_echo_n "checking signed char declarations... " >&6; }
+if ${tcl_cv_char_signed+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -16236,44 +9323,18 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_char_signed=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_char_signed=no
+ tcl_cv_char_signed=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_char_signed" >&5
-echo "${ECHO_T}$tcl_cv_char_signed" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_char_signed" >&5
+$as_echo "$tcl_cv_char_signed" >&6; }
if test $tcl_cv_char_signed = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_SIGNED_CHAR 1
-_ACEOF
+$as_echo "#define HAVE_SIGNED_CHAR 1" >>confdefs.h
fi
@@ -16281,20 +9342,16 @@ fi
# Does putenv() copy or not? We need to know to avoid memory leaks.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for a putenv() that copies the buffer" >&5
-echo $ECHO_N "checking for a putenv() that copies the buffer... $ECHO_C" >&6
-if test "${tcl_cv_putenv_copy+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a putenv() that copies the buffer" >&5
+$as_echo_n "checking for a putenv() that copies the buffer... " >&6; }
+if ${tcl_cv_putenv_copy+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
tcl_cv_putenv_copy=no
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
@@ -16316,36 +9373,21 @@ cat >>conftest.$ac_ext <<_ACEOF
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_run "$LINENO"; then :
tcl_cv_putenv_copy=no
else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-tcl_cv_putenv_copy=yes
+ tcl_cv_putenv_copy=yes
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
-echo "$as_me:$LINENO: result: $tcl_cv_putenv_copy" >&5
-echo "${ECHO_T}$tcl_cv_putenv_copy" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_putenv_copy" >&5
+$as_echo "$tcl_cv_putenv_copy" >&6; }
if test $tcl_cv_putenv_copy = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_PUTENV_THAT_COPIES 1
-_ACEOF
+$as_echo "#define HAVE_PUTENV_THAT_COPIES 1" >>confdefs.h
fi
@@ -16354,154 +9396,18 @@ fi
#--------------------------------------------------------------------
- # Check whether --enable-langinfo or --disable-langinfo was given.
-if test "${enable_langinfo+set}" = set; then
- enableval="$enable_langinfo"
- langinfo_ok=$enableval
+ # Check whether --enable-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 "${ac_cv_header_langinfo_h+set}" = set; then
- echo "$as_me:$LINENO: checking for langinfo.h" >&5
-echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6
-if test "${ac_cv_header_langinfo_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
fi
-echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5
-echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking langinfo.h usability" >&5
-echo $ECHO_N "checking langinfo.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <langinfo.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-# Is the header present?
-echo "$as_me:$LINENO: checking langinfo.h presence" >&5
-echo $ECHO_N "checking langinfo.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <langinfo.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: langinfo.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: langinfo.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: langinfo.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: langinfo.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: langinfo.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: langinfo.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: langinfo.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: langinfo.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: langinfo.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: langinfo.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: langinfo.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: langinfo.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: langinfo.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for langinfo.h" >&5
-echo $ECHO_N "checking for langinfo.h... $ECHO_C" >&6
-if test "${ac_cv_header_langinfo_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_langinfo_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_langinfo_h" >&5
-echo "${ECHO_T}$ac_cv_header_langinfo_h" >&6
-
-fi
-if test $ac_cv_header_langinfo_h = yes; then
+ HAVE_LANGINFO=0
+ if test "$langinfo_ok" = "yes"; then
+ ac_fn_c_check_header_mongrel "$LINENO" "langinfo.h" "ac_cv_header_langinfo_h" "$ac_includes_default"
+if test "x$ac_cv_header_langinfo_h" = xyes; then :
langinfo_ok=yes
else
langinfo_ok=no
@@ -16509,18 +9415,14 @@ fi
fi
- echo "$as_me:$LINENO: checking whether to use nl_langinfo" >&5
-echo $ECHO_N "checking whether to use nl_langinfo... $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use nl_langinfo" >&5
+$as_echo_n "checking whether to use nl_langinfo... " >&6; }
if test "$langinfo_ok" = "yes"; then
- if test "${tcl_cv_langinfo_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${tcl_cv_langinfo_h+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <langinfo.h>
int
@@ -16531,50 +9433,24 @@ nl_langinfo(CODESET);
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_langinfo_h=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_langinfo_h=no
+ tcl_cv_langinfo_h=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
- echo "$as_me:$LINENO: result: $tcl_cv_langinfo_h" >&5
-echo "${ECHO_T}$tcl_cv_langinfo_h" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_langinfo_h" >&5
+$as_echo "$tcl_cv_langinfo_h" >&6; }
if test $tcl_cv_langinfo_h = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_LANGINFO 1
-_ACEOF
+$as_echo "#define HAVE_LANGINFO 1" >>confdefs.h
fi
else
- echo "$as_me:$LINENO: result: $langinfo_ok" >&5
-echo "${ECHO_T}$langinfo_ok" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $langinfo_ok" >&5
+$as_echo "$langinfo_ok" >&6; }
fi
@@ -16582,104 +9458,13 @@ echo "${ECHO_T}$langinfo_ok" >&6
# Check for support of chflags and mkstemps functions
#--------------------------------------------------------------------
-
-
for ac_func in chflags mkstemps
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+do :
+ as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
+ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
+if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
_ACEOF
fi
@@ -16690,17 +9475,13 @@ done
# Check for support of isnan() function or macro
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking isnan" >&5
-echo $ECHO_N "checking isnan... $ECHO_C" >&6
-if test "${tcl_cv_isnan+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking isnan" >&5
+$as_echo_n "checking isnan... " >&6; }
+if ${tcl_cv_isnan+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <math.h>
int
@@ -16713,45 +9494,19 @@ isnan(0.0); /* Generates an error if isnan is missing */
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_isnan=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_isnan=no
+ tcl_cv_isnan=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_isnan" >&5
-echo "${ECHO_T}$tcl_cv_isnan" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_isnan" >&5
+$as_echo "$tcl_cv_isnan" >&6; }
if test $tcl_cv_isnan = no; then
-cat >>confdefs.h <<\_ACEOF
-#define NO_ISNAN 1
-_ACEOF
+$as_echo "#define NO_ISNAN 1" >>confdefs.h
fi
@@ -16760,608 +9515,59 @@ fi
#--------------------------------------------------------------------
if test "`uname -s`" = "Darwin" ; then
-
-for ac_func in getattrlist
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+ for ac_func in getattrlist
+do :
+ ac_fn_c_check_func "$LINENO" "getattrlist" "ac_cv_func_getattrlist"
+if test "x$ac_cv_func_getattrlist" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define HAVE_GETATTRLIST 1
_ACEOF
fi
done
-
-for ac_header in copyfile.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ for ac_header in copyfile.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "copyfile.h" "ac_cv_header_copyfile_h" "$ac_includes_default"
+if test "x$ac_cv_header_copyfile_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_COPYFILE_H 1
_ACEOF
fi
done
-
-for ac_func in copyfile
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+ for ac_func in copyfile
+do :
+ ac_fn_c_check_func "$LINENO" "copyfile" "ac_cv_func_copyfile"
+if test "x$ac_cv_func_copyfile" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define HAVE_COPYFILE 1
_ACEOF
fi
done
if test $tcl_corefoundation = yes; then
-
-for ac_header in libkern/OSAtomic.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ for ac_header in libkern/OSAtomic.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "libkern/OSAtomic.h" "ac_cv_header_libkern_OSAtomic_h" "$ac_includes_default"
+if test "x$ac_cv_header_libkern_OSAtomic_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_LIBKERN_OSATOMIC_H 1
_ACEOF
fi
done
-
-for ac_func in OSSpinLockLock
-do
-as_ac_var=`echo "ac_cv_func_$ac_func" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_func" >&5
-echo $ECHO_N "checking for $ac_func... $ECHO_C" >&6
-if eval "test \"\${$as_ac_var+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-/* Define $ac_func to an innocuous variant, in case <limits.h> declares $ac_func.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $ac_func innocuous_$ac_func
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $ac_func (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $ac_func
-
-/* Override any gcc2 internal prototype to avoid an error. */
-#ifdef __cplusplus
-extern "C"
-{
-#endif
-/* We use char because int might match the return type of a gcc2
- builtin and then its argument prototype would still apply. */
-char $ac_func ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
-choke me
-#else
-char (*f) () = $ac_func;
-#endif
-#ifdef __cplusplus
-}
-#endif
-
-int
-main ()
-{
-return f != $ac_func;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_var=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_var=no"
-fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_var'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_var'}'`" >&6
-if test `eval echo '${'$as_ac_var'}'` = yes; then
+ for ac_func in OSSpinLockLock
+do :
+ ac_fn_c_check_func "$LINENO" "OSSpinLockLock" "ac_cv_func_OSSpinLockLock"
+if test "x$ac_cv_func_OSSpinLockLock" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_func" | $as_tr_cpp` 1
+#define HAVE_OSSPINLOCKLOCK 1
_ACEOF
fi
@@ -17369,169 +9575,23 @@ done
fi
-cat >>confdefs.h <<\_ACEOF
-#define USE_VFORK 1
-_ACEOF
+$as_echo "#define USE_VFORK 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define TCL_DEFAULT_ENCODING "utf-8"
-_ACEOF
+$as_echo "#define TCL_DEFAULT_ENCODING \"utf-8\"" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define TCL_LOAD_FROM_MEMORY 1
-_ACEOF
+$as_echo "#define TCL_LOAD_FROM_MEMORY 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define TCL_WIDE_CLICKS 1
-_ACEOF
-
+$as_echo "#define TCL_WIDE_CLICKS 1" >>confdefs.h
-for ac_header in AvailabilityMacros.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ for ac_header in AvailabilityMacros.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "AvailabilityMacros.h" "ac_cv_header_AvailabilityMacros_h" "$ac_includes_default"
+if test "x$ac_cv_header_AvailabilityMacros_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_AVAILABILITYMACROS_H 1
_ACEOF
fi
@@ -17539,18 +9599,14 @@ fi
done
if test "$ac_cv_header_AvailabilityMacros_h" = yes; then
- echo "$as_me:$LINENO: checking if weak import is available" >&5
-echo $ECHO_N "checking if weak import is available... $ECHO_C" >&6
-if test "${tcl_cv_cc_weak_import+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if weak import is available" >&5
+$as_echo_n "checking if weak import is available... " >&6; }
+if ${tcl_cv_cc_weak_import+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
@@ -17570,60 +9626,30 @@ rand();
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_cc_weak_import=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_weak_import=no
+ tcl_cv_cc_weak_import=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_weak_import" >&5
-echo "${ECHO_T}$tcl_cv_cc_weak_import" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_weak_import" >&5
+$as_echo "$tcl_cv_cc_weak_import" >&6; }
if test $tcl_cv_cc_weak_import = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_WEAK_IMPORT 1
-_ACEOF
+$as_echo "#define HAVE_WEAK_IMPORT 1" >>confdefs.h
fi
- echo "$as_me:$LINENO: checking if Darwin SUSv3 extensions are available" >&5
-echo $ECHO_N "checking if Darwin SUSv3 extensions are available... $ECHO_C" >&6
-if test "${tcl_cv_cc_darwin_c_source+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if Darwin SUSv3 extensions are available" >&5
+$as_echo_n "checking if Darwin SUSv3 extensions are available... " >&6; }
+if ${tcl_cv_cc_darwin_c_source+:} false; then :
+ $as_echo_n "(cached) " >&6
else
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -Werror"
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __ENVIRONMENT_MAC_OS_X_VERSION_MIN_REQUIRED__
@@ -17644,45 +9670,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_cc_darwin_c_source=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cc_darwin_c_source=no
+ tcl_cv_cc_darwin_c_source=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
CFLAGS=$hold_cflags
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cc_darwin_c_source" >&5
-echo "${ECHO_T}$tcl_cv_cc_darwin_c_source" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cc_darwin_c_source" >&5
+$as_echo "$tcl_cv_cc_darwin_c_source" >&6; }
if test $tcl_cv_cc_darwin_c_source = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define _DARWIN_C_SOURCE 1
-_ACEOF
+$as_echo "#define _DARWIN_C_SOURCE 1" >>confdefs.h
fi
fi
@@ -17698,17 +9698,13 @@ fi
# Check for support of fts functions (readdir replacement)
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for fts" >&5
-echo $ECHO_N "checking for fts... $ECHO_C" >&6
-if test "${tcl_cv_api_fts+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fts" >&5
+$as_echo_n "checking for fts... " >&6; }
+if ${tcl_cv_api_fts+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <sys/param.h>
@@ -17727,45 +9723,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_api_fts=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_api_fts=no
+ tcl_cv_api_fts=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_api_fts" >&5
-echo "${ECHO_T}$tcl_cv_api_fts" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_api_fts" >&5
+$as_echo "$tcl_cv_api_fts" >&6; }
if test $tcl_cv_api_fts = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_FTS 1
-_ACEOF
+$as_echo "#define HAVE_FTS 1" >>confdefs.h
fi
@@ -17776,300 +9746,24 @@ fi
#--------------------------------------------------------------------
-
-for ac_header in sys/ioctl.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ for ac_header in sys/ioctl.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/ioctl.h" "ac_cv_header_sys_ioctl_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_ioctl_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_SYS_IOCTL_H 1
_ACEOF
fi
done
-
-for ac_header in sys/filio.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking $ac_header usability" >&5
-echo $ECHO_N "checking $ac_header usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking $ac_header presence" >&5
-echo $ECHO_N "checking $ac_header presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <$ac_header>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: $ac_header: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: $ac_header: present but cannot be compiled" >&5
-echo "$as_me: WARNING: $ac_header: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: $ac_header: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: $ac_header: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: $ac_header: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: $ac_header: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: $ac_header: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: $ac_header: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- eval "$as_ac_Header=\$ac_header_preproc"
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-
-fi
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+ for ac_header in sys/filio.h
+do :
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/filio.h" "ac_cv_header_sys_filio_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_filio_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define HAVE_SYS_FILIO_H 1
_ACEOF
fi
@@ -18077,27 +9771,21 @@ fi
done
- echo "$as_me:$LINENO: checking system version" >&5
-echo $ECHO_N "checking system version... $ECHO_C" >&6
-if test "${tcl_cv_sys_version+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking system version" >&5
+$as_echo_n "checking system version... " >&6; }
+if ${tcl_cv_sys_version+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test -f /usr/lib/NextStep/software_version; then
- tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+ if test "${TEA_PLATFORM}" = "windows" ; then
+ tcl_cv_sys_version=windows
else
tcl_cv_sys_version=`uname -s`-`uname -r`
if test "$?" -ne 0 ; then
- { echo "$as_me:$LINENO: WARNING: can't find uname command" >&5
-echo "$as_me: WARNING: can't find uname command" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: can't find uname command" >&5
+$as_echo "$as_me: WARNING: can't find uname command" >&2;}
tcl_cv_sys_version=unknown
else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- tcl_cv_sys_version=MP-RAS-`awk '{print $3}' /etc/.relid`
- fi
if test "`uname -s`" = "AIX" ; then
tcl_cv_sys_version=AIX-`uname -v`.`uname -r`
fi
@@ -18105,58 +9793,45 @@ echo "$as_me: WARNING: can't find uname command" >&2;}
fi
fi
-echo "$as_me:$LINENO: result: $tcl_cv_sys_version" >&5
-echo "${ECHO_T}$tcl_cv_sys_version" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_sys_version" >&5
+$as_echo "$tcl_cv_sys_version" >&6; }
system=$tcl_cv_sys_version
- echo "$as_me:$LINENO: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
-echo $ECHO_N "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking FIONBIO vs. O_NONBLOCK for nonblocking I/O" >&5
+$as_echo_n "checking FIONBIO vs. O_NONBLOCK for nonblocking I/O... " >&6; }
case $system in
OSF*)
-cat >>confdefs.h <<\_ACEOF
-#define USE_FIONBIO 1
-_ACEOF
+$as_echo "#define USE_FIONBIO 1" >>confdefs.h
- echo "$as_me:$LINENO: result: FIONBIO" >&5
-echo "${ECHO_T}FIONBIO" >&6
- ;;
- SunOS-4*)
-
-cat >>confdefs.h <<\_ACEOF
-#define USE_FIONBIO 1
-_ACEOF
-
- echo "$as_me:$LINENO: result: FIONBIO" >&5
-echo "${ECHO_T}FIONBIO" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: FIONBIO" >&5
+$as_echo "FIONBIO" >&6; }
;;
*)
- echo "$as_me:$LINENO: result: O_NONBLOCK" >&5
-echo "${ECHO_T}O_NONBLOCK" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: O_NONBLOCK" >&5
+$as_echo "O_NONBLOCK" >&6; }
;;
esac
#------------------------------------------------------------------------
-echo "$as_me:$LINENO: checking whether to use dll unloading" >&5
-echo $ECHO_N "checking whether to use dll unloading... $ECHO_C" >&6
-# Check whether --enable-dll-unloading or --disable-dll-unloading was given.
-if test "${enable_dll_unloading+set}" = set; then
- enableval="$enable_dll_unloading"
- tcl_ok=$enableval
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to use dll unloading" >&5
+$as_echo_n "checking whether to use dll unloading... " >&6; }
+# Check whether --enable-dll-unloading was given.
+if test "${enable_dll_unloading+set}" = set; then :
+ enableval=$enable_dll_unloading; tcl_ok=$enableval
else
tcl_ok=yes
-fi;
+fi
+
if test $tcl_ok = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_UNLOAD_DLLS 1
-_ACEOF
+$as_echo "#define TCL_UNLOAD_DLLS 1" >>confdefs.h
fi
-echo "$as_me:$LINENO: result: $tcl_ok" >&5
-echo "${ECHO_T}$tcl_ok" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
+$as_echo "$tcl_ok" >&6; }
#------------------------------------------------------------------------
# Check whether the timezone data is supplied by the OS or has
@@ -18164,31 +9839,31 @@ echo "${ECHO_T}$tcl_ok" >&6
# be overriden on the configure command line either way.
#------------------------------------------------------------------------
-echo "$as_me:$LINENO: checking for timezone data" >&5
-echo $ECHO_N "checking for timezone data... $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for timezone data" >&5
+$as_echo_n "checking for timezone data... " >&6; }
-# Check whether --with-tzdata or --without-tzdata was given.
-if test "${with_tzdata+set}" = set; then
- withval="$with_tzdata"
- tcl_ok=$withval
+# Check whether --with-tzdata was given.
+if test "${with_tzdata+set}" = set; then :
+ withval=$with_tzdata; tcl_ok=$withval
else
tcl_ok=auto
-fi;
+fi
+
#
# Any directories that get added here must also be added to the
# search path in ::tcl::clock::Initialize (library/clock.tcl).
#
case $tcl_ok in
no)
- echo "$as_me:$LINENO: result: supplied by OS vendor" >&5
-echo "${ECHO_T}supplied by OS vendor" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by OS vendor" >&5
+$as_echo "supplied by OS vendor" >&6; }
;;
yes)
# nothing to do here
;;
auto*)
- if test "${tcl_cv_dir_zoneinfo+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${tcl_cv_dir_zoneinfo+:} false; then :
+ $as_echo_n "(cached) " >&6
else
for dir in /usr/share/zoneinfo \
@@ -18205,22 +9880,20 @@ fi
if test -n "$tcl_cv_dir_zoneinfo"; then
tcl_ok=no
- echo "$as_me:$LINENO: result: $dir" >&5
-echo "${ECHO_T}$dir" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $dir" >&5
+$as_echo "$dir" >&6; }
else
tcl_ok=yes
fi
;;
*)
- { { echo "$as_me:$LINENO: error: invalid argument: $tcl_ok" >&5
-echo "$as_me: error: invalid argument: $tcl_ok" >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error $? "invalid argument: $tcl_ok" "$LINENO" 5
;;
esac
if test $tcl_ok = yes
then
- echo "$as_me:$LINENO: result: supplied by Tcl" >&5
-echo "${ECHO_T}supplied by Tcl" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: supplied by Tcl" >&5
+$as_echo "supplied by Tcl" >&6; }
INSTALL_TZDATA=install-tzdata
fi
@@ -18228,152 +9901,16 @@ fi
# DTrace support
#--------------------------------------------------------------------
-# Check whether --enable-dtrace or --disable-dtrace was given.
-if test "${enable_dtrace+set}" = set; then
- enableval="$enable_dtrace"
- tcl_ok=$enableval
+# Check whether --enable-dtrace was given.
+if test "${enable_dtrace+set}" = set; then :
+ enableval=$enable_dtrace; tcl_ok=$enableval
else
tcl_ok=no
-fi;
-if test $tcl_ok = yes; then
- if test "${ac_cv_header_sys_sdt_h+set}" = set; then
- echo "$as_me:$LINENO: checking for sys/sdt.h" >&5
-echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6
-if test "${ac_cv_header_sys_sdt_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
fi
-echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5
-echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6
-else
- # Is the header compilable?
-echo "$as_me:$LINENO: checking sys/sdt.h usability" >&5
-echo $ECHO_N "checking sys/sdt.h usability... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-#include <sys/sdt.h>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_header_compiler=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-ac_header_compiler=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_compiler" >&5
-echo "${ECHO_T}$ac_header_compiler" >&6
-
-# Is the header present?
-echo "$as_me:$LINENO: checking sys/sdt.h presence" >&5
-echo $ECHO_N "checking sys/sdt.h presence... $ECHO_C" >&6
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-#include <sys/sdt.h>
-_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- ac_header_preproc=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
- ac_header_preproc=no
-fi
-rm -f conftest.err conftest.$ac_ext
-echo "$as_me:$LINENO: result: $ac_header_preproc" >&5
-echo "${ECHO_T}$ac_header_preproc" >&6
-
-# So? What about this header?
-case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in
- yes:no: )
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&5
-echo "$as_me: WARNING: sys/sdt.h: accepted by the compiler, rejected by the preprocessor!" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the compiler's result" >&5
-echo "$as_me: WARNING: sys/sdt.h: proceeding with the compiler's result" >&2;}
- ac_header_preproc=yes
- ;;
- no:yes:* )
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: present but cannot be compiled" >&5
-echo "$as_me: WARNING: sys/sdt.h: present but cannot be compiled" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&5
-echo "$as_me: WARNING: sys/sdt.h: check for missing prerequisite headers?" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: see the Autoconf documentation" >&5
-echo "$as_me: WARNING: sys/sdt.h: see the Autoconf documentation" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&5
-echo "$as_me: WARNING: sys/sdt.h: section \"Present But Cannot Be Compiled\"" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&5
-echo "$as_me: WARNING: sys/sdt.h: proceeding with the preprocessor's result" >&2;}
- { echo "$as_me:$LINENO: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&5
-echo "$as_me: WARNING: sys/sdt.h: in the future, the compiler will take precedence" >&2;}
- (
- cat <<\_ASBOX
-## ------------------------------ ##
-## Report this to the tcl lists. ##
-## ------------------------------ ##
-_ASBOX
- ) |
- sed "s/^/$as_me: WARNING: /" >&2
- ;;
-esac
-echo "$as_me:$LINENO: checking for sys/sdt.h" >&5
-echo $ECHO_N "checking for sys/sdt.h... $ECHO_C" >&6
-if test "${ac_cv_header_sys_sdt_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- ac_cv_header_sys_sdt_h=$ac_header_preproc
-fi
-echo "$as_me:$LINENO: result: $ac_cv_header_sys_sdt_h" >&5
-echo "${ECHO_T}$ac_cv_header_sys_sdt_h" >&6
-
-fi
-if test $ac_cv_header_sys_sdt_h = yes; then
+if test $tcl_ok = yes; then
+ ac_fn_c_check_header_mongrel "$LINENO" "sys/sdt.h" "ac_cv_header_sys_sdt_h" "$ac_includes_default"
+if test "x$ac_cv_header_sys_sdt_h" = xyes; then :
tcl_ok=yes
else
tcl_ok=no
@@ -18384,10 +9921,10 @@ fi
if test $tcl_ok = yes; then
# Extract the first word of "dtrace", so it can be a program name with args.
set dummy dtrace; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_path_DTRACE+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_path_DTRACE+:} false; then :
+ $as_echo_n "(cached) " >&6
else
case $DTRACE in
[\\/]* | ?:[\\/]*)
@@ -18400,38 +9937,37 @@ for as_dir in $as_dummy
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_DTRACE="$as_dir/$ac_word$ac_exec_ext"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
;;
esac
fi
DTRACE=$ac_cv_path_DTRACE
-
if test -n "$DTRACE"; then
- echo "$as_me:$LINENO: result: $DTRACE" >&5
-echo "${ECHO_T}$DTRACE" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $DTRACE" >&5
+$as_echo "$DTRACE" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
test -z "$ac_cv_path_DTRACE" && tcl_ok=no
fi
-echo "$as_me:$LINENO: checking whether to enable DTrace support" >&5
-echo $ECHO_N "checking whether to enable DTrace support... $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to enable DTrace support" >&5
+$as_echo_n "checking whether to enable DTrace support... " >&6; }
MAKEFILE_SHELL='/bin/sh'
if test $tcl_ok = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define USE_DTRACE 1
-_ACEOF
+$as_echo "#define USE_DTRACE 1" >>confdefs.h
DTRACE_SRC="\${DTRACE_SRC}"
DTRACE_HDR="\${DTRACE_HDR}"
@@ -18449,24 +9985,185 @@ _ACEOF
fi
fi
fi
-echo "$as_me:$LINENO: result: $tcl_ok" >&5
-echo "${ECHO_T}$tcl_ok" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_ok" >&5
+$as_echo "$tcl_ok" >&6; }
+
+#--------------------------------------------------------------------
+# Zipfs support - Tip 430
+#--------------------------------------------------------------------
+# Check whether --enable-zipfs was given.
+if test "${enable_zipfs+set}" = set; then :
+ enableval=$enable_zipfs; tcl_ok=$enableval
+else
+ tcl_ok=yes
+fi
+
+if test "$tcl_ok" = "yes" ; then
+ #
+ # Find a native compiler
+ #
+ # Put a plausible default for CC_FOR_BUILD in Makefile.
+ if test -z "$CC_FOR_BUILD"; then
+ if test "x$cross_compiling" = "xno"; then
+ CC_FOR_BUILD='$(CC)'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
+$as_echo_n "checking for gcc... " >&6; }
+ if ${ac_cv_path_cc+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/gcc 2> /dev/null` \
+ `ls -r $dir/gcc 2> /dev/null` ; do
+ if test x"$ac_cv_path_cc" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_cc=$j
+ break
+ fi
+ fi
+ done
+ done
+
+fi
+
+ fi
+ fi
+
+ # Also set EXEEXT_FOR_BUILD.
+ if test "x$cross_compiling" = "xno"; then
+ EXEEXT_FOR_BUILD='$(EXEEXT)'
+ OBJEXT_FOR_BUILD='$(OBJEXT)'
+ else
+ OBJEXT_FOR_BUILD='.no'
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
+$as_echo_n "checking for build system executable suffix... " >&6; }
+if ${bfd_cv_build_exeext+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.c
+ bfd_cv_build_exeext=
+ ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ rm -f conftest*
+ test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
+$as_echo "$bfd_cv_build_exeext" >&6; }
+ EXEEXT_FOR_BUILD=""
+ test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+ fi
+
+ #
+ # Find a native zip implementation
+ #
+
+ ZIP_PROG=""
+ ZIP_PROG_OPTIONS=""
+ ZIP_PROG_VFSSEARCH=""
+ ZIP_INSTALL_OBJS=""
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
+$as_echo_n "checking for zip... " >&6; }
+ if ${ac_cv_path_zip+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/zip 2> /dev/null` \
+ `ls -r $dir/zip 2> /dev/null` ; do
+ if test x"$ac_cv_path_zip" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_zip=$j
+ break
+ fi
+ fi
+ done
+ done
+
+fi
+
+ if test -f "$ac_cv_path_zip" ; then
+ ZIP_PROG="$ac_cv_path_zip"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
+$as_echo "$ZIP_PROG" >&6; }
+ ZIP_PROG_OPTIONS="-rq"
+ ZIP_PROG_VFSSEARCH="*"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
+$as_echo "Found INFO Zip in environment" >&6; }
+ # Use standard arguments for zip
+ else
+ # It is not an error if an installed version of Zip can't be located.
+ # We can use the locally distributed minizip instead
+ ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
+ ZIP_PROG_OPTIONS="-o -r"
+ ZIP_PROG_VFSSEARCH="*"
+ ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH. Building minizip" >&5
+$as_echo "No zip found on PATH. Building minizip" >&6; }
+ fi
+
+
+
+
+
+ ZIPFS_BUILD=1
+ TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+ ZIPFS_BUILD=0
+ TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
+$as_echo_n "checking for building with zipfs... " >&6; }
+if test "${ZIPFS_BUILD}" = 1; then
+ if test "${SHARED_BUILD}" = 0; then
+ ZIPFS_BUILD=2;
+
+$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h
+
+ INSTALL_LIBRARIES=install-libraries-zipfs-static
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ else
+
+$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
+\
+ INSTALL_LIBRARIES=install-libraries-zipfs-shared
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ fi
+else
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+
+
+
+
+
#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking whether the cpuid instruction is usable" >&5
-echo $ECHO_N "checking whether the cpuid instruction is usable... $ECHO_C" >&6
-if test "${tcl_cv_cpuid+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the cpuid instruction is usable" >&5
+$as_echo_n "checking whether the cpuid instruction is usable... " >&6; }
+if ${tcl_cv_cpuid+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -18485,45 +10182,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_cpuid=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cpuid=no
+ tcl_cv_cpuid=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cpuid" >&5
-echo "${ECHO_T}$tcl_cv_cpuid" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cpuid" >&5
+$as_echo "$tcl_cv_cpuid" >&6; }
if test $tcl_cv_cpuid = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_CPUID 1
-_ACEOF
+$as_echo "#define HAVE_CPUID 1" >>confdefs.h
fi
@@ -18554,38 +10225,38 @@ HTML_DIR='$(DISTDIR)/html'
if test "`uname -s`" = "Darwin" ; then
if test "`uname -s`" = "Darwin" ; then
- echo "$as_me:$LINENO: checking how to package libraries" >&5
-echo $ECHO_N "checking how to package libraries... $ECHO_C" >&6
- # Check whether --enable-framework or --disable-framework was given.
-if test "${enable_framework+set}" = set; then
- enableval="$enable_framework"
- enable_framework=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to package libraries" >&5
+$as_echo_n "checking how to package libraries... " >&6; }
+ # Check whether --enable-framework was given.
+if test "${enable_framework+set}" = set; then :
+ enableval=$enable_framework; enable_framework=$enableval
else
enable_framework=no
-fi;
+fi
+
if test $enable_framework = yes; then
if test $SHARED_BUILD = 0; then
- { echo "$as_me:$LINENO: WARNING: Frameworks can only be built if --enable-shared is yes" >&5
-echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be built if --enable-shared is yes" >&5
+$as_echo "$as_me: WARNING: Frameworks can only be built if --enable-shared is yes" >&2;}
enable_framework=no
fi
if test $tcl_corefoundation = no; then
- { echo "$as_me:$LINENO: WARNING: Frameworks can only be used when CoreFoundation is available" >&5
-echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Frameworks can only be used when CoreFoundation is available" >&5
+$as_echo "$as_me: WARNING: Frameworks can only be used when CoreFoundation is available" >&2;}
enable_framework=no
fi
fi
if test $enable_framework = yes; then
- echo "$as_me:$LINENO: result: framework" >&5
-echo "${ECHO_T}framework" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: framework" >&5
+$as_echo "framework" >&6; }
FRAMEWORK_BUILD=1
else
if test $SHARED_BUILD = 1; then
- echo "$as_me:$LINENO: result: shared library" >&5
-echo "${ECHO_T}shared library" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared library" >&5
+$as_echo "shared library" >&6; }
else
- echo "$as_me:$LINENO: result: static library" >&5
-echo "${ECHO_T}static library" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: static library" >&5
+$as_echo "static library" >&6; }
fi
FRAMEWORK_BUILD=0
fi
@@ -18597,20 +10268,18 @@ echo "${ECHO_T}static library" >&6
TCL_SHLIB_LD_EXTRAS="${TCL_SHLIB_LD_EXTRAS}"' -sectcreate __TEXT __info_plist Tcl-Info.plist'
EXTRA_TCLSH_LIBS='-sectcreate __TEXT __info_plist Tclsh-Info.plist'
EXTRA_APP_CC_SWITCHES='-mdynamic-no-pic'
- ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in"
+ ac_config_files="$ac_config_files Tcl-Info.plist:../macosx/Tcl-Info.plist.in Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in"
TCL_YEAR="`date +%Y`"
fi
if test "$FRAMEWORK_BUILD" = "1" ; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_FRAMEWORK 1
-_ACEOF
+$as_echo "#define TCL_FRAMEWORK 1" >>confdefs.h
# Construct a fake local framework structure to make linking with
# '-framework Tcl' and running of tcltest work
- ac_config_commands="$ac_config_commands Tcl.framework"
+ ac_config_commands="$ac_config_commands Tcl.framework"
LD_LIBRARY_PATH_VAR="DYLD_FRAMEWORK_PATH"
# default install directory for bundled packages
@@ -18770,7 +10439,8 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
- ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
+
+ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
@@ -18790,39 +10460,70 @@ _ACEOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
+# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
+ esac ;;
+ esac
+ done
+
(set) 2>&1 |
- case `(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 \).
+ case $as_nl`(ac_space=' '; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
+ # `set' does not quote correctly, so add quotes: double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \.
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
- ;;
+ ;; #(
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-} |
+ esac |
+ sort
+) |
sed '
+ /^ac_cv_env_/b end
t clear
- : clear
+ :clear
s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
t end
- /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
- : end' >>confcache
-if diff $cache_file confcache >/dev/null 2>&1; then :; else
- if test -w $cache_file; then
- test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
- cat confcache >$cache_file
+ s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+ if test -w "$cache_file"; then
+ if test "x$cache_file" != "x/dev/null"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+ if test ! -f "$cache_file" || test -h "$cache_file"; then
+ cat confcache >"$cache_file"
+ else
+ case $cache_file in #(
+ */* | ?:*)
+ mv -f confcache "$cache_file"$$ &&
+ mv -f "$cache_file"$$ "$cache_file" ;; #(
+ *)
+ mv -f confcache "$cache_file" ;;
+ esac
+ fi
+ fi
else
- echo "not updating unwritable cache $cache_file"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
fi
fi
rm -f confcache
@@ -18831,63 +10532,56 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-# VPATH may cause trouble with some makes, so we remove $(srcdir),
-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
-# trailing colons and then remove the whole line if VPATH becomes empty
-# (actually we leave an empty line to preserve line numbers).
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=/{
-s/:*\$(srcdir):*/:/;
-s/:*\${srcdir}:*/:/;
-s/:*@srcdir@:*/:/;
-s/^\([^=]*=[ ]*\):*/\1/;
-s/:*$//;
-s/^[^=]*=[ ]*$//;
-}'
-fi
-
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
-# take arguments), then we branch to the quote section. Otherwise,
+# take arguments), then branch to the quote section. Otherwise,
# look for a macro that doesn't take arguments.
-cat >confdef2opt.sed <<\_ACEOF
+ac_script='
+:mline
+/\\$/{
+ N
+ s,\\\n,,
+ b mline
+}
t clear
-: clear
-s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+:clear
+s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g
t quote
-s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g
t quote
-d
-: quote
-s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
-s,\[,\\&,g
-s,\],\\&,g
-s,\$,$$,g
-p
-_ACEOF
-# We use echo to avoid assuming a particular line-breaking character.
-# The extra dot is to prevent the shell from consuming trailing
-# line-breaks from the sub-command output. A line-break within
-# single-quotes doesn't work because, if this script is created in a
-# platform that uses two characters for line-breaks (e.g., DOS), tr
-# would break.
-ac_LF_and_DOT=`echo; echo .`
-DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
-rm -f confdef2opt.sed
+b any
+:quote
+s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g
+s/\[/\\&/g
+s/\]/\\&/g
+s/\$/$$/g
+H
+:any
+${
+ g
+ s/^\n//
+ s/\n/ /g
+ p
+}
+'
+DEFS=`sed -n "$ac_script" confdefs.h`
CFLAGS="${CFLAGS} ${CPPFLAGS}"; CPPFLAGS=""
-: ${CONFIG_STATUS=./config.status}
+
+: "${CONFIG_STATUS=./config.status}"
+ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
-{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
-echo "$as_me: creating $CONFIG_STATUS" >&6;}
-cat >$CONFIG_STATUS <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
@@ -18897,81 +10591,253 @@ cat >$CONFIG_STATUS <<_ACEOF
debug=false
ac_cs_recheck=false
ac_cs_silent=false
-SHELL=\${CONFIG_SHELL-$SHELL}
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
-DUALCASE=1; export DUALCASE # for MKS sh
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
+else
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
+ else
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
+ fi
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
fi
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
+fi
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- $as_unset $as_var
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$1; test $as_status -eq 0 && as_status=1
+ if test "$4"; then
+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
fi
-done
+ $as_echo "$as_me: error: $2" >&2
+ as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-
-# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -18979,148 +10845,111 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
- sed '
- N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
- t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
- ' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
- # Exit status is that of the last command.
- exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+ case `echo 'xy\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
else
- as_expr=false
+ rm -f conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -pR'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -pR'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
+ as_ln_s='cp -pR'
fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-as_executable_p="test -f"
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -19129,31 +10958,20 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
exec 6>&1
-
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling. Logging --version etc. is OK.
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
-This file was extended by tcl $as_me 8.6, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+# values after options handling.
+ac_log="
+This file was extended by tcl $as_me 8.7, which was
+generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -19161,43 +10979,41 @@ generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_COMMANDS = $CONFIG_COMMANDS
$ $0 $@
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
_ACEOF
-# Files that config.status was made for.
-if test -n "$ac_config_files"; then
- echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
-fi
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
-if test -n "$ac_config_headers"; then
- echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
-fi
-if test -n "$ac_config_links"; then
- echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
-fi
-if test -n "$ac_config_commands"; then
- echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
-fi
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_files="$ac_config_files"
+config_commands="$ac_config_commands"
-cat >>$CONFIG_STATUS <<\_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration. Unless the files
+and actions are specified as TAGs, all are instantiated by default.
-Usage: $0 [OPTIONS] [FILE]...
+Usage: $0 [OPTION]... [TAG]...
-h, --help print this help, then exit
- -V, --version print version number, then exit
- -q, --quiet do not print progress messages
+ -V, --version print version number and configuration settings, then exit
+ --config print configuration, then exit
+ -q, --quiet, --silent
+ do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
Configuration files:
$config_files
@@ -19205,83 +11021,78 @@ $config_files
Configuration commands:
$config_commands
-Report bugs to <bug-autoconf@gnu.org>."
-_ACEOF
+Report bugs to the package provider."
-cat >>$CONFIG_STATUS <<_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-tcl config.status 8.6
-configured by $0, generated by GNU Autoconf 2.59,
- with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+tcl config.status 8.7
+configured by $0, generated by GNU Autoconf 2.69,
+ with options \\"\$ac_cs_config\\"
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
-srcdir=$srcdir
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-# If no file are specified by the user, then we need to provide default
-# value. By we need to know if files were specified by the user.
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
case $1 in
- --*=*)
- ac_option=`expr "x$1" : 'x\([^=]*\)='`
- ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ --*=?*)
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
ac_shift=:
;;
- -*)
+ --*=)
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=
+ ac_shift=:
+ ;;
+ *)
ac_option=$1
ac_optarg=$2
ac_shift=shift
;;
- *) # This is not an option, so the user has probably given explicit
- # arguments.
- ac_option=$1
- ac_need_defaults=false;;
esac
case $ac_option in
# Handling of the options.
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
- --version | --vers* | -V )
- echo "$ac_cs_version"; exit 0 ;;
- --he | --h)
- # Conflict between --help and --header
- { { echo "$as_me:$LINENO: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; };;
- --help | --hel | -h )
- echo "$ac_cs_usage"; exit 0 ;;
- --debug | --d* | -d )
+ --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+ $as_echo "$ac_cs_version"; exit ;;
+ --config | --confi | --conf | --con | --co | --c )
+ $as_echo "$ac_cs_config"; exit ;;
+ --debug | --debu | --deb | --de | --d | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
- CONFIG_FILES="$CONFIG_FILES $ac_optarg"
- ac_need_defaults=false;;
- --header | --heade | --head | --hea )
- $ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ case $ac_optarg in
+ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ '') as_fn_error $? "missing file argument" ;;
+ esac
+ as_fn_append CONFIG_FILES " '$ac_optarg'"
ac_need_defaults=false;;
+ --he | --h | --help | --hel | -h )
+ $as_echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
- -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; } ;;
+ -*) as_fn_error $? "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
- *) ac_config_targets="$ac_config_targets $1" ;;
+ *) as_fn_append ac_config_targets " $1"
+ ac_need_defaults=false ;;
esac
shift
@@ -19295,43 +11106,55 @@ if $ac_cs_silent; then
fi
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
- exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ shift
+ \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+ CONFIG_SHELL='$SHELL'
+ export CONFIG_SHELL
+ exec "\$@"
fi
_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+ $as_echo "$ac_log"
+} >&5
-cat >>$CONFIG_STATUS <<_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
#
-# INIT-COMMANDS section.
+# INIT-COMMANDS
#
-
VERSION=${TCL_VERSION}
_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-
-cat >>$CONFIG_STATUS <<\_ACEOF
+# Handling of arguments.
for ac_config_target in $ac_config_targets
do
- case "$ac_config_target" in
- # Handling of arguments.
- "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;;
- "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;;
- "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
- "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
- "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
- "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
- "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
- *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
- { (exit 1); exit 1; }; };;
+ case $ac_config_target in
+ "Tcl-Info.plist") CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;;
+ "Tclsh-Info.plist") CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;;
+ "Tcl.framework") CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
+ "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
+ "dltest/Makefile") CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
+ "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
+ "tcl.pc") CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
+
+ *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
esac
done
+
# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used. Set only those that are not.
# We use the long form for the default assignment because of an extremely
@@ -19342,533 +11165,427 @@ if $ac_need_defaults; then
fi
# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
+# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
- trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
- trap '{ (exit 1); exit 1; }' 1 2 13 15
+ tmp= ac_tmp=
+ trap 'exit_status=$?
+ : "${ac_tmp:=$tmp}"
+ { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
+' 0
+ trap 'as_fn_exit 1' 1 2 13 15
}
-
# Create a (secure) tmp directory for tmp files.
{
- tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
- test -n "$tmp" && test -d "$tmp"
+ tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+ test -d "$tmp"
} ||
{
- tmp=./confstat$$-$RANDOM
- (umask 077 && mkdir $tmp)
-} ||
+ tmp=./conf$$-$RANDOM
+ (umask 077 && mkdir "$tmp")
+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
+ac_tmp=$tmp
+
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
+if test -n "$CONFIG_FILES"; then
+
+
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+ eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+ ac_cs_awk_cr='\\r'
+else
+ ac_cs_awk_cr=$ac_cr
+fi
+
+echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
+_ACEOF
+
+
{
- echo "$me: cannot create a temporary directory in ." >&2
- { (exit 1); exit 1; }
+ echo "cat >conf$$subs.awk <<_ACEOF" &&
+ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+ echo "_ACEOF"
+} >conf$$subs.sh ||
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+ . ./conf$$subs.sh ||
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+
+ ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+ if test $ac_delim_n = $ac_delim_num; then
+ break
+ elif $ac_last_try; then
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ else
+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+ fi
+done
+rm -f conf$$subs.sh
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' <conf$$subs.awk | sed '
+/^[^""]/{
+ N
+ s/\n//
+}
+' >>$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
+ for (key in S) S_is_set[key] = 1
+ FS = ""
+
+}
+{
+ line = $ 0
+ nfields = split(line, field, "@")
+ substed = 0
+ len = length(field[1])
+ for (i = 2; i < nfields; i++) {
+ key = field[i]
+ keylen = length(key)
+ if (S_is_set[key]) {
+ value = S[key]
+ line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+ len += length(value) + length(field[++i])
+ substed = 1
+ } else
+ len += 1 + keylen
+ }
+
+ print line
}
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+ cat
+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
+ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{
+h
+s///
+s/^/:/
+s/[ ]*$/:/
+s/:\$(srcdir):/:/g
+s/:\${srcdir}:/:/g
+s/:@srcdir@:/:/g
+s/^:*//
+s/:*$//
+x
+s/\(=[ ]*\).*/\1/
+G
+s/\n//
+s/^[^=]*=[ ]*$//
+}'
+fi
-#
-# CONFIG_FILES section.
-#
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+fi # test -n "$CONFIG_FILES"
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "\$CONFIG_FILES"; then
- # Protect against being on the right side of a sed subst in config.status.
- sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
- s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
-s,@SHELL@,$SHELL,;t t
-s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
-s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
-s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
-s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
-s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
-s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
-s,@exec_prefix@,$exec_prefix,;t t
-s,@prefix@,$prefix,;t t
-s,@program_transform_name@,$program_transform_name,;t t
-s,@bindir@,$bindir,;t t
-s,@sbindir@,$sbindir,;t t
-s,@libexecdir@,$libexecdir,;t t
-s,@datadir@,$datadir,;t t
-s,@sysconfdir@,$sysconfdir,;t t
-s,@sharedstatedir@,$sharedstatedir,;t t
-s,@localstatedir@,$localstatedir,;t t
-s,@libdir@,$libdir,;t t
-s,@includedir@,$includedir,;t t
-s,@oldincludedir@,$oldincludedir,;t t
-s,@infodir@,$infodir,;t t
-s,@mandir@,$mandir,;t t
-s,@build_alias@,$build_alias,;t t
-s,@host_alias@,$host_alias,;t t
-s,@target_alias@,$target_alias,;t t
-s,@DEFS@,$DEFS,;t t
-s,@ECHO_C@,$ECHO_C,;t t
-s,@ECHO_N@,$ECHO_N,;t t
-s,@ECHO_T@,$ECHO_T,;t t
-s,@LIBS@,$LIBS,;t t
-s,@MAN_FLAGS@,$MAN_FLAGS,;t t
-s,@CC@,$CC,;t t
-s,@CFLAGS@,$CFLAGS,;t t
-s,@LDFLAGS@,$LDFLAGS,;t t
-s,@CPPFLAGS@,$CPPFLAGS,;t t
-s,@ac_ct_CC@,$ac_ct_CC,;t t
-s,@EXEEXT@,$EXEEXT,;t t
-s,@OBJEXT@,$OBJEXT,;t t
-s,@CPP@,$CPP,;t t
-s,@EGREP@,$EGREP,;t t
-s,@TCL_THREADS@,$TCL_THREADS,;t t
-s,@TCLSH_PROG@,$TCLSH_PROG,;t t
-s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
-s,@ZLIB_SRCS@,$ZLIB_SRCS,;t t
-s,@ZLIB_INCLUDE@,$ZLIB_INCLUDE,;t t
-s,@RANLIB@,$RANLIB,;t t
-s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
-s,@AR@,$AR,;t t
-s,@ac_ct_AR@,$ac_ct_AR,;t t
-s,@LIBOBJS@,$LIBOBJS,;t t
-s,@TCL_LIBS@,$TCL_LIBS,;t t
-s,@DL_LIBS@,$DL_LIBS,;t t
-s,@DL_OBJS@,$DL_OBJS,;t t
-s,@PLAT_OBJS@,$PLAT_OBJS,;t t
-s,@PLAT_SRCS@,$PLAT_SRCS,;t t
-s,@LDAIX_SRC@,$LDAIX_SRC,;t t
-s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t
-s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t
-s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t
-s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t
-s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t
-s,@CC_SEARCH_FLAGS@,$CC_SEARCH_FLAGS,;t t
-s,@LD_SEARCH_FLAGS@,$LD_SEARCH_FLAGS,;t t
-s,@STLIB_LD@,$STLIB_LD,;t t
-s,@SHLIB_LD@,$SHLIB_LD,;t t
-s,@TCL_SHLIB_LD_EXTRAS@,$TCL_SHLIB_LD_EXTRAS,;t t
-s,@TK_SHLIB_LD_EXTRAS@,$TK_SHLIB_LD_EXTRAS,;t t
-s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t
-s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t
-s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t
-s,@MAKE_LIB@,$MAKE_LIB,;t t
-s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t
-s,@INSTALL_LIB@,$INSTALL_LIB,;t t
-s,@DLL_INSTALL_DIR@,$DLL_INSTALL_DIR,;t t
-s,@INSTALL_STUB_LIB@,$INSTALL_STUB_LIB,;t t
-s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
-s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
-s,@DTRACE@,$DTRACE,;t t
-s,@TCL_VERSION@,$TCL_VERSION,;t t
-s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t
-s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t
-s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
-s,@TCL_YEAR@,$TCL_YEAR,;t t
-s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t
-s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
-s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t
-s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t
-s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t
-s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t
-s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t
-s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t
-s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t
-s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t
-s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t
-s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
-s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t
-s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t
-s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t
-s,@LD_LIBRARY_PATH_VAR@,$LD_LIBRARY_PATH_VAR,;t t
-s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t
-s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t
-s,@TCL_SHARED_LIB_SUFFIX@,$TCL_SHARED_LIB_SUFFIX,;t t
-s,@TCL_UNSHARED_LIB_SUFFIX@,$TCL_UNSHARED_LIB_SUFFIX,;t t
-s,@TCL_HAS_LONGLONG@,$TCL_HAS_LONGLONG,;t t
-s,@INSTALL_TZDATA@,$INSTALL_TZDATA,;t t
-s,@DTRACE_SRC@,$DTRACE_SRC,;t t
-s,@DTRACE_HDR@,$DTRACE_HDR,;t t
-s,@DTRACE_OBJ@,$DTRACE_OBJ,;t t
-s,@MAKEFILE_SHELL@,$MAKEFILE_SHELL,;t t
-s,@BUILD_DLTEST@,$BUILD_DLTEST,;t t
-s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
-s,@TCL_MODULE_PATH@,$TCL_MODULE_PATH,;t t
-s,@TCL_LIBRARY@,$TCL_LIBRARY,;t t
-s,@PRIVATE_INCLUDE_DIR@,$PRIVATE_INCLUDE_DIR,;t t
-s,@HTML_DIR@,$HTML_DIR,;t t
-s,@PACKAGE_DIR@,$PACKAGE_DIR,;t t
-s,@EXTRA_CC_SWITCHES@,$EXTRA_CC_SWITCHES,;t t
-s,@EXTRA_APP_CC_SWITCHES@,$EXTRA_APP_CC_SWITCHES,;t t
-s,@EXTRA_INSTALL@,$EXTRA_INSTALL,;t t
-s,@EXTRA_INSTALL_BINARIES@,$EXTRA_INSTALL_BINARIES,;t t
-s,@EXTRA_BUILD_HTML@,$EXTRA_BUILD_HTML,;t t
-s,@EXTRA_TCLSH_LIBS@,$EXTRA_TCLSH_LIBS,;t t
-s,@DLTEST_LD@,$DLTEST_LD,;t t
-s,@DLTEST_SUFFIX@,$DLTEST_SUFFIX,;t t
-CEOF
-_ACEOF
+eval set X " :F $CONFIG_FILES :C $CONFIG_COMMANDS"
+shift
+for ac_tag
+do
+ case $ac_tag in
+ :[FHLC]) ac_mode=$ac_tag; continue;;
+ esac
+ case $ac_mode$ac_tag in
+ :[FHL]*:*);;
+ :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
+ :[FH]-) ac_tag=-:-;;
+ :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+ esac
+ ac_save_IFS=$IFS
+ IFS=:
+ set x $ac_tag
+ IFS=$ac_save_IFS
+ shift
+ ac_file=$1
+ shift
- cat >>$CONFIG_STATUS <<\_ACEOF
- # Split the substitutions into bite-sized pieces for seds with
- # small command number limits, like on Digital OSF/1 and HP-UX.
- ac_max_sed_lines=48
- ac_sed_frag=1 # Number of current file.
- ac_beg=1 # First line for current file.
- ac_end=$ac_max_sed_lines # Line after last line for current file.
- ac_more_lines=:
- ac_sed_cmds=
- while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- else
- sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- fi
- if test ! -s $tmp/subs.frag; then
- ac_more_lines=false
- else
- # The purpose of the label and of the branching condition is to
- # speed up the sed processing (if there are no `@' at all, there
- # is no need to browse any of the substitutions).
- # These are the two extra sed commands mentioned above.
- (echo ':t
- /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
- fi
- ac_sed_frag=`expr $ac_sed_frag + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_lines`
+ case $ac_mode in
+ :L) ac_source=$1;;
+ :[FH])
+ ac_file_inputs=
+ for ac_f
+ do
+ case $ac_f in
+ -) ac_f="$ac_tmp/stdin";;
+ *) # Look for the file first in the build tree, then in the source tree
+ # (if the path is not absolute). The absolute path cannot be DOS-style,
+ # because $ac_f cannot contain `:'.
+ test -f "$ac_f" ||
+ case $ac_f in
+ [\\/$]*) false;;
+ *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+ esac ||
+ as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+ esac
+ case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+ as_fn_append ac_file_inputs " '$ac_f'"
+ done
+
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ configure_input='Generated from '`
+ $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+ `' by configure.'
+ if test x"$ac_file" != x-; then
+ configure_input="$ac_file. $configure_input"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
fi
- done
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
- fi
-fi # test -n "$CONFIG_FILES"
+ # Neutralize special characters interpreted by sed in replacement strings.
+ case $configure_input in #(
+ *\&* | *\|* | *\\* )
+ ac_sed_conf_input=`$as_echo "$configure_input" |
+ sed 's/[\\\\&|]/\\\\&/g'`;; #(
+ *) ac_sed_conf_input=$configure_input;;
+ esac
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
+ case $ac_tag in
+ *:-:* | *:-) cat >"$ac_tmp/stdin" \
+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
+ esac
+ ;;
esac
- # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+ ac_dir=`$as_dirname -- "$ac_file" ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
+ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ as_dir="$ac_dir"; as_fn_mkdir_p
ac_builddir=.
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+
+ case $ac_mode in
+ :F)
+ #
+ # CONFIG_FILE
+ #
+
+_ACEOF
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+ac_sed_dataroot='
+/datarootdir/ {
+ p
+ q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ ac_datarootdir_hack='
+ s&@datadir@&$datadir&g
+ s&@docdir@&$docdir&g
+ s&@infodir@&$infodir&g
+ s&@localedir@&$localedir&g
+ s&@mandir@&$mandir&g
+ s&\\\${datarootdir}&$datarootdir&g' ;;
esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
-
-
- if test x"$ac_file" != x-; then
- { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
- rm -f "$ac_file"
- fi
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- configure_input=
- else
- configure_input="$ac_file. "
- fi
- configure_input=$configure_input"Generated from `echo $ac_file_in |
- sed 's,.*/,,'` by configure."
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
- sed "$ac_vpsub
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s,@configure_input@,$configure_input,;t t
-s,@srcdir@,$ac_srcdir,;t t
-s,@abs_srcdir@,$ac_abs_srcdir,;t t
-s,@top_srcdir@,$ac_top_srcdir,;t t
-s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s,@builddir@,$ac_builddir,;t t
-s,@abs_builddir@,$ac_abs_builddir,;t t
-s,@top_builddir@,$ac_top_builddir,;t t
-s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
- rm -f $tmp/stdin
- if test x"$ac_file" != x-; then
- mv $tmp/out $ac_file
- else
- cat $tmp/out
- rm -f $tmp/out
- fi
-
-done
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-
-#
-# CONFIG_COMMANDS section.
-#
-for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue
- ac_dest=`echo "$ac_file" | sed 's,:.*,,'`
- ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_dir=`(dirname "$ac_dest") 2>/dev/null ||
-$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$ac_dest" : 'X\(//\)[^/]' \| \
- X"$ac_dest" : 'X\(//\)$' \| \
- X"$ac_dest" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_dest" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
- ac_builddir=.
+s|@configure_input@|$ac_sed_conf_input|;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+$ac_datarootdir_hack
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
+ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+ { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
+ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \
+ "$ac_tmp/out"`; test -z "$ac_out"; } &&
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined" >&5
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined" >&2;}
+
+ rm -f "$ac_tmp/stdin"
+ case $ac_file in
+ -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
+ *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
+ esac \
+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+ ;;
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
-case $srcdir in
- .) # No --srcdir option. We are building in place.
- ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
- ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
+ :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5
+$as_echo "$as_me: executing $ac_file commands" >&6;}
+ ;;
+ esac
- { echo "$as_me:$LINENO: executing $ac_dest commands" >&5
-echo "$as_me: executing $ac_dest commands" >&6;}
- case $ac_dest in
- Tcl.framework ) n=Tcl &&
+ case $ac_file$ac_mode in
+ "Tcl.framework":C) n=Tcl &&
f=$n.framework && v=Versions/$VERSION &&
rm -rf $f && mkdir -p $f/$v/Resources &&
ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v &&
ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist &&
unset n f v
;;
+
esac
-done
-_ACEOF
+done # for ac_tag
-cat >>$CONFIG_STATUS <<\_ACEOF
-{ (exit 0); exit 0; }
+as_fn_exit 0
_ACEOF
-chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save
+test $ac_write_fail = 0 ||
+ as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
@@ -19888,7 +11605,11 @@ if test "$no_create" != yes; then
exec 5>>config.log
# Use ||, not &&, to avoid exiting from the if with $? = 1, which
# would make configure fail if this is the last instruction.
- $ac_cs_success || { (exit 1); exit 1; }
+ $ac_cs_success || as_fn_exit 1
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
diff --git a/unix/configure.in b/unix/configure.ac
index 61e408f..f34091f 100644
--- a/unix/configure.in
+++ b/unix/configure.ac
@@ -3,8 +3,8 @@ 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.
-AC_INIT([tcl],[8.6])
-AC_PREREQ(2.59)
+AC_INIT([tcl],[8.7])
+AC_PREREQ(2.69)
dnl This is only used when included from macosx/configure.ac
m4_ifdef([SC_USE_CONFIG_HEADERS], [
@@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
#endif /* _TCLCONFIG */])
])
-TCL_VERSION=8.6
+TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".9"
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
@@ -86,6 +86,7 @@ fi
AC_PROG_CC
AC_C_INLINE
+
#--------------------------------------------------------------------
# Supply substitutes for missing POSIX header files. Special notes:
# - stdlib.h doesn't define strtol, strtoul, or
@@ -120,12 +121,6 @@ if test -z "$no_pipe" && test -n "$GCC"; then
fi
#------------------------------------------------------------------------
-# Threads support
-#------------------------------------------------------------------------
-
-SC_ENABLE_THREADS
-
-#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------
@@ -182,7 +177,6 @@ SC_CONFIG_CFLAGS
SC_ENABLE_SYMBOLS(bccdebug)
-AC_DEFINE(TCL_TOMMATH, 1, [Build libtommath?])
AC_DEFINE(MP_PREC, 4, [Default libtommath precision.])
#--------------------------------------------------------------------
@@ -216,7 +210,7 @@ AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])
-if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
+if test "`uname -s`" = "Darwin" && \
test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then
# prior to Darwin 7, realpath is not threadsafe, so don't
# use it when threads are enabled, c.f. bug # 711232
@@ -230,35 +224,33 @@ SC_TCL_IPV6
# Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------
-if test "${TCL_THREADS}" = 1; then
- SC_TCL_GETPWUID_R
- SC_TCL_GETPWNAM_R
- SC_TCL_GETGRGID_R
- SC_TCL_GETGRNAM_R
- if test "`uname -s`" = "Darwin" && \
- test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
- # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
- # are actually MT-safe as they always return pointers
- # from TSD instead of static storage.
- AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
- [Do we have MT-safe gethostbyname() ?])
- AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
- [Do we have MT-safe gethostbyaddr() ?])
-
- elif test "`uname -s`" = "HP-UX" && \
- test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
- # Starting with HPUX 11.00 (we believe), gethostbyX
- # are actually MT-safe as they always return pointers
- # from TSD instead of static storage.
- AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
- [Do we have MT-safe gethostbyname() ?])
- AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
- [Do we have MT-safe gethostbyaddr() ?])
+SC_TCL_GETPWUID_R
+SC_TCL_GETPWNAM_R
+SC_TCL_GETGRGID_R
+SC_TCL_GETGRNAM_R
+if test "`uname -s`" = "Darwin" && \
+ test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
+ # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
+ # are actually MT-safe as they always return pointers
+ # from TSD instead of static storage.
+ AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
+ [Do we have MT-safe gethostbyname() ?])
+ AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
+ [Do we have MT-safe gethostbyaddr() ?])
+
+elif test "`uname -s`" = "HP-UX" && \
+ test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
+ # Starting with HPUX 11.00 (we believe), gethostbyX
+ # are actually MT-safe as they always return pointers
+ # from TSD instead of static storage.
+ AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
+ [Do we have MT-safe gethostbyname() ?])
+ AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
+ [Do we have MT-safe gethostbyaddr() ?])
- else
- SC_TCL_GETHOSTBYNAME_R
- SC_TCL_GETHOSTBYADDR_R
- fi
+else
+ SC_TCL_GETHOSTBYNAME_R
+ SC_TCL_GETHOSTBYADDR_R
fi
#---------------------------------------------------------------------------
@@ -301,6 +293,36 @@ if test $tcl_ok = no; then
AC_DEFINE(NO_FD_SET, 1, [Do we have fd_set?])
fi
+#------------------------------------------------------------------------
+# Options for the notifier. Checks for epoll(7) on Linux, and
+# kqueue(2) on {DragonFly,Free,Net,Open}BSD
+#------------------------------------------------------------------------
+
+AC_MSG_CHECKING([for advanced notifier support])
+case x`uname -s` in
+ xLinux)
+ AC_MSG_RESULT([epoll(7)])
+ AC_CHECK_HEADERS([sys/epoll.h],
+ [AC_DEFINE(NOTIFIER_EPOLL, [1], [Is epoll(7) supported?])])
+ AC_CHECK_HEADERS([sys/eventfd.h],
+ [AC_DEFINE(HAVE_EVENTFD, [1], [Is eventfd(2) supported?])]);;
+ xDragonFlyBSD|xFreeBSD|xNetBSD|xOpenBSD)
+ AC_MSG_RESULT([kqueue(2)])
+ # Messy because we want to check if *all* the headers are present, and not
+ # just *any*
+ tcl_kqueue_headers=x
+ AC_CHECK_HEADERS([sys/types.h sys/event.h sys/time.h],
+ [tcl_kqueue_headers=${tcl_kqueue_headers}y])
+ AS_IF([test $tcl_kqueue_headers = xyyy], [
+ AC_DEFINE(NOTIFIER_KQUEUE, [1], [Is kqueue(2) supported?])]);;
+ xDarwin)
+ # Assume that we've got CoreFoundation present (checked elsewhere because
+ # of wider impact).
+ AC_MSG_RESULT([OSX]);;
+ *)
+ AC_MSG_RESULT([none]);;
+esac
+
#------------------------------------------------------------------------------
# Find out all about time handling differences.
#------------------------------------------------------------------------------
@@ -741,6 +763,52 @@ fi
AC_MSG_RESULT([$tcl_ok])
#--------------------------------------------------------------------
+# Zipfs support - Tip 430
+#--------------------------------------------------------------------
+AC_ARG_ENABLE(zipfs,
+ AC_HELP_STRING([--enable-zipfs],
+ [build with Zipfs support (default: on)]),
+ [tcl_ok=$enableval], [tcl_ok=yes])
+if test "$tcl_ok" = "yes" ; then
+ #
+ # Find a native compiler
+ #
+ AX_CC_FOR_BUILD
+ #
+ # Find a native zip implementation
+ #
+ SC_ZIPFS_SUPPORT
+ ZIPFS_BUILD=1
+ TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+ ZIPFS_BUILD=0
+ TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+AC_MSG_CHECKING([for building with zipfs])
+if test "${ZIPFS_BUILD}" = 1; then
+ if test "${SHARED_BUILD}" = 0; then
+ ZIPFS_BUILD=2;
+ AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
+ INSTALL_LIBRARIES=install-libraries-zipfs-static
+ AC_MSG_RESULT([yes])
+ else
+ AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
+ INSTALL_LIBRARIES=install-libraries-zipfs-shared
+ AC_MSG_RESULT([yes])
+ fi
+else
+AC_MSG_RESULT([no])
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+AC_SUBST(ZIPFS_BUILD)
+AC_SUBST(TCL_ZIP_FILE)
+AC_SUBST(INSTALL_LIBRARIES)
+AC_SUBST(INSTALL_MSGS)
+
+
+#--------------------------------------------------------------------
# The check below checks whether the cpuid instruction is usable.
#--------------------------------------------------------------------
@@ -910,6 +978,7 @@ AC_SUBST(TCL_PATCH_LEVEL)
AC_SUBST(TCL_YEAR)
AC_SUBST(PKG_CFG_ARGS)
+AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
index c4d3f32..5bf3c1e 100644
--- a/unix/dltest/pkga.c
+++ b/unix/dltest/pkga.c
@@ -14,14 +14,6 @@
#include "tcl.h"
/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Pkga_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-/*
* Prototypes for procedures defined later in this file:
*/
@@ -124,14 +116,14 @@ Pkga_QuoteObjCmd(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkga_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "Pkga", "1.0");
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
index 557f21b..983fcf3 100644
--- a/unix/dltest/pkgc.c
+++ b/unix/dltest/pkgc.c
@@ -15,14 +15,6 @@
#include "tcl.h"
/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Pkgc_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-/*
* Prototypes for procedures defined later in this file:
*/
@@ -114,14 +106,14 @@ Pkgc_UnsafeObjCmd(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgc_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
@@ -151,14 +143,14 @@ Pkgc_Init(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgc_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
index 6e114e9..c708df0 100644
--- a/unix/dltest/pkgd.c
+++ b/unix/dltest/pkgd.c
@@ -15,14 +15,6 @@
#include "tcl.h"
/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Pkgd_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-/*
* Prototypes for procedures defined later in this file:
*/
@@ -114,14 +106,14 @@ Pkgd_UnsafeObjCmd(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgd_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
@@ -151,14 +143,14 @@ Pkgd_Init(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgd_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
int code;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
diff --git a/unix/dltest/pkge.c b/unix/dltest/pkge.c
index 395cd0e..f46ca74 100644
--- a/unix/dltest/pkge.c
+++ b/unix/dltest/pkge.c
@@ -13,15 +13,6 @@
#undef STATIC_BUILD
#include "tcl.h"
-
-/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Pkge_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
/*
*----------------------------------------------------------------------
@@ -40,14 +31,14 @@
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkge_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
static const char script[] = "if 44 {open non_existent}";
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
return Tcl_EvalEx(interp, script, -1, 0);
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index 78af376..5a0b0ef 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -96,7 +96,7 @@ Pkgooa_Init(
* This worked in Tcl 8.6.0, and is expected
* to keep working in all future Tcl 8.x releases.
*/
- if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
if (tclStubsPtr == NULL) {
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index 417bedb..9d5a9d9 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -11,18 +11,9 @@
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#undef STATIC_BUILD
#include "tcl.h"
/*
- * TCL_STORAGE_CLASS is set unconditionally to DLLEXPORT because the
- * Pkgua_Init declaration is in the source file itself, which is only
- * accessed when we are building a library.
- */
-#undef TCL_STORAGE_CLASS
-#define TCL_STORAGE_CLASS DLLEXPORT
-
-/*
* Prototypes for procedures defined later in this file:
*/
@@ -78,7 +69,7 @@ PkguaInterpToTokens(
int newEntry;
Tcl_Command *cmdTokens;
Tcl_HashEntry *entryPtr =
- Tcl_CreateHashEntry(&interpTokenMap, (char *) interp, &newEntry);
+ Tcl_CreateHashEntry(&interpTokenMap, interp, &newEntry);
if (newEntry) {
cmdTokens = (Tcl_Command *)
@@ -98,7 +89,7 @@ PkguaDeleteTokens(
Tcl_Interp *interp)
{
Tcl_HashEntry *entryPtr =
- Tcl_FindHashEntry(&interpTokenMap, (char *) interp);
+ Tcl_FindHashEntry(&interpTokenMap, interp);
if (entryPtr) {
Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
@@ -200,7 +191,7 @@ PkguaQuoteObjCmd(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -208,7 +199,7 @@ Pkgua_Init(
int code, cmdIndex = 0;
Tcl_Command *cmdTokens;
- if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
@@ -224,7 +215,7 @@ Pkgua_Init(
return code;
}
- Tcl_SetVar(interp, "::pkgua_loaded", ".", TCL_APPEND_VALUE);
+ Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
cmdTokens[cmdIndex++] =
@@ -253,7 +244,7 @@ Pkgua_Init(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgua_SafeInit(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
@@ -278,7 +269,7 @@ Pkgua_SafeInit(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgua_Unload(
Tcl_Interp *interp, /* Interpreter from which the package is to be
* unloaded. */
@@ -299,7 +290,7 @@ Pkgua_Unload(
PkguaDeleteTokens(interp);
- Tcl_SetVar(interp, "::pkgua_detached", ".", TCL_APPEND_VALUE);
+ Tcl_SetVar2(interp, "::pkgua_detached", NULL, ".", TCL_APPEND_VALUE);
if (flags == TCL_UNLOAD_DETACH_FROM_PROCESS) {
/*
@@ -309,7 +300,7 @@ Pkgua_Unload(
*/
PkguaFreeTokensHashTable();
- Tcl_SetVar(interp, "::pkgua_unloaded", ".", TCL_APPEND_VALUE);
+ Tcl_SetVar2(interp, "::pkgua_unloaded", NULL, ".", TCL_APPEND_VALUE);
}
return TCL_OK;
}
@@ -331,7 +322,7 @@ Pkgua_Unload(
*----------------------------------------------------------------------
*/
-EXTERN int
+DLLEXPORT int
Pkgua_SafeUnload(
Tcl_Interp *interp, /* Interpreter from which the package is to be
* unloaded. */
diff --git a/unix/installManPage b/unix/installManPage
index 1f1cbde..09a31dd 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -60,20 +60,35 @@ test -z "$SymOrLoc" && SymOrLoc="$Dir/"
#
Names=`sed -n '
# Look for a line that starts with .SH NAME
- /^\.SH NAME/{
-# Read next line
- n
-# Remove all commas ...
- s/,//g
-# ... and backslash-escaped spaces.
- s/\\\ //g
-# Delete from \- to the end of line
- s/ \\\-.*//
-# Convert all non-space non-alphanum sequences
-# to single underscores.
- s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
-# print the result and exit
- p;q
+ /^\.SH NAME/,/^\./{
+
+
+ /^\./!{
+
+ # Remove all commas...
+ s/,//g
+
+ # ... and backslash-escaped spaces.
+ s/\\\ //g
+
+ /\\\-.*/{
+ # Delete from \- to the end of line
+ s/ \\\-.*//
+ h
+ s/.*/./
+ x
+ }
+
+ # Convert all non-space non-alphanum sequences
+ # to single underscores.
+ s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
+ p
+ g
+ /^\./{
+ q
+ }
+ }
+
}' $ManPage`
if test -z "$Names" ; then
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index f091a6b..a206f26 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -96,8 +96,8 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
`ls -d /usr/pkg/lib 2>/dev/null` \
`ls -d /usr/lib 2>/dev/null` \
`ls -d /usr/lib64 2>/dev/null` \
- `ls -d /usr/local/lib/tcl8.6 2>/dev/null` \
- `ls -d /usr/local/lib/tcl/tcl8.6 2>/dev/null` \
+ `ls -d /usr/local/lib/tcl8.7 2>/dev/null` \
+ `ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \
; do
if test -f "$i/tclConfig.sh" ; then
ac_cv_c_tclconfig="`(cd $i; pwd)`"
@@ -229,8 +229,8 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
`ls -d /usr/pkg/lib 2>/dev/null` \
`ls -d /usr/lib 2>/dev/null` \
`ls -d /usr/lib64 2>/dev/null` \
- `ls -d /usr/local/lib/tk8.6 2>/dev/null` \
- `ls -d /usr/local/lib/tcl/tk8.6 2>/dev/null` \
+ `ls -d /usr/local/lib/tk8.7 2>/dev/null` \
+ `ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \
; do
if test -f "$i/tkConfig.sh" ; then
ac_cv_c_tkconfig="`(cd $i; pwd)`"
@@ -547,6 +547,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [
SHARED_BUILD=0
AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
fi
+ AC_SUBST(SHARED_BUILD)
])
#------------------------------------------------------------------------
@@ -598,113 +599,6 @@ AC_DEFUN([SC_ENABLE_FRAMEWORK], [
])
#------------------------------------------------------------------------
-# SC_ENABLE_THREADS --
-#
-# Specify if thread support should be enabled
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --enable-threads
-#
-# Sets the following vars:
-# THREADS_LIBS Thread library(s)
-#
-# Defines the following vars:
-# TCL_THREADS
-# _REENTRANT
-# _THREAD_SAFE
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_ENABLE_THREADS], [
- AC_ARG_ENABLE(threads,
- AC_HELP_STRING([--enable-threads],
- [build with threads (default: on)]),
- [tcl_ok=$enableval], [tcl_ok=yes])
-
- if test "${TCL_THREADS}" = 1; then
- tcl_threaded_core=1;
- fi
-
- if test "$tcl_ok" = "yes" -o "${TCL_THREADS}" = 1; then
- TCL_THREADS=1
- # USE_THREAD_ALLOC tells us to try the special thread-based
- # allocator that significantly reduces lock contention
- AC_DEFINE(USE_THREAD_ALLOC, 1,
- [Do we want to use the threaded memory allocator?])
- AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
- if test "`uname -s`" = "SunOS" ; then
- AC_DEFINE(_POSIX_PTHREAD_SEMANTICS, 1,
- [Do we really want to follow the standard? Yes we do!])
- fi
- AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?])
- AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
- if test "$tcl_ok" = "no"; then
- # Check a little harder for __pthread_mutex_init in the same
- # library, as some systems hide it there until pthread.h is
- # defined. We could alternatively do an AC_TRY_COMPILE with
- # pthread.h, but that will work with libpthread really doesn't
- # exist, like AIX 4.2. [Bug: 4359]
- AC_CHECK_LIB(pthread, __pthread_mutex_init,
- tcl_ok=yes, tcl_ok=no)
- fi
-
- if test "$tcl_ok" = "yes"; then
- # The space is needed
- THREADS_LIBS=" -lpthread"
- else
- AC_CHECK_LIB(pthreads, pthread_mutex_init,
- tcl_ok=yes, tcl_ok=no)
- if test "$tcl_ok" = "yes"; then
- # The space is needed
- THREADS_LIBS=" -lpthreads"
- else
- AC_CHECK_LIB(c, pthread_mutex_init,
- tcl_ok=yes, tcl_ok=no)
- if test "$tcl_ok" = "no"; then
- 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
-
- # Does the pthread-implementation provide
- # 'pthread_attr_setstacksize' ?
-
- ac_saved_libs=$LIBS
- LIBS="$LIBS $THREADS_LIBS"
- AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
- LIBS=$ac_saved_libs
- else
- TCL_THREADS=0
- fi
- # Do checking message here to not mess up interleaved configure output
- AC_MSG_CHECKING([for building with threads])
- if test "${TCL_THREADS}" = 1; then
- AC_DEFINE(TCL_THREADS, 1, [Are we building with threads enabled?])
- if test "${tcl_threaded_core}" = 1; then
- AC_MSG_RESULT([yes (threaded core)])
- else
- AC_MSG_RESULT([yes])
- fi
- else
- AC_MSG_RESULT([no])
- fi
-
- AC_SUBST(TCL_THREADS)
-])
-
-#------------------------------------------------------------------------
# SC_ENABLE_SYMBOLS --
#
# Specify if debugging symbols should be used.
@@ -896,8 +790,7 @@ AC_DEFUN([SC_CONFIG_MANPAGES], [
#
# Determine what the system is (some things cannot be easily checked
# on a feature-driven basis, alas). This can usually be done via the
-# "uname" command, but there are a few systems, like Next, where
-# this doesn't work.
+# "uname" command.
#
# Arguments:
# none
@@ -906,25 +799,18 @@ AC_DEFUN([SC_CONFIG_MANPAGES], [
# Defines the following var:
#
# system - System/platform/version identification code.
-#
#--------------------------------------------------------------------
AC_DEFUN([SC_CONFIG_SYSTEM], [
AC_CACHE_CHECK([system version], tcl_cv_sys_version, [
- if test -f /usr/lib/NextStep/software_version; then
- tcl_cv_sys_version=NEXTSTEP-`awk '/3/,/3/' /usr/lib/NextStep/software_version`
+ if test "${TEA_PLATFORM}" = "windows" ; then
+ tcl_cv_sys_version=windows
else
tcl_cv_sys_version=`uname -s`-`uname -r`
if test "$?" -ne 0 ; then
AC_MSG_WARN([can't find uname command])
tcl_cv_sys_version=unknown
else
- # Special check for weird MP-RAS system (uname returns weird
- # results, and the version is kept in special file).
-
- if test -r /etc/.relid -a "X`uname -n`" = "X`uname -s`" ; then
- tcl_cv_sys_version=MP-RAS-`awk '{print $[3]}' /etc/.relid`
- fi
if test "`uname -s`" = "AIX" ; then
tcl_cv_sys_version=AIX-`uname -v`.`uname -r`
fi
@@ -984,8 +870,8 @@ AC_DEFUN([SC_CONFIG_SYSTEM], [
# shared libraries. The value of the symbol defaults to
# "${LIBS}" if all of the dependent libraries should
# be specified when creating a shared library. If
-# dependent libraries should not be specified (as on
-# SunOS 4.x, where they cause the link to fail, or in
+# dependent libraries should not be specified (as on some
+# SunOS systems, where they cause the link to fail, or in
# general if Tcl and Tk aren't themselves shared
# libraries), then this symbol has an empty string
# as its value.
@@ -1100,7 +986,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CFLAGS_DEBUG=-g
AS_IF([test "$GCC" = yes], [
CFLAGS_OPTIMIZE=-O2
- CFLAGS_WARNING="-Wall"
+ CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
], [
CFLAGS_OPTIMIZE=-O
CFLAGS_WARNING=""
@@ -1111,10 +997,10 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
PLAT_OBJS=""
PLAT_SRCS=""
LDAIX_SRC=""
- AS_IF([test "x${SHLIB_VERSION}" = x],[SHLIB_VERSION=".1.0"],[SHLIB_VERSION=".${SHLIB_VERSION}"])
+ AS_IF([test "x${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
case $system in
AIX-*)
- AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [
+ AS_IF([test "$GCC" != "yes"], [
# AIX requires the _r compiler when gcc isn't being used
case "${CC}" in
*_r|*_r\ *)
@@ -1209,7 +1095,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- CYGWIN_*|MINGW32*)
+ CYGWIN_*)
SHLIB_CFLAGS=""
SHLIB_LD='${CC} -shared'
SHLIB_SUFFIX=".dll"
@@ -1235,9 +1121,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
if test "$ac_cv_cygwin" = "no"; then
AC_MSG_ERROR([${CC} is not a cygwin compiler.])
fi
- if test "x${TCL_THREADS}" = "x0"; then
- AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
- fi
do64bit_ok=yes
if test "x${SHARED_BUILD}" = "x1"; then
echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
@@ -1447,27 +1330,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
;;
- MP-RAS-02*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD='${CC} -G'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- MP-RAS-*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD='${CC} -G'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- LDFLAGS="$LDFLAGS -Wl,-Bexport"
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
OpenBSD-*)
arch=`arch -s`
case "$arch" in
@@ -1485,15 +1347,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}'
+ SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
LDFLAGS="-Wl,-export-dynamic"
CFLAGS_OPTIMIZE="-O2"
- AS_IF([test "${TCL_THREADS}" = "1"], [
- # On OpenBSD: Compile with -pthread
- # Don't link with -lpthread
- LIBS=`echo $LIBS | sed s/-lpthread//`
- CFLAGS="$CFLAGS -pthread"
- ])
+ # On OpenBSD: Compile with -pthread
+ # Don't link with -lpthread
+ LIBS=`echo $LIBS | sed s/-lpthread//`
+ CFLAGS="$CFLAGS -pthread"
# OpenBSD doesn't do version numbers with dots.
UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
TCL_LIB_VERSIONS_OK=nodots
@@ -1509,12 +1369,10 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
- AS_IF([test "${TCL_THREADS}" = "1"], [
- # The -pthread needs to go in the CFLAGS, not LIBS
- LIBS=`echo $LIBS | sed s/-pthread//`
- CFLAGS="$CFLAGS -pthread"
- LDFLAGS="$LDFLAGS -pthread"
- ])
+ # The -pthread needs to go in the CFLAGS, not LIBS
+ LIBS=`echo $LIBS | sed s/-pthread//`
+ CFLAGS="$CFLAGS -pthread"
+ LDFLAGS="$LDFLAGS -pthread"
;;
DragonFly-*|FreeBSD-*)
# This configuration from FreeBSD Ports.
@@ -1528,11 +1386,10 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AS_IF([test $doRpath = yes], [
CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
- AS_IF([test "${TCL_THREADS}" = "1"], [
- # The -pthread needs to go in the LDFLAGS, not LIBS
- LIBS=`echo $LIBS | sed s/-pthread//`
- CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
- LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
+ # The -pthread needs to go in the LDFLAGS, not LIBS
+ LIBS=`echo $LIBS | sed s/-pthread//`
+ CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
+ LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
case $system in
FreeBSD-3.*)
# Version numbers are dot-stripped by system policy.
@@ -1677,47 +1534,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
])
])
;;
- NEXTSTEP-*)
- SHLIB_CFLAGS=""
- SHLIB_LD='${CC} -nostdlib -r'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadNext.o"
- DL_LIBS=""
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
OS/390-*)
SHLIB_LD_LIBS=""
CFLAGS_OPTIMIZE="" # Optimizer is buggy
AC_DEFINE(_OE_SOCKETS, 1, # needed in sys/socket.h
[Should OS/390 do the right thing with sockets?])
;;
- OSF1-1.0|OSF1-1.1|OSF1-1.2)
- # OSF/1 1.[012] from OSF, and derivatives, including Paragon OSF/1
- SHLIB_CFLAGS=""
- # Hack: make package name same as library name
- SHLIB_LD='ld -R -export $@:'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadOSF.o"
- DL_LIBS=""
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- OSF1-1.*)
- # OSF/1 1.3 from OSF using ELF, and derivatives, including AD2
- SHLIB_CFLAGS="-fPIC"
- AS_IF([test "$SHARED_BUILD" = 1], [SHLIB_LD="ld -shared"], [
- SHLIB_LD="ld -non_shared"
- ])
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS=""
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
OSF1-V*)
# Digital OSF/1
SHLIB_CFLAGS=""
@@ -1735,16 +1557,14 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [
CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"])
# see pthread_intro(3) for pthread support on osf1, k.furukawa
- AS_IF([test "${TCL_THREADS}" = 1], [
- CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
- CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
- LIBS=`echo $LIBS | sed s/-lpthreads//`
- AS_IF([test "$GCC" = yes], [
- LIBS="$LIBS -lpthread -lmach -lexc"
- ], [
- CFLAGS="$CFLAGS -pthread"
- LDFLAGS="$LDFLAGS -pthread"
- ])
+ CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
+ CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
+ LIBS=`echo $LIBS | sed s/-lpthreads//`
+ AS_IF([test "$GCC" = yes], [
+ LIBS="$LIBS -lpthread -lmach -lexc"
+ ], [
+ CFLAGS="$CFLAGS -pthread"
+ LDFLAGS="$LDFLAGS -pthread"
])
;;
QNX-6*)
@@ -1779,35 +1599,6 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CC_SEARCH_FLAGS=""
LD_SEARCH_FLAGS=""
;;
- SINIX*5.4*)
- SHLIB_CFLAGS="-K PIC"
- SHLIB_LD='${CC} -G'
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- CC_SEARCH_FLAGS=""
- LD_SEARCH_FLAGS=""
- ;;
- SunOS-4*)
- SHLIB_CFLAGS="-PIC"
- SHLIB_LD="ld"
- SHLIB_LD_LIBS=""
- SHLIB_SUFFIX=".so"
- DL_OBJS="tclLoadDl.o"
- DL_LIBS="-ldl"
- 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
- # requires an extra version number at the end of .so file names.
- # So, the library has to have a name like libtcl75.so.1.0
-
- SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so${SHLIB_VERSION}'
- UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
- TCL_LIB_VERSIONS_OK=nodots
- ;;
SunOS-5.[[0-6]])
# Careful to not let 5.10+ fall into this case
@@ -2006,7 +1797,7 @@ dnl # preprocessing tests use only CPPFLAGS.
case $system in
AIX-*) ;;
BSD/OS*) ;;
- CYGWIN_*|MINGW32_*) ;;
+ CYGWIN_*) ;;
IRIX*) ;;
NetBSD-*|DragonFly-*|FreeBSD-*|OpenBSD-*) ;;
Darwin-*) ;;
@@ -2134,7 +1925,6 @@ dnl # preprocessing tests use only CPPFLAGS.
#
# Defines some of the following vars:
# NO_DIRENT_H
-# NO_VALUES_H
# NO_STDLIB_H
# NO_STRING_H
# NO_SYS_WAIT_H
@@ -2172,8 +1962,6 @@ closedir(d);
AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
fi
- AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have <float.h>?])])
- AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.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)
@@ -2316,10 +2104,6 @@ AC_DEFUN([SC_BLOCKING_STYLE], [
AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?])
AC_MSG_RESULT([FIONBIO])
;;
- SunOS-4*)
- AC_DEFINE(USE_FIONBIO, 1, [Should we use FIONBIO?])
- AC_MSG_RESULT([FIONBIO])
- ;;
*)
AC_MSG_RESULT([O_NONBLOCK])
;;
@@ -2398,13 +2182,20 @@ AC_DEFUN([SC_TIME_HANDLER], [
#
# Search for the libraries needed to link the Tcl shell.
# Things like the math library (-lm) and socket stuff (-lsocket vs.
-# -lnsl) are dealt with here.
+# -lnsl) or thread library (-lpthread) are dealt with here.
#
# Arguments:
# None.
#
# Results:
#
+# Sets the following vars:
+# THREADS_LIBS Thread library(s)
+#
+# Defines the following vars:
+# _REENTRANT
+# _THREAD_SAFE
+#
# Might append to the following vars:
# LIBS
# MATH_LIBS
@@ -2462,6 +2253,55 @@ AC_DEFUN([SC_TCL_LINK_LIBS], [
fi
AC_CHECK_FUNC(gethostbyname, , [AC_CHECK_LIB(nsl, gethostbyname,
[LIBS="$LIBS -lnsl"])])
+
+ AC_DEFINE(_REENTRANT, 1, [Do we want the reentrant OS API?])
+ AC_DEFINE(_THREAD_SAFE, 1, [Do we want the thread-safe OS API?])
+ AC_CHECK_LIB(pthread,pthread_mutex_init,tcl_ok=yes,tcl_ok=no)
+ if test "$tcl_ok" = "no"; then
+ # Check a little harder for __pthread_mutex_init in the same
+ # library, as some systems hide it there until pthread.h is
+ # defined. We could alternatively do an AC_TRY_COMPILE with
+ # pthread.h, but that will work with libpthread really doesn't
+ # exist, like AIX 4.2. [Bug: 4359]
+ AC_CHECK_LIB(pthread, __pthread_mutex_init,
+ tcl_ok=yes, tcl_ok=no)
+ fi
+
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthread"
+ else
+ AC_CHECK_LIB(pthreads, pthread_mutex_init,
+ _ok=yes, tcl_ok=no)
+ if test "$tcl_ok" = "yes"; then
+ # The space is needed
+ THREADS_LIBS=" -lpthreads"
+ else
+ AC_CHECK_LIB(c, pthread_mutex_init,
+ tcl_ok=yes, tcl_ok=no)
+ if test "$tcl_ok" = "no"; then
+ 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
+ AC_MSG_WARN([Don't know how to find pthread lib on your system - you must edit the LIBS in the Makefile...])
+ fi
+ fi
+ fi
+ fi
+
+ # Does the pthread-implementation provide
+ # 'pthread_attr_setstacksize' ?
+
+ ac_saved_libs=$LIBS
+ LIBS="$LIBS $THREADS_LIBS"
+ AC_CHECK_FUNCS(pthread_attr_setstacksize pthread_atfork)
+ LIBS=$ac_saved_libs
+
+ # TIP #509
+ AC_CHECK_DECLS([PTHREAD_MUTEX_RECURSIVE],tcl_ok=yes,tcl_ok=no, [[#include <pthread.h>]])
])
#--------------------------------------------------------------------
@@ -2537,15 +2377,15 @@ AC_DEFUN([SC_TCL_64BIT_FLAGS], [
# See if the compiler knows natively about __int64
AC_TRY_COMPILE(,[__int64 value = (__int64) 0;],
tcl_type_64bit=__int64, tcl_type_64bit="long long")
- # See if we should use long anyway Note that we substitute in the
+ # See if we could use long anyway Note that we substitute in the
# type that is our current guess for a 64-bit type inside this check
# program, so it should be modified only carefully...
AC_TRY_COMPILE(,[switch (0) {
case 1: case (sizeof(]${tcl_type_64bit}[)==sizeof(long)): ;
}],tcl_cv_type_64bit=${tcl_type_64bit})])
if test "${tcl_cv_type_64bit}" = none ; then
- AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Are wide integers to be implemented with C 'long's?])
- AC_MSG_RESULT([using long])
+ AC_DEFINE(TCL_WIDE_INT_IS_LONG, 1, [Do 'long' and 'long long' have the same size (64-bit)?])
+ AC_MSG_RESULT([yes])
else
AC_DEFINE_UNQUOTED(TCL_WIDE_INT_TYPE,${tcl_cv_type_64bit},
[What type should be used to define wide integers?])
@@ -3065,6 +2905,129 @@ if test "x$NEED_FAKE_RFC2553" = "x1"; then
AC_CHECK_FUNC(strlcpy)
fi
])
+
+#------------------------------------------------------------------------
+# SC_CC_FOR_BUILD
+# For cross compiles, locate a C compiler that can generate native binaries.
+#
+# Arguments:
+# none
+#
+# Results:
+# Substitutes the following vars:
+# CC_FOR_BUILD
+# EXEEXT_FOR_BUILD
+#------------------------------------------------------------------------
+
+dnl Get a default for CC_FOR_BUILD to put into Makefile.
+AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile.
+ if test -z "$CC_FOR_BUILD"; then
+ if test "x$cross_compiling" = "xno"; then
+ CC_FOR_BUILD='$(CC)'
+ else
+ AC_MSG_CHECKING([for gcc])
+ AC_CACHE_VAL(ac_cv_path_cc, [
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/gcc 2> /dev/null` \
+ `ls -r $dir/gcc 2> /dev/null` ; do
+ if test x"$ac_cv_path_cc" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_cc=$j
+ break
+ fi
+ fi
+ done
+ done
+ ])
+ fi
+ fi
+ AC_SUBST(CC_FOR_BUILD)
+ # Also set EXEEXT_FOR_BUILD.
+ if test "x$cross_compiling" = "xno"; then
+ EXEEXT_FOR_BUILD='$(EXEEXT)'
+ OBJEXT_FOR_BUILD='$(OBJEXT)'
+ else
+ OBJEXT_FOR_BUILD='.no'
+ AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
+ [rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.c
+ bfd_cv_build_exeext=
+ ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ rm -f conftest*
+ test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
+ EXEEXT_FOR_BUILD=""
+ test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+ fi
+ AC_SUBST(EXEEXT_FOR_BUILD)])dnl
+ AC_SUBST(OBJEXT_FOR_BUILD)])dnl
+])
+
+
+#------------------------------------------------------------------------
+# SC_ZIPFS_SUPPORT
+# Locate a zip encoder installed on the system path, or none.
+#
+# Arguments:
+# none
+#
+# Results:
+# Substitutes the following vars:
+# ZIP_PROG
+# ZIP_PROG_OPTIONS
+# ZIP_PROG_VFSSEARCH
+# ZIP_INSTALL_OBJS
+#------------------------------------------------------------------------
+
+AC_DEFUN([SC_ZIPFS_SUPPORT], [
+ ZIP_PROG=""
+ ZIP_PROG_OPTIONS=""
+ ZIP_PROG_VFSSEARCH=""
+ ZIP_INSTALL_OBJS=""
+
+ AC_MSG_CHECKING([for zip])
+ AC_CACHE_VAL(ac_cv_path_zip, [
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/zip 2> /dev/null` \
+ `ls -r $dir/zip 2> /dev/null` ; do
+ if test x"$ac_cv_path_zip" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_zip=$j
+ break
+ fi
+ fi
+ done
+ done
+ ])
+ if test -f "$ac_cv_path_zip" ; then
+ ZIP_PROG="$ac_cv_path_zip"
+ AC_MSG_RESULT([$ZIP_PROG])
+ ZIP_PROG_OPTIONS="-rq"
+ ZIP_PROG_VFSSEARCH="*"
+ AC_MSG_RESULT([Found INFO Zip in environment])
+ # Use standard arguments for zip
+ else
+ # It is not an error if an installed version of Zip can't be located.
+ # We can use the locally distributed minizip instead
+ ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
+ ZIP_PROG_OPTIONS="-o -r"
+ ZIP_PROG_VFSSEARCH="*"
+ ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+ AC_MSG_RESULT([No zip found on PATH. Building minizip])
+ fi
+ AC_SUBST(ZIP_PROG)
+ AC_SUBST(ZIP_PROG_OPTIONS)
+ AC_SUBST(ZIP_PROG_VFSSEARCH)
+ AC_SUBST(ZIP_INSTALL_OBJS)
+])
+
# Local Variables:
# mode: autoconf
# End:
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index 846cb11..ca932d2 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -4,6 +4,8 @@ prefix=@prefix@
exec_prefix=@exec_prefix@
libdir=@libdir@
includedir=@includedir@
+libfile=@TCL_LIB_FILE@
+zipfile=@TCL_ZIP_FILE@
Name: Tool Command Language
Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
diff --git a/unix/tcl.spec b/unix/tcl.spec
index cc36790..265e4df 100644
--- a/unix/tcl.spec
+++ b/unix/tcl.spec
@@ -4,7 +4,7 @@
Name: tcl
Summary: Tcl scripting language development environment
-Version: 8.6.9
+Version: 8.7a2
Release: 2
License: BSD
Group: Development/Languages
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 9bbc88b..3587f35 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -79,6 +79,8 @@ main(
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#else
+ TclZipfs_AppHook(&argc, &argv);
#endif
Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index a26a48f..e626049 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -298,9 +298,6 @@
/* Do we have fd_set? */
#undef NO_FD_SET
-/* Do we have <float.h>? */
-#undef NO_FLOAT_H
-
/* Do we have fstatfs()? */
#undef NO_FSTATFS
@@ -337,9 +334,6 @@
/* Do we have a usable 'union wait'? */
#undef NO_UNION_WAIT
-/* Do we have <values.h>? */
-#undef NO_VALUES_H
-
/* Do we have wait3() */
#undef NO_WAIT3
@@ -394,19 +388,13 @@
/* What is the default extension for shared libraries? */
#undef TCL_SHLIB_EXT
-/* Are we building with threads enabled? */
-#undef TCL_THREADS
-
-/* Build libtommath? */
-#undef TCL_TOMMATH
-
/* Do we allow unloading of shared libraries? */
#undef TCL_UNLOAD_DLLS
/* Does this platform have wide high-resolution clicks? */
#undef TCL_WIDE_CLICKS
-/* Are wide integers to be implemented with C 'long's? */
+/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */
#undef TCL_WIDE_INT_IS_LONG
/* What type should be used to define wide integers? */
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index f768690..743b5a5 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -39,6 +39,9 @@ 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 name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
+TCL_ZIP_FILE='@TCL_ZIP_FILE@'
+
# Additional libraries to use when linking Tcl.
TCL_LIBS='@TCL_LIBS@'
@@ -66,7 +69,7 @@ TCL_SHLIB_LD='@SHLIB_LD@'
TCL_STLIB_LD='@STLIB_LD@'
# Either '$LIBS' (if dependent libraries should be included when linking
-# shared libraries) or an empty string. See Tcl's configure.in for more
+# shared libraries) or an empty string. See Tcl's configure.ac for more
# explanation.
TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
@@ -164,6 +167,3 @@ 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@'
-
-# Flag, 1: we built Tcl with threads enabled, 0 we didn't
-TCL_THREADS=@TCL_THREADS@
diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c
new file mode 100644
index 0000000..4961ef5
--- /dev/null
+++ b/unix/tclEpollNotfy.c
@@ -0,0 +1,835 @@
+/*
+ * tclEpollNotfy.c --
+ *
+ * This file contains the implementation of the epoll()-based
+ * Linux-specific notifier, which is the lowest-level part of the Tcl
+ * event loop. This file works together with generic/tclNotify.c.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
+ * in tclMacOSXNotify.c */
+#if defined(NOTIFIER_EPOLL) && TCL_THREADS
+#define _GNU_SOURCE /* For pipe2(2) */
+#include <fcntl.h>
+#include <signal.h>
+#include <sys/epoll.h>
+#ifdef HAVE_EVENTFD
+#include <sys/eventfd.h>
+#endif /* HAVE_EVENTFD */
+#include <sys/queue.h>
+
+/*
+ * This structure is used to keep track of the notifier info for a registered
+ * file.
+ */
+
+struct PlatformEventData;
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE,
+ * etc. */
+ int readyMask; /* Mask of events that have been seen since
+ * the last time file handlers were invoked
+ * for this file. */
+ Tcl_FileProc *proc; /* Function to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+ LIST_ENTRY(FileHandler) readyNode;
+ /* Next/previous in list of FileHandlers asso-
+ * ciated with regular files (S_IFREG) that are
+ * ready for I/O. */
+ struct PlatformEventData *pedPtr;
+ /* Pointer to PlatformEventData associating this
+ * FileHandler with epoll(7) events. */
+} FileHandler;
+
+/*
+ * The following structure associates a FileHandler and the thread that owns
+ * it with the file descriptors of interest and their event masks passed to
+ * epoll_ctl(2) and their corresponding event(s) returned by epoll_wait(2).
+ */
+
+struct ThreadSpecificData;
+struct PlatformEventData {
+ FileHandler *filePtr;
+ struct ThreadSpecificData *tsdPtr;
+};
+
+/*
+ * The following structure is what is added to the Tcl event queue when file
+ * handlers are ready to fire.
+ */
+
+typedef struct {
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ int fd; /* File descriptor that is ready. Used to find
+ * the FileHandler structure for the file
+ * (can't point directly to the FileHandler
+ * structure because it could go away while
+ * the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * epoll based implementation of the Tcl notifier. One of these structures is
+ * created for each thread that is using the notifier.
+ */
+
+LIST_HEAD(PlatformReadyFileHandlerList, FileHandler);
+typedef struct ThreadSpecificData {
+ FileHandler *triggerFilePtr;
+ FileHandler *firstFileHandlerPtr;
+ /* Pointer to head of file handler list. */
+ struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
+ /* Pointer to head of list of FileHandlers
+ * associated with regular files (S_IFREG)
+ * that are ready for I/O. */
+ pthread_mutex_t notifierMutex;
+ /* Mutex protecting notifier termination in
+ * PlatformEventsFinalize. */
+#ifdef HAVE_EVENTFD
+ int triggerEventFd; /* eventfd(2) used by other threads to wake
+ * up this thread for inter-thread IPC. */
+#else
+ int triggerPipe[2]; /* pipe(2) used by other threads to wake
+ * up this thread for inter-thread IPC. */
+#endif /* HAVE_EVENTFD */
+ int eventsFd; /* epoll(7) file descriptor used to wait for
+ * fds */
+ struct epoll_event *readyEvents;
+ /* Pointer to at most maxReadyEvents events
+ * returned by epoll_wait(2). */
+ size_t maxReadyEvents; /* Count of epoll_events in readyEvents. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations.
+ */
+
+static void PlatformEventsControl(FileHandler *filePtr,
+ ThreadSpecificData *tsdPtr, int op, int isNew);
+static void PlatformEventsFinalize(void);
+static void PlatformEventsInit(void);
+static int PlatformEventsTranslate(struct epoll_event *event);
+static int PlatformEventsWait(struct epoll_event *events,
+ size_t numEvents, struct timeval *timePtr);
+
+/*
+ * Incorporate the base notifier API.
+ */
+
+#include "tclUnixNotfy.c"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitNotifier --
+ *
+ * Initializes the platform specific notifier state.
+ *
+ * Results:
+ * Returns a handle to the notifier state for this thread.
+ *
+ * Side effects:
+ * If no initNotifierProc notifier hook exists, PlatformEventsInit
+ * is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_InitNotifier(void)
+{
+ if (tclNotifierHooks.initNotifierProc) {
+ return tclNotifierHooks.initNotifierProc();
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ PlatformEventsInit();
+ return tsdPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ * This function is called to cleanup the notifier state before a thread
+ * is terminated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If no finalizeNotifierProc notifier hook exists, PlatformEvents-
+ * Finalize is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeNotifier(
+ ClientData clientData) /* Not used. */
+{
+ if (tclNotifierHooks.finalizeNotifierProc) {
+ tclNotifierHooks.finalizeNotifierProc(clientData);
+ return;
+ } else {
+ PlatformEventsFinalize();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsControl --
+ *
+ * This function registers interest for the file descriptor and the mask
+ * of TCL_* bits associated with filePtr on the epoll file descriptor
+ * associated with tsdPtr.
+ *
+ * Future calls to epoll_wait will return filePtr and tsdPtr alongside
+ * with the event registered here via the PlatformEventData struct.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * - If adding a new file descriptor, a PlatformEventData struct will be
+ * allocated and associated with filePtr.
+ * - fstat is called on the file descriptor; if it is associated with a
+ * regular file (S_IFREG,) filePtr is considered to be ready for I/O
+ * and added to or deleted from the corresponding list in tsdPtr.
+ * - If it is not associated with a regular file, the file descriptor is
+ * added, modified concerning its mask of events of interest, or
+ * deleted from the epoll file descriptor of the calling thread.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PlatformEventsControl(
+ FileHandler *filePtr,
+ ThreadSpecificData *tsdPtr,
+ int op,
+ int isNew)
+{
+ struct epoll_event newEvent;
+ struct PlatformEventData *newPedPtr;
+ struct stat fdStat;
+
+ newEvent.events = 0;
+ if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
+ newEvent.events |= EPOLLIN;
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ newEvent.events |= EPOLLOUT;
+ }
+ if (isNew) {
+ newPedPtr = ckalloc(sizeof(*newPedPtr));
+ newPedPtr->filePtr = filePtr;
+ newPedPtr->tsdPtr = tsdPtr;
+ filePtr->pedPtr = newPedPtr;
+ }
+ newEvent.data.ptr = filePtr->pedPtr;
+
+ /*
+ * N.B. As discussed in Tcl_WaitForEvent(), epoll(7) does not support
+ * regular files (S_IFREG.) Therefore, filePtr is in these cases simply
+ * added or deleted from the list of FileHandlers associated with regular
+ * files belonging to tsdPtr.
+ */
+
+ if (fstat(filePtr->fd, &fdStat) == -1) {
+ Tcl_Panic("fstat: %s", strerror(errno));
+ } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) {
+ switch (op) {
+ case EPOLL_CTL_ADD:
+ if (isNew) {
+ LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
+ readyNode);
+ }
+ break;
+ case EPOLL_CTL_DEL:
+ LIST_REMOVE(filePtr, readyNode);
+ break;
+ }
+ return;
+ } else if (epoll_ctl(tsdPtr->eventsFd, op, filePtr->fd, &newEvent) == -1) {
+ Tcl_Panic("epoll_ctl: %s", strerror(errno));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsFinalize --
+ *
+ * This function closes the eventfd and the epoll file descriptor and
+ * frees the epoll_event structs owned by the thread of the caller. The
+ * above operations are protected by tsdPtr->notifierMutex, which is
+ * destroyed thereafter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * While tsdPtr->notifierMutex is held:
+ * - The per-thread eventfd(2) is closed, if non-zero, and set to -1.
+ * - The per-thread epoll(7) fd is closed, if non-zero, and set to 0.
+ * - The per-thread epoll_event structs are freed, if any, and set to 0.
+ *
+ * tsdPtr->notifierMutex is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PlatformEventsFinalize(
+ void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ pthread_mutex_lock(&tsdPtr->notifierMutex);
+#ifdef HAVE_EVENTFD
+ if (tsdPtr->triggerEventFd) {
+ close(tsdPtr->triggerEventFd);
+ tsdPtr->triggerEventFd = -1;
+ }
+#else /* !HAVE_EVENTFD */
+ if (tsdPtr->triggerPipe[0]) {
+ close(tsdPtr->triggerPipe[0]);
+ tsdPtr->triggerPipe[0] = -1;
+ }
+ if (tsdPtr->triggerPipe[1]) {
+ close(tsdPtr->triggerPipe[1]);
+ tsdPtr->triggerPipe[1] = -1;
+ }
+#endif /* HAVE_EVENTFD */
+ ckfree(tsdPtr->triggerFilePtr->pedPtr);
+ ckfree(tsdPtr->triggerFilePtr);
+ if (tsdPtr->eventsFd > 0) {
+ close(tsdPtr->eventsFd);
+ tsdPtr->eventsFd = 0;
+ }
+ if (tsdPtr->readyEvents) {
+ ckfree(tsdPtr->readyEvents);
+ tsdPtr->maxReadyEvents = 0;
+ }
+ pthread_mutex_unlock(&tsdPtr->notifierMutex);
+ if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
+ Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsInit --
+ *
+ * This function abstracts creating a kqueue fd via the epoll_create
+ * system call and allocating memory for the epoll_event structs in
+ * tsdPtr for the thread of the caller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The following per-thread entities are initialised:
+ * - notifierMutex is initialised.
+ * - The eventfd(2) is created w/ EFD_CLOEXEC and EFD_NONBLOCK.
+ * - The epoll(7) fd is created w/ EPOLL_CLOEXEC.
+ * - A FileHandler struct is allocated and initialised for the
+ * eventfd(2), registering interest for TCL_READABLE on it via
+ * PlatformEventsControl().
+ * - readyEvents and maxReadyEvents are initialised with 512
+ * epoll_events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PlatformEventsInit(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ FileHandler *filePtr;
+
+ errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
+ if (errno) {
+ Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
+ }
+ filePtr = ckalloc(sizeof(*filePtr));
+#ifdef HAVE_EVENTFD
+ tsdPtr->triggerEventFd = eventfd(0, EFD_CLOEXEC | EFD_NONBLOCK);
+ if (tsdPtr->triggerEventFd <= 0) {
+ Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger eventfd");
+ }
+ filePtr->fd = tsdPtr->triggerEventFd;
+#else /* !HAVE_EVENTFD */
+ if (pipe2(tsdPtr->triggerPipe, O_CLOEXEC | O_NONBLOCK) != 0) {
+ Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
+ }
+ filePtr->fd = tsdPtr->triggerPipe[0];
+#endif /* HAVE_EVENTFD */
+ tsdPtr->triggerFilePtr = filePtr;
+ if ((tsdPtr->eventsFd = epoll_create1(EPOLL_CLOEXEC)) == -1) {
+ Tcl_Panic("epoll_create1: %s", strerror(errno));
+ }
+ filePtr->mask = TCL_READABLE;
+ PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_ADD, 1);
+ if (!tsdPtr->readyEvents) {
+ tsdPtr->maxReadyEvents = 512;
+ tsdPtr->readyEvents = ckalloc(
+ tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
+ }
+ LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsTranslate --
+ *
+ * This function translates the platform-specific mask of returned events
+ * in eventPtr to a mask of TCL_* bits.
+ *
+ * Results:
+ * Returns the translated mask.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+PlatformEventsTranslate(
+ struct epoll_event *eventPtr)
+{
+ int mask;
+
+ mask = 0;
+ if (eventPtr->events & (EPOLLIN | EPOLLHUP)) {
+ mask |= TCL_READABLE;
+ }
+ if (eventPtr->events & EPOLLOUT) {
+ mask |= TCL_WRITABLE;
+ }
+ if (eventPtr->events & EPOLLERR) {
+ mask |= TCL_EXCEPTION;
+ }
+ return mask;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsWait --
+ *
+ * This function abstracts waiting for I/O events via epoll_wait.
+ *
+ * Results:
+ * Returns -1 if epoll_wait failed. Returns 0 if polling and if no events
+ * became available whilst polling. Returns a pointer to and the count of
+ * all returned events in all other cases.
+ *
+ * Side effects:
+ * gettimeofday(2), epoll_wait(2), and gettimeofday(2) are called, in the
+ * specified order.
+ * If timePtr specifies a positive value, it is updated to reflect the
+ * amount of time that has passed; if its value would {under, over}flow,
+ * it is set to zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+PlatformEventsWait(
+ struct epoll_event *events,
+ size_t numEvents,
+ struct timeval *timePtr)
+{
+ int numFound;
+ struct timeval tv0, tv1, tv_delta;
+ int timeout;
+
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * If timePtr is NULL, epoll_wait(2) will wait indefinitely. If it
+ * specifies a timeout of {0,0}, epoll_wait(2) will poll. Otherwise, the
+ * timeout will simply be converted to milliseconds.
+ */
+
+ if (!timePtr) {
+ timeout = -1;
+ } else if (!timePtr->tv_sec && !timePtr->tv_usec) {
+ timeout = 0;
+ } else {
+ timeout = (int)timePtr->tv_sec * 1000;
+ if (timePtr->tv_usec) {
+ timeout += (int)timePtr->tv_usec / 1000;
+ }
+ }
+
+ /*
+ * Call (and possibly block on) epoll_wait(2) and substract the delta of
+ * gettimeofday(2) before and after the call from timePtr if the latter is
+ * not NULL. Return the number of events returned by epoll_wait(2).
+ */
+
+ gettimeofday(&tv0, NULL);
+ numFound = epoll_wait(tsdPtr->eventsFd, events, (int)numEvents, timeout);
+ gettimeofday(&tv1, NULL);
+ if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
+ timersub(&tv1, &tv0, &tv_delta);
+ if (!timercmp(&tv_delta, timePtr, >)) {
+ timersub(timePtr, &tv_delta, timePtr);
+ } else {
+ timePtr->tv_sec = 0;
+ timePtr->tv_usec = 0;
+ }
+ }
+ return numFound;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ * This function registers a file handler with the epoll notifier of the
+ * thread of the caller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure.
+ * PlatformEventsControl() is called for the new file handler structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateFileHandler(
+ int fd, /* Handle of stream to watch. */
+ int mask, /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION: indicates
+ * conditions under which proc should be
+ * called. */
+ Tcl_FileProc *proc, /* Function to call for each selected
+ * event. */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
+{
+ int isNew;
+
+ if (tclNotifierHooks.createFileHandlerProc) {
+ tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
+ return;
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ FileHandler *filePtr;
+
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = ckalloc(sizeof(FileHandler));
+ filePtr->fd = fd;
+ filePtr->readyMask = 0;
+ filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
+ tsdPtr->firstFileHandlerPtr = filePtr;
+ isNew = 1;
+ } else {
+ isNew = 0;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+ filePtr->mask = mask;
+
+ PlatformEventsControl(filePtr, tsdPtr,
+ isNew ? EPOLL_CTL_ADD : EPOLL_CTL_MOD, isNew);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for a file on the
+ * epoll file descriptor of the thread of the caller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ * PlatformEventsControl() is called for the file handler structure.
+ * The PlatformEventData struct associated with the new file handler
+ * structure is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteFileHandler(
+ int fd) /* Stream id for which to remove callback
+ * function. */
+{
+ if (tclNotifierHooks.deleteFileHandlerProc) {
+ tclNotifierHooks.deleteFileHandlerProc(fd);
+ return;
+ } else {
+ FileHandler *filePtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Find the entry for the given file (and return if there isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ PlatformEventsControl(filePtr, tsdPtr, EPOLL_CTL_DEL, 0);
+ if (filePtr->pedPtr) {
+ ckfree(filePtr->pedPtr);
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ ckfree(filePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new events on
+ * the message queue. If the block time is 0, then Tcl_WaitForEvent just
+ * polls without blocking.
+ *
+ * The waiting logic is implemented in PlatformEventsWait.
+ *
+ * Results:
+ * Returns -1 if PlatformEventsWait() would block forever, otherwise
+ * returns 0.
+ *
+ * Side effects:
+ * Queues file events that are detected by PlatformEventsWait().
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+{
+ if (tclNotifierHooks.waitForEventProc) {
+ return tclNotifierHooks.waitForEventProc(timePtr);
+ } else {
+ FileHandler *filePtr;
+ int mask;
+ Tcl_Time vTime;
+ /*
+ * Impl. notes: timeout & timeoutPtr are used if, and only if threads
+ * are not enabled. They are the arguments for the regular epoll_wait()
+ * used when the core is not thread-enabled.
+ */
+
+ struct timeval timeout, *timeoutPtr;
+ int numFound, numEvent;
+ struct PlatformEventData *pedPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int numQueued;
+ ssize_t i;
+
+ /*
+ * Set up the timeout structure. Note that if there are no events to
+ * check for, we return with a negative result rather than blocking
+ * forever.
+ */
+
+ if (timePtr != NULL) {
+ /*
+ * TIP #233 (Virtualized Time). Is virtual time in effect? And do
+ * we actually have something to scale? If yes to both then we
+ * call the handler to do this scaling.
+ */
+
+ if (timePtr->sec != 0 || timePtr->usec != 0) {
+ vTime = *timePtr;
+ tclScaleTimeProcPtr(&vTime, tclTimeClientData);
+ timePtr = &vTime;
+ }
+ timeout.tv_sec = timePtr->sec;
+ timeout.tv_usec = timePtr->usec;
+ timeoutPtr = &timeout;
+ } else {
+ timeoutPtr = NULL;
+ }
+
+ /*
+ * Walk the list of FileHandlers associated with regular files
+ * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and
+ * update their mask of events of interest.
+ *
+ * As epoll(7) does not support regular files, the behaviour of
+ * {select,poll}(2) is simply simulated here: fds associated with
+ * regular files are added to this list by PlatformEventsControl() and
+ * processed here before calling (and possibly blocking) on
+ * PlatformEventsWait().
+ */
+
+ numQueued = 0;
+ LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
+ mask = 0;
+ if (filePtr->mask & TCL_READABLE) {
+ mask |= TCL_READABLE;
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ mask |= TCL_WRITABLE;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ FileHandlerEvent *fileEvPtr =
+ ckalloc(sizeof(FileHandlerEvent));
+
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ numQueued++;
+ }
+ filePtr->readyMask = mask;
+ }
+
+ /*
+ * If any events were queued in the above loop, force
+ * PlatformEventsWait() to poll as there already are events that need
+ * to be processed at this point.
+ */
+
+ if (numQueued) {
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 0;
+ timeoutPtr = &timeout;
+ }
+
+ /*
+ * Wait or poll for new events, queue Tcl events for the FileHandlers
+ * corresponding to them, and update the FileHandlers' mask of events
+ * of interest registered by the last call to Tcl_CreateFileHandler().
+ *
+ * Events for the eventfd(2)/trigger pipe are processed here in order
+ * to facilitate inter-thread IPC. If another thread intends to wake
+ * up this thread whilst it's blocking on PlatformEventsWait(), it
+ * write(2)s to the eventfd(2)/trigger pipe (see Tcl_AlertNotifier(),)
+ * which in turn will cause PlatformEventsWait() to return
+ * immediately.
+ */
+
+ numFound = PlatformEventsWait(tsdPtr->readyEvents,
+ tsdPtr->maxReadyEvents, timeoutPtr);
+ for (numEvent = 0; numEvent < numFound; numEvent++) {
+ pedPtr = tsdPtr->readyEvents[numEvent].data.ptr;
+ filePtr = pedPtr->filePtr;
+ mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
+#ifdef HAVE_EVENTFD
+ if (filePtr->fd == tsdPtr->triggerEventFd) {
+ uint64_t eventFdVal;
+ i = read(tsdPtr->triggerEventFd, &eventFdVal,
+ sizeof(eventFdVal));
+ if ((i != sizeof(eventFdVal)) && (errno != EAGAIN)) {
+ Tcl_Panic(
+ "Tcl_WaitForEvent: read from %p->triggerEventFd: %s",
+ (void *) tsdPtr, strerror(errno));
+ }
+ continue;
+ }
+#else /* !HAVE_EVENTFD */
+ if (filePtr->fd == tsdPtr->triggerPipe[0]) {
+ char triggerPipeVal;
+ i = read(tsdPtr->triggerPipe[0], &triggerPipeVal,
+ sizeof(triggerPipeVal));
+ if ((i != sizeof(triggerPipeVal)) && (errno != EAGAIN)) {
+ Tcl_Panic(
+ "Tcl_WaitForEvent: read from %p->triggerPipe[0]: %s",
+ (void *) tsdPtr, strerror(errno));
+ }
+ continue;
+ }
+#endif /* HAVE_EVENTFD */
+ if (!mask) {
+ continue;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ FileHandlerEvent *fileEvPtr =
+ ckalloc(sizeof(FileHandlerEvent));
+
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ }
+ filePtr->readyMask = mask;
+ }
+ return 0;
+ }
+}
+
+#endif /* NOTIFIER_EPOLL && TCL_THREADS */
+#endif /* !HAVE_COREFOUNDATION */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c
new file mode 100644
index 0000000..99d794e
--- /dev/null
+++ b/unix/tclKqueueNotfy.c
@@ -0,0 +1,853 @@
+/*
+ * tclKqueueNotfy.c --
+ *
+ * This file contains the implementation of the kqueue()-based
+ * DragonFly/Free/Net/OpenBSD-specific notifier, which is the lowest-
+ * level part of the Tcl event loop. This file works together with
+ * generic/tclNotify.c.
+ *
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
+ * in tclMacOSXNotify.c */
+#if defined(NOTIFIER_KQUEUE) && TCL_THREADS
+
+#include <signal.h>
+#include <sys/types.h>
+#include <sys/event.h>
+#include <sys/queue.h>
+#include <sys/time.h>
+
+/*
+ * This structure is used to keep track of the notifier info for a registered
+ * file.
+ */
+
+struct PlatformEventData;
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE,
+ * etc. */
+ int readyMask; /* Mask of events that have been seen since
+ * the last time file handlers were invoked
+ * for this file. */
+ Tcl_FileProc *proc; /* Function to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+ LIST_ENTRY(FileHandler) readyNode;
+ /* Next/previous in list of FileHandlers asso-
+ * ciated with regular files (S_IFREG) that are
+ * ready for I/O. */
+ struct PlatformEventData *pedPtr;
+ /* Pointer to PlatformEventData associating this
+ * FileHandler with kevent(2) events. */
+} FileHandler;
+
+/*
+ * The following structure associates a FileHandler and the thread that owns
+ * it with the file descriptors of interest and their event masks passed to
+ * kevent(2) and their corresponding event(s) returned by kevent(2).
+ */
+
+struct ThreadSpecificData;
+struct PlatformEventData {
+ FileHandler *filePtr;
+ struct ThreadSpecificData *tsdPtr;
+};
+
+/*
+ * The following structure is what is added to the Tcl event queue when file
+ * handlers are ready to fire.
+ */
+
+typedef struct {
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ int fd; /* File descriptor that is ready. Used to find
+ * the FileHandler structure for the file
+ * (can't point directly to the FileHandler
+ * structure because it could go away while
+ * the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * kqueue based implementation of the Tcl notifier. One of these structures is
+ * created for each thread that is using the notifier.
+ */
+
+LIST_HEAD(PlatformReadyFileHandlerList, FileHandler);
+typedef struct ThreadSpecificData {
+ FileHandler *firstFileHandlerPtr;
+ /* Pointer to head of file handler list. */
+ struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
+ /* Pointer to head of list of FileHandlers
+ * associated with regular files (S_IFREG)
+ * that are ready for I/O. */
+ pthread_mutex_t notifierMutex;
+ /* Mutex protecting notifier termination in
+ * PlatformEventsFinalize. */
+ int triggerPipe[2]; /* pipe(2) used by other threads to wake
+ * up this thread for inter-thread IPC. */
+ int eventsFd; /* kqueue(2) file descriptor used to wait for
+ * fds. */
+ struct kevent *readyEvents; /* Pointer to at most maxReadyEvents events
+ * returned by kevent(2). */
+ size_t maxReadyEvents; /* Count of kevents in readyEvents. */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+/*
+ * Forward declarations of internal functions.
+ */
+
+static void PlatformEventsControl(FileHandler *filePtr,
+ ThreadSpecificData *tsdPtr, int op, int isNew);
+static void PlatformEventsFinalize(void);
+static void PlatformEventsInit(void);
+static int PlatformEventsTranslate(struct kevent *eventPtr);
+static int PlatformEventsWait(struct kevent *events,
+ size_t numEvents, struct timeval *timePtr);
+
+#include "tclUnixNotfy.c"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitNotifier --
+ *
+ * Initializes the platform specific notifier state.
+ *
+ * Results:
+ * Returns a handle to the notifier state for this thread.
+ *
+ * Side effects:
+ * If no initNotifierProc notifier hook exists, PlatformEventsInit
+ * is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_InitNotifier(void)
+{
+ if (tclNotifierHooks.initNotifierProc) {
+ return tclNotifierHooks.initNotifierProc();
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ PlatformEventsInit();
+ return tsdPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ * This function is called to cleanup the notifier state before a thread
+ * is terminated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If no finalizeNotifierProc notifier hook exists, PlatformEvents-
+ * Finalize is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeNotifier(
+ ClientData clientData) /* Not used. */
+{
+ if (tclNotifierHooks.finalizeNotifierProc) {
+ tclNotifierHooks.finalizeNotifierProc(clientData);
+ return;
+ } else {
+ PlatformEventsFinalize();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsControl --
+ *
+ * This function registers interest for the file descriptor and the mask
+ * of TCL_* bits associated with filePtr on the kqueue file descriptor
+ * associated with tsdPtr.
+ *
+ * Future calls to kevent will return filePtr and tsdPtr alongside with
+ * the event registered here via the PlatformEventData struct.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * - If adding a new file descriptor, a PlatformEventData struct will be
+ * allocated and associated with filePtr.
+ * - fstat is called on the file descriptor; if it is associated with
+ * a regular file (S_IFREG,) filePtr is considered to be ready for I/O
+ * and added to or deleted from the corresponding list in tsdPtr.
+ * - If it is not associated with a regular file, the file descriptor is
+ * added, modified concerning its mask of events of interest, or
+ * deleted from the epoll file descriptor of the calling thread.
+ * - If deleting a file descriptor, kevent(2) is called twice specifying
+ * EVFILT_READ first and then EVFILT_WRITE (see note below.)
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PlatformEventsControl(
+ FileHandler *filePtr,
+ ThreadSpecificData *tsdPtr,
+ int op,
+ int isNew)
+{
+ int numChanges;
+ struct kevent changeList[2];
+ struct PlatformEventData *newPedPtr;
+ struct stat fdStat;
+
+ if (isNew) {
+ newPedPtr = ckalloc(sizeof(*newPedPtr));
+ newPedPtr->filePtr = filePtr;
+ newPedPtr->tsdPtr = tsdPtr;
+ filePtr->pedPtr = newPedPtr;
+ }
+
+ /*
+ * N.B. As discussed in Tcl_WaitForEvent(), kqueue(2) does not reproduce
+ * the `always ready' {select,poll}(2) behaviour for regular files
+ * (S_IFREG) prior to FreeBSD 11.0-RELEASE. Therefore, filePtr is in these
+ * cases simply added or deleted from the list of FileHandlers associated
+ * with regular files belonging to tsdPtr.
+ */
+
+ if (fstat(filePtr->fd, &fdStat) == -1) {
+ Tcl_Panic("fstat: %s", strerror(errno));
+ } else if ((fdStat.st_mode & S_IFMT) == S_IFREG) {
+ switch (op) {
+ case EV_ADD:
+ if (isNew) {
+ LIST_INSERT_HEAD(&tsdPtr->firstReadyFileHandlerPtr, filePtr,
+ readyNode);
+ }
+ break;
+ case EV_DELETE:
+ LIST_REMOVE(filePtr, readyNode);
+ break;
+ }
+ return;
+ }
+
+ numChanges = 0;
+ switch (op) {
+ case EV_ADD:
+ if (filePtr->mask & (TCL_READABLE | TCL_EXCEPTION)) {
+ EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd,
+ EVFILT_READ, op, 0, 0, filePtr->pedPtr);
+ numChanges++;
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ EV_SET(&changeList[numChanges], (uintptr_t)filePtr->fd,
+ EVFILT_WRITE, op, 0, 0, filePtr->pedPtr);
+ numChanges++;
+ }
+ if (numChanges) {
+ if (kevent(tsdPtr->eventsFd, changeList, numChanges, NULL, 0,
+ NULL) == -1) {
+ Tcl_Panic("kevent: %s", strerror(errno));
+ }
+ }
+ break;
+ case EV_DELETE:
+ /*
+ * N.B. kqueue(2) has separate filters for readability and writability
+ * fd events. We therefore need to ensure that fds are ompletely
+ * removed from the kqueue(2) fd when deleting. This is exacerbated
+ * by changes to filePtr->mask w/o calls to PlatforEventsControl()
+ * after e.g. an exec(3) in a child process.
+ *
+ * As one of these calls can fail, two separate kevent(2) calls are
+ * made for EVFILT_{READ,WRITE}.
+ */
+ EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_READ, op, 0, 0,
+ NULL);
+ if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
+ && (errno != ENOENT)) {
+ Tcl_Panic("kevent: %s", strerror(errno));
+ }
+ EV_SET(&changeList[0], (uintptr_t)filePtr->fd, EVFILT_WRITE, op, 0, 0,
+ NULL);
+ if ((kevent(tsdPtr->eventsFd, changeList, 1, NULL, 0, NULL) == -1)
+ && (errno != ENOENT)) {
+ Tcl_Panic("kevent: %s", strerror(errno));
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsFinalize --
+ *
+ * This function closes the pipe and the kqueue file descriptors and
+ * frees the kevent structs owned by the thread of the caller. The above
+ * operations are protected by tsdPtr->notifierMutex, which is destroyed
+ * thereafter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * While tsdPtr->notifierMutex is held:
+ * The per-thread pipe(2) fds are closed, if non-zero, and set to -1.
+ * The per-thread kqueue(2) fd is closed, if non-zero, and set to 0.
+ * The per-thread kevent structs are freed, if any, and set to 0.
+ *
+ * tsdPtr->notifierMutex is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PlatformEventsFinalize(
+ void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ pthread_mutex_lock(&tsdPtr->notifierMutex);
+ if (tsdPtr->triggerPipe[0]) {
+ close(tsdPtr->triggerPipe[0]);
+ tsdPtr->triggerPipe[0] = -1;
+ }
+ if (tsdPtr->triggerPipe[1]) {
+ close(tsdPtr->triggerPipe[1]);
+ tsdPtr->triggerPipe[1] = -1;
+ }
+ if (tsdPtr->eventsFd > 0) {
+ close(tsdPtr->eventsFd);
+ tsdPtr->eventsFd = 0;
+ }
+ if (tsdPtr->readyEvents) {
+ ckfree(tsdPtr->readyEvents);
+ tsdPtr->maxReadyEvents = 0;
+ }
+ pthread_mutex_unlock(&tsdPtr->notifierMutex);
+ if ((errno = pthread_mutex_destroy(&tsdPtr->notifierMutex))) {
+ Tcl_Panic("pthread_mutex_destroy: %s", strerror(errno));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsInit --
+ *
+ * This function abstracts creating a kqueue fd via the kqueue system
+ * call and allocating memory for the kevents structs in tsdPtr for the
+ * thread of the caller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The following per-thread entities are initialised:
+ * - notifierMutex is initialised.
+ * - The pipe(2) is created; fcntl(2) is called on both fds to set
+ * FD_CLOEXEC and O_NONBLOCK.
+ * - The kqueue(2) fd is created; fcntl(2) is called on it to set
+ * FD_CLOEXEC.
+ * - A FileHandler struct is allocated and initialised for the event-
+ * fd(2), registering interest for TCL_READABLE on it via Platform-
+ * EventsControl().
+ * - readyEvents and maxReadyEvents are initialised with 512 kevents.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+PlatformEventsInit(void)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int i, fdFl;
+ FileHandler *filePtr;
+
+ errno = pthread_mutex_init(&tsdPtr->notifierMutex, NULL);
+ if (errno) {
+ Tcl_Panic("Tcl_InitNotifier: %s", "could not create mutex");
+ }
+ if (pipe(tsdPtr->triggerPipe) != 0) {
+ Tcl_Panic("Tcl_InitNotifier: %s", "could not create trigger pipe");
+ } else for (i = 0; i < 2; i++) {
+ if (fcntl(tsdPtr->triggerPipe[i], F_SETFD, FD_CLOEXEC) == -1) {
+ Tcl_Panic("fcntl: %s", strerror(errno));
+ } else {
+ fdFl = fcntl(tsdPtr->triggerPipe[i], F_GETFL);
+ fdFl |= O_NONBLOCK;
+ }
+ if (fcntl(tsdPtr->triggerPipe[i], F_SETFL, fdFl) == -1) {
+ Tcl_Panic("fcntl: %s", strerror(errno));
+ }
+ }
+ if ((tsdPtr->eventsFd = kqueue()) == -1) {
+ Tcl_Panic("kqueue: %s", strerror(errno));
+ } else if (fcntl(tsdPtr->eventsFd, F_SETFD, FD_CLOEXEC) == -1) {
+ Tcl_Panic("fcntl: %s", strerror(errno));
+ }
+ filePtr = ckalloc(sizeof(*filePtr));
+ filePtr->fd = tsdPtr->triggerPipe[0];
+ filePtr->mask = TCL_READABLE;
+ PlatformEventsControl(filePtr, tsdPtr, EV_ADD, 1);
+ if (!tsdPtr->readyEvents) {
+ tsdPtr->maxReadyEvents = 512;
+ tsdPtr->readyEvents = ckalloc(
+ tsdPtr->maxReadyEvents * sizeof(tsdPtr->readyEvents[0]));
+ }
+ LIST_INIT(&tsdPtr->firstReadyFileHandlerPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsTranslate --
+ *
+ * This function translates the platform-specific mask of returned
+ * events in eventPtr to a mask of TCL_* bits.
+ *
+ * Results:
+ * Returns the translated mask.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+PlatformEventsTranslate(
+ struct kevent *eventPtr)
+{
+ int mask;
+
+ mask = 0;
+ if (eventPtr->filter == EVFILT_READ) {
+ mask |= TCL_READABLE;
+ if (eventPtr->flags & EV_ERROR) {
+ mask |= TCL_EXCEPTION;
+ }
+ }
+ if (eventPtr->filter == EVFILT_WRITE) {
+ mask |= TCL_WRITABLE;
+ if (eventPtr->flags & EV_ERROR) {
+ mask |= TCL_EXCEPTION;
+ }
+ }
+ return mask;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlatformEventsWait --
+ *
+ * This function abstracts waiting for I/O events via the kevent system
+ * call.
+ *
+ * Results:
+ * Returns -1 if kevent failed. Returns 0 if polling and if no events
+ * became available whilst polling. Returns a pointer to and the count of
+ * all returned events in all other cases.
+ *
+ * Side effects:
+ * gettimeofday(2), kevent(2), and gettimeofday(2) are called, in the
+ * specified order.
+ * If timePtr specifies a positive value, it is updated to reflect the
+ * amount of time that has passed; if its value would {under, over}flow,
+ * it is set to zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+PlatformEventsWait(
+ struct kevent *events,
+ size_t numEvents,
+ struct timeval *timePtr)
+{
+ int numFound;
+ struct timeval tv0, tv1, tv_delta;
+ struct timespec timeout, *timeoutPtr;
+
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * If timePtr is NULL, kevent(2) will wait indefinitely. If it specifies a
+ * timeout of {0,0}, kevent(2) will poll. Otherwise, the timeout will
+ * simply be converted to a timespec.
+ */
+
+ if (!timePtr) {
+ timeoutPtr = NULL;
+ } else if (!timePtr->tv_sec && !timePtr->tv_usec) {
+ timeout.tv_sec = 0;
+ timeout.tv_nsec = 0;
+ timeoutPtr = &timeout;
+ } else {
+ timeout.tv_sec = timePtr->tv_sec;
+ timeout.tv_nsec = timePtr->tv_usec * 1000;
+ timeoutPtr = &timeout;
+ }
+
+ /*
+ * Call (and possibly block on) kevent(2) and substract the delta of
+ * gettimeofday(2) before and after the call from timePtr if the latter is
+ * not NULL. Return the number of events returned by kevent(2).
+ */
+
+ gettimeofday(&tv0, NULL);
+ numFound = kevent(tsdPtr->eventsFd, NULL, 0, events, (int) numEvents,
+ timeoutPtr);
+ gettimeofday(&tv1, NULL);
+ if (timePtr && (timePtr->tv_sec && timePtr->tv_usec)) {
+ timersub(&tv1, &tv0, &tv_delta);
+ if (!timercmp(&tv_delta, timePtr, >)) {
+ timersub(timePtr, &tv_delta, timePtr);
+ } else {
+ timePtr->tv_sec = 0;
+ timePtr->tv_usec = 0;
+ }
+ }
+ return numFound;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ * This function registers a file handler with the kqueue notifier
+ * of the thread of the caller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure.
+ * PlatformEventsControl() is called for the new file handler structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateFileHandler(
+ int fd, /* Handle of stream to watch. */
+ int mask, /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION: indicates
+ * conditions under which proc should be
+ * called. */
+ Tcl_FileProc *proc, /* Function to call for each selected
+ * event. */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
+{
+ int isNew;
+
+ if (tclNotifierHooks.createFileHandlerProc) {
+ tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
+ return;
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ FileHandler *filePtr;
+
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = ckalloc(sizeof(FileHandler));
+ filePtr->fd = fd;
+ filePtr->readyMask = 0;
+ filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
+ tsdPtr->firstFileHandlerPtr = filePtr;
+ isNew = 1;
+ } else {
+ isNew = 0;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+ filePtr->mask = mask;
+
+ PlatformEventsControl(filePtr, tsdPtr, EV_ADD, isNew);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for a file on the
+ * kqueue of the thread of the caller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ * PlatformEventsControl() is called for the file handler structure.
+ * The PlatformEventData struct associated with the new file handler
+ * structure is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteFileHandler(
+ int fd) /* Stream id for which to remove callback
+ * function. */
+{
+ if (tclNotifierHooks.deleteFileHandlerProc) {
+ tclNotifierHooks.deleteFileHandlerProc(fd);
+ return;
+ } else {
+ FileHandler *filePtr, *prevPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Find the entry for the given file (and return if there isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ PlatformEventsControl(filePtr, tsdPtr, EV_DELETE, 0);
+ if (filePtr->pedPtr) {
+ ckfree(filePtr->pedPtr);
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ ckfree(filePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new events on
+ * the message queue. If the block time is 0, then Tcl_WaitForEvent just
+ * polls without blocking.
+ *
+ * The waiting logic is implemented in PlatformEventsWait.
+ *
+ * Results:
+ * Returns -1 if PlatformEventsWait() would block forever, otherwise
+ * returns 0.
+ *
+ * Side effects:
+ * Queues file events that are detected by PlatformEventsWait().
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+{
+ if (tclNotifierHooks.waitForEventProc) {
+ return tclNotifierHooks.waitForEventProc(timePtr);
+ } else {
+ FileHandler *filePtr;
+ int mask;
+ Tcl_Time vTime;
+ /*
+ * Impl. notes: timeout & timeoutPtr are used if, and only if threads
+ * are not enabled. They are the arguments for the regular epoll_wait()
+ * used when the core is not thread-enabled.
+ */
+
+ struct timeval timeout, *timeoutPtr;
+ int numFound, numEvent;
+ struct PlatformEventData *pedPtr;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ int numQueued;
+ ssize_t i;
+ char buf[1];
+
+ /*
+ * Set up the timeout structure. Note that if there are no events to
+ * check for, we return with a negative result rather than blocking
+ * forever.
+ */
+
+ if (timePtr != NULL) {
+ /*
+ * TIP #233 (Virtualized Time). Is virtual time in effect? And do
+ * we actually have something to scale? If yes to both then we
+ * call the handler to do this scaling.
+ */
+
+ if (timePtr->sec != 0 || timePtr->usec != 0) {
+ vTime = *timePtr;
+ tclScaleTimeProcPtr(&vTime, tclTimeClientData);
+ timePtr = &vTime;
+ }
+ timeout.tv_sec = timePtr->sec;
+ timeout.tv_usec = timePtr->usec;
+ timeoutPtr = &timeout;
+ } else {
+ timeoutPtr = NULL;
+ }
+
+ /*
+ * Walk the list of FileHandlers associated with regular files
+ * (S_IFREG) belonging to tsdPtr, queue Tcl events for them, and
+ * update their mask of events of interest.
+ *
+ * kqueue(2), unlike epoll(7), does support regular files, but
+ * EVFILT_READ only `[r]eturns when the file pointer is not at the end
+ * of file' as opposed to unconditionally. While FreeBSD 11.0-RELEASE
+ * adds support for this mode (NOTE_FILE_POLL,) this is not used for
+ * reasons of compatibility.
+ *
+ * Therefore, the behaviour of {select,poll}(2) is simply simulated
+ * here: fds associated with regular files are added to this list by
+ * PlatformEventsControl() and processed here before calling (and
+ * possibly blocking) on PlatformEventsWait().
+ */
+
+ numQueued = 0;
+ LIST_FOREACH(filePtr, &tsdPtr->firstReadyFileHandlerPtr, readyNode) {
+ mask = 0;
+ if (filePtr->mask & TCL_READABLE) {
+ mask |= TCL_READABLE;
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ mask |= TCL_WRITABLE;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ FileHandlerEvent *fileEvPtr =
+ ckalloc(sizeof(FileHandlerEvent));
+
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ numQueued++;
+ }
+ filePtr->readyMask = mask;
+ }
+
+ /*
+ * If any events were queued in the above loop, force PlatformEvents-
+ * Wait() to poll as there already are events that need to be processed
+ * at this point.
+ */
+
+ if (numQueued) {
+ timeout.tv_sec = 0;
+ timeout.tv_usec = 0;
+ timeoutPtr = &timeout;
+ }
+
+ /*
+ * Wait or poll for new events, queue Tcl events for the FileHandlers
+ * corresponding to them, and update the FileHandlers' mask of events
+ * of interest registered by the last call to Tcl_CreateFileHandler().
+ *
+ * Events for the trigger pipe are processed here in order to facilitate
+ * inter-thread IPC. If another thread intends to wake up this thread
+ * whilst it's blocking on PlatformEventsWait(), it write(2)s to the
+ * other end of the pipe (see Tcl_AlertNotifier(),) which in turn will
+ * cause PlatformEventsWait() to return immediately.
+ */
+
+ numFound = PlatformEventsWait(tsdPtr->readyEvents,
+ tsdPtr->maxReadyEvents, timeoutPtr);
+ for (numEvent = 0; numEvent < numFound; numEvent++) {
+ pedPtr = (struct PlatformEventData *)
+ tsdPtr->readyEvents[numEvent].udata;
+ filePtr = pedPtr->filePtr;
+ mask = PlatformEventsTranslate(&tsdPtr->readyEvents[numEvent]);
+ if (filePtr->fd == tsdPtr->triggerPipe[0]) {
+ i = read(tsdPtr->triggerPipe[0], buf, 1);
+ if ((i == -1) && (errno != EAGAIN)) {
+ Tcl_Panic("Tcl_WaitForEvent: read from %p->triggerPipe: %s",
+ (void *) tsdPtr, strerror(errno));
+ }
+ continue;
+ }
+ if (!mask) {
+ continue;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ FileHandlerEvent *fileEvPtr =
+ ckalloc(sizeof(FileHandlerEvent));
+
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ }
+ filePtr->readyMask |= mask;
+ }
+ return 0;
+ }
+}
+
+#endif /* NOTIFIER_KQUEUE && TCL_THREADS */
+#endif /* !HAVE_COREFOUNDATION */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/tclLoadAix.c b/unix/tclLoadAix.c
index 88e6b50..e5d9729 100644
--- a/unix/tclLoadAix.c
+++ b/unix/tclLoadAix.c
@@ -134,7 +134,7 @@ dlopen(
return NULL;
}
- mp->name = malloc((unsigned) (strlen(path) + 1));
+ mp->name = malloc(strlen(path) + 1);
strcpy(mp->name, path);
/*
@@ -541,7 +541,7 @@ readExports(
tmpsym[SYMNMLEN] = '\0';
symname = tmpsym;
}
- ep->name = malloc((unsigned) (strlen(symname) + 1));
+ ep->name = malloc(strlen(symname) + 1);
strcpy(ep->name, symname);
ep->addr = (void *)((unsigned long)
mp->entry + ls->l_value - shdata.s_vaddr);
diff --git a/unix/tclSelectNotfy.c b/unix/tclSelectNotfy.c
new file mode 100644
index 0000000..a0dea57
--- /dev/null
+++ b/unix/tclSelectNotfy.c
@@ -0,0 +1,1114 @@
+/*
+ * tclSelectNotfy.c --
+ *
+ * This file contains the implementation of the select()-based generic
+ * Unix notifier, which is the lowest-level part of the Tcl event loop.
+ * This file works together with generic/tclNotify.c.
+ *
+ * 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.
+ */
+
+#include "tclInt.h"
+#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
+ * in tclMacOSXNotify.c */
+#if (!defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)) || !TCL_THREADS
+
+#include <signal.h>
+
+/*
+ * This structure is used to keep track of the notifier info for a registered
+ * file.
+ */
+
+typedef struct FileHandler {
+ int fd;
+ int mask; /* Mask of desired events: TCL_READABLE,
+ * etc. */
+ int readyMask; /* Mask of events that have been seen since
+ * the last time file handlers were invoked
+ * for this file. */
+ Tcl_FileProc *proc; /* Function to call, in the style of
+ * Tcl_CreateFileHandler. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct FileHandler *nextPtr;/* Next in list of all files we care about. */
+} FileHandler;
+
+/*
+ * The following structure contains a set of select() masks to track readable,
+ * writable, and exception conditions.
+ */
+
+typedef struct {
+ fd_set readable;
+ fd_set writable;
+ fd_set exception;
+} SelectMasks;
+
+/*
+ * The following structure is what is added to the Tcl event queue when file
+ * handlers are ready to fire.
+ */
+
+typedef struct {
+ Tcl_Event header; /* Information that is standard for all
+ * events. */
+ int fd; /* File descriptor that is ready. Used to find
+ * the FileHandler structure for the file
+ * (can't point directly to the FileHandler
+ * structure because it could go away while
+ * the event is queued). */
+} FileHandlerEvent;
+
+/*
+ * The following static structure contains the state information for the
+ * select based implementation of the Tcl notifier. One of these structures is
+ * created for each thread that is using the notifier.
+ */
+
+typedef struct ThreadSpecificData {
+ FileHandler *firstFileHandlerPtr;
+ /* Pointer to head of file handler list. */
+ SelectMasks checkMasks; /* This structure is used to build up the
+ * masks to be used in the next call to
+ * select. Bits are set in response to calls
+ * to Tcl_CreateFileHandler. */
+ SelectMasks readyMasks; /* This array reflects the readable/writable
+ * conditions that were found to exist by the
+ * last call to select. */
+ int numFdBits; /* Number of valid bits in checkMasks (one
+ * more than highest fd for which
+ * Tcl_WatchFile has been called). */
+#if TCL_THREADS
+ int onList; /* True if it is in this list */
+ unsigned int pollState; /* pollState is used to implement a polling
+ * handshake between each thread and the
+ * notifier thread. Bits defined below. */
+ struct ThreadSpecificData *nextPtr, *prevPtr;
+ /* All threads that are currently waiting on
+ * an event have their ThreadSpecificData
+ * structure on a doubly-linked listed formed
+ * from these pointers. You must hold the
+ * notifierMutex lock before accessing these
+ * fields. */
+#ifdef __CYGWIN__
+ void *event; /* Any other thread alerts a notifier that an
+ * event is ready to be processed by sending
+ * this event. */
+ void *hwnd; /* Messaging window. */
+#else /* !__CYGWIN__ */
+ pthread_cond_t waitCV; /* Any other thread alerts a notifier that an
+ * event is ready to be processed by signaling
+ * this condition variable. */
+#endif /* __CYGWIN__ */
+ int waitCVinitialized; /* Variable to flag initialization of the
+ * structure. */
+ int eventReady; /* True if an event is ready to be processed.
+ * Used as condition flag together with waitCV
+ * above. */
+#endif /* TCL_THREADS */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+#if TCL_THREADS
+/*
+ * The following static indicates the number of threads that have initialized
+ * notifiers.
+ *
+ * You must hold the notifierMutex lock before accessing this variable.
+ */
+
+static int notifierCount = 0;
+
+/*
+ * The following variable points to the head of a doubly-linked list of
+ * ThreadSpecificData structures for all threads that are currently waiting on
+ * an event.
+ *
+ * You must hold the notifierMutex lock before accessing this list.
+ */
+
+static ThreadSpecificData *waitingListPtr = NULL;
+
+/*
+ * The notifier thread spends all its time in select() waiting for a file
+ * descriptor associated with one of the threads on the waitingListPtr list to
+ * do something interesting. But if the contents of the waitingListPtr list
+ * ever changes, we need to wake up and restart the select() system call. You
+ * can wake up the notifier thread by writing a single byte to the file
+ * descriptor defined below. This file descriptor is the input-end of a pipe
+ * and the notifier thread is listening for data on the output-end of the same
+ * pipe. Hence writing to this file descriptor will cause the select() system
+ * call to return and wake up the notifier thread.
+ *
+ * You must hold the notifierMutex lock before writing to the pipe.
+ */
+
+static int triggerPipe = -1;
+
+/*
+ * The notifierMutex locks access to all of the global notifier state.
+ */
+
+static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER;
+static pthread_mutex_t notifierMutex = PTHREAD_MUTEX_INITIALIZER;
+/*
+ * The following static indicates if the notifier thread is running.
+ *
+ * You must hold the notifierInitMutex before accessing this variable.
+ */
+
+static int notifierThreadRunning = 0;
+
+/*
+ * The notifier thread signals the notifierCV when it has finished
+ * initializing the triggerPipe and right before the notifier thread
+ * terminates.
+ */
+
+static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER;
+
+/*
+ * The pollState bits:
+ *
+ * POLL_WANT is set by each thread before it waits on its condition variable.
+ * It is checked by the notifier before it does select.
+ *
+ * POLL_DONE is set by the notifier if it goes into select after seeing
+ * POLL_WANT. The idea is to ensure it tries a select with the same bits
+ * the initial thread had set.
+ */
+
+#define POLL_WANT 0x1
+#define POLL_DONE 0x2
+
+/*
+ * This is the thread ID of the notifier thread that does select.
+ */
+
+static Tcl_ThreadId notifierThread;
+#endif /* TCL_THREADS */
+
+/*
+ * Static routines defined in this file.
+ */
+
+#if TCL_THREADS
+static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
+#if defined(HAVE_PTHREAD_ATFORK)
+static int atForkInit = 0;
+static void AtForkChild(void);
+#endif /* HAVE_PTHREAD_ATFORK */
+#endif /* TCL_THREADS */
+static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+
+/*
+ * Import of critical bits of Windows API when building threaded with Cygwin.
+ */
+
+#if defined(__CYGWIN__)
+typedef struct {
+ void *hwnd; /* Messaging window. */
+ unsigned int *message; /* Message payload. */
+ int wParam; /* Event-specific "word" parameter. */
+ int lParam; /* Event-specific "long" parameter. */
+ int time; /* Event timestamp. */
+ int x; /* Event location (where meaningful). */
+ int y;
+} MSG;
+
+typedef struct {
+ unsigned int style;
+ void *lpfnWndProc;
+ int cbClsExtra;
+ int cbWndExtra;
+ void *hInstance;
+ void *hIcon;
+ void *hCursor;
+ void *hbrBackground;
+ void *lpszMenuName;
+ const void *lpszClassName;
+} WNDCLASS;
+
+extern void __stdcall CloseHandle(void *);
+extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char,
+ void *);
+extern void *__stdcall CreateWindowExW(void *, const void *, const void *,
+ DWORD, int, int, int, int, void *, void *, void *,
+ void *);
+extern DWORD __stdcall DefWindowProcW(void *, int, void *, void *);
+extern unsigned char __stdcall DestroyWindow(void *);
+extern int __stdcall DispatchMessageW(const MSG *);
+extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int);
+extern void __stdcall MsgWaitForMultipleObjects(DWORD, void *,
+ unsigned char, DWORD, DWORD);
+extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int);
+extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *,
+ void *);
+extern void __stdcall PostQuitMessage(int);
+extern void *__stdcall RegisterClassW(const WNDCLASS *);
+extern unsigned char __stdcall ResetEvent(void *);
+extern unsigned char __stdcall TranslateMessage(const MSG *);
+
+/*
+ * Threaded-cygwin specific constants and functions in this file:
+ */
+
+static const WCHAR className[] = L"TclNotifier";
+static DWORD __stdcall NotifierProc(void *hwnd, unsigned int message,
+ void *wParam, void *lParam);
+#endif /* TCL_THREADS && __CYGWIN__ */
+
+
+#include "tclUnixNotfy.c"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitNotifier --
+ *
+ * Initializes the platform specific notifier state.
+ *
+ * Results:
+ * Returns a handle to the notifier state for this thread.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_InitNotifier(void)
+{
+ if (tclNotifierHooks.initNotifierProc) {
+ return tclNotifierHooks.initNotifierProc();
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+#if TCL_THREADS
+ tsdPtr->eventReady = 0;
+
+ /*
+ * Initialize thread specific condition variable for this thread.
+ */
+ if (tsdPtr->waitCVinitialized == 0) {
+#ifdef __CYGWIN__
+ WNDCLASS class;
+
+ class.style = 0;
+ class.cbClsExtra = 0;
+ class.cbWndExtra = 0;
+ class.hInstance = TclWinGetTclInstance();
+ class.hbrBackground = NULL;
+ class.lpszMenuName = NULL;
+ class.lpszClassName = className;
+ class.lpfnWndProc = NotifierProc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ RegisterClassW(&class);
+ tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
+ class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
+ TclWinGetTclInstance(), NULL);
+ tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
+ 0 /* !signaled */, NULL);
+#else
+ pthread_cond_init(&tsdPtr->waitCV, NULL);
+#endif /* __CYGWIN__ */
+ tsdPtr->waitCVinitialized = 1;
+ }
+
+ pthread_mutex_lock(&notifierInitMutex);
+#if defined(HAVE_PTHREAD_ATFORK)
+ /*
+ * Install pthread_atfork handlers to clean up the notifier in the
+ * child of a fork.
+ */
+
+ if (!atForkInit) {
+ int result = pthread_atfork(NULL, NULL, AtForkChild);
+
+ if (result) {
+ Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
+ }
+ atForkInit = 1;
+ }
+#endif /* HAVE_PTHREAD_ATFORK */
+
+ notifierCount++;
+ pthread_mutex_unlock(&notifierInitMutex);
+
+#endif /* TCL_THREADS */
+ return tsdPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ * This function is called to cleanup the notifier state before a thread
+ * is terminated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May terminate the background notifier thread if this is the last
+ * notifier instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeNotifier(
+ ClientData clientData) /* Not used. */
+{
+ if (tclNotifierHooks.finalizeNotifierProc) {
+ tclNotifierHooks.finalizeNotifierProc(clientData);
+ return;
+ } else {
+#if TCL_THREADS
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ pthread_mutex_lock(&notifierInitMutex);
+ notifierCount--;
+
+ /*
+ * If this is the last thread to use the notifier, close the notifier
+ * pipe and wait for the background thread to terminate.
+ */
+
+ if (notifierCount == 0 && triggerPipe != -1) {
+ if (write(triggerPipe, "q", 1) != 1) {
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "unable to write 'q' to triggerPipe");
+ }
+ close(triggerPipe);
+ pthread_mutex_lock(&notifierMutex);
+ while(triggerPipe != -1) {
+ pthread_cond_wait(&notifierCV, &notifierMutex);
+ }
+ pthread_mutex_unlock(&notifierMutex);
+ if (notifierThreadRunning) {
+ int result = pthread_join((pthread_t) notifierThread, NULL);
+
+ if (result) {
+ Tcl_Panic("Tcl_FinalizeNotifier: %s",
+ "unable to join notifier thread");
+ }
+ notifierThreadRunning = 0;
+ }
+ }
+
+ /*
+ * Clean up any synchronization objects in the thread local storage.
+ */
+
+#ifdef __CYGWIN__
+ DestroyWindow(tsdPtr->hwnd);
+ CloseHandle(tsdPtr->event);
+#else /* __CYGWIN__ */
+ pthread_cond_destroy(&tsdPtr->waitCV);
+#endif /* __CYGWIN__ */
+ tsdPtr->waitCVinitialized = 0;
+
+ pthread_mutex_unlock(&notifierInitMutex);
+#endif /* TCL_THREADS */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ * This function registers a file handler with the select notifier.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Creates a new file handler structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_CreateFileHandler(
+ int fd, /* Handle of stream to watch. */
+ int mask, /* OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION: indicates
+ * conditions under which proc should be
+ * called. */
+ Tcl_FileProc *proc, /* Function to call for each selected
+ * event. */
+ ClientData clientData) /* Arbitrary data to pass to proc. */
+{
+ if (tclNotifierHooks.createFileHandlerProc) {
+ tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
+ return;
+ } else {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+ FileHandler *filePtr;
+
+ for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
+ filePtr = filePtr->nextPtr) {
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+ if (filePtr == NULL) {
+ filePtr = ckalloc(sizeof(FileHandler));
+ filePtr->fd = fd;
+ filePtr->readyMask = 0;
+ filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
+ tsdPtr->firstFileHandlerPtr = filePtr;
+ }
+ filePtr->proc = proc;
+ filePtr->clientData = clientData;
+ filePtr->mask = mask;
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ if (mask & TCL_READABLE) {
+ FD_SET(fd, &tsdPtr->checkMasks.readable);
+ } else {
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
+ }
+ if (mask & TCL_WRITABLE) {
+ FD_SET(fd, &tsdPtr->checkMasks.writable);
+ } else {
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
+ }
+ if (mask & TCL_EXCEPTION) {
+ FD_SET(fd, &tsdPtr->checkMasks.exception);
+ } else {
+ FD_CLR(fd, &tsdPtr->checkMasks.exception);
+ }
+ if (tsdPtr->numFdBits <= fd) {
+ tsdPtr->numFdBits = fd+1;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ * Cancel a previously-arranged callback arrangement for a file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a callback was previously registered on file, remove it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_DeleteFileHandler(
+ int fd) /* Stream id for which to remove callback
+ * function. */
+{
+ if (tclNotifierHooks.deleteFileHandlerProc) {
+ tclNotifierHooks.deleteFileHandlerProc(fd);
+ return;
+ } else {
+ FileHandler *filePtr, *prevPtr;
+ int i;
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Find the entry for the given file (and return if there isn't one).
+ */
+
+ for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
+ prevPtr = filePtr, filePtr = filePtr->nextPtr) {
+ if (filePtr == NULL) {
+ return;
+ }
+ if (filePtr->fd == fd) {
+ break;
+ }
+ }
+
+ /*
+ * Update the check masks for this file.
+ */
+
+ if (filePtr->mask & TCL_READABLE) {
+ FD_CLR(fd, &tsdPtr->checkMasks.readable);
+ }
+ if (filePtr->mask & TCL_WRITABLE) {
+ FD_CLR(fd, &tsdPtr->checkMasks.writable);
+ }
+ if (filePtr->mask & TCL_EXCEPTION) {
+ FD_CLR(fd, &tsdPtr->checkMasks.exception);
+ }
+
+ /*
+ * Find current max fd.
+ */
+
+ if (fd+1 == tsdPtr->numFdBits) {
+ int numFdBits = 0;
+
+ for (i = fd-1; i >= 0; i--) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.writable)
+ || FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
+ numFdBits = i+1;
+ break;
+ }
+ }
+ tsdPtr->numFdBits = numFdBits;
+ }
+
+ /*
+ * Clean up information in the callback record.
+ */
+
+ if (prevPtr == NULL) {
+ tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = filePtr->nextPtr;
+ }
+ ckfree(filePtr);
+ }
+}
+
+#if defined(__CYGWIN__)
+
+static DWORD __stdcall
+NotifierProc(
+ void *hwnd,
+ unsigned int message,
+ void *wParam,
+ void *lParam)
+{
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ if (message != 1024) {
+ return DefWindowProcW(hwnd, message, wParam, lParam);
+ }
+
+ /*
+ * Process all of the runnable events.
+ */
+
+ tsdPtr->eventReady = 1;
+ Tcl_ServiceAll();
+ return 0;
+}
+#endif /* TCL_THREADS && __CYGWIN__ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ * This function is called by Tcl_DoOneEvent to wait for new events on
+ * the message queue. If the block time is 0, then Tcl_WaitForEvent just
+ * polls without blocking.
+ *
+ * Results:
+ * Returns -1 if the select would block forever, otherwise returns 0.
+ *
+ * Side effects:
+ * Queues file events that are detected by the select.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+ const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
+{
+ if (tclNotifierHooks.waitForEventProc) {
+ return tclNotifierHooks.waitForEventProc(timePtr);
+ } else {
+ FileHandler *filePtr;
+ int mask;
+ Tcl_Time vTime;
+#if TCL_THREADS
+ int waitForFiles;
+# ifdef __CYGWIN__
+ MSG msg;
+# endif /* __CYGWIN__ */
+#else /* !TCL_THREADS */
+ /*
+ * Impl. notes: timeout & timeoutPtr are used if, and only if threads
+ * are not enabled. They are the arguments for the regular select()
+ * used when the core is not thread-enabled.
+ */
+
+ struct timeval timeout, *timeoutPtr;
+ int numFound;
+#endif /* TCL_THREADS */
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
+
+ /*
+ * Set up the timeout structure. Note that if there are no events to
+ * check for, we return with a negative result rather than blocking
+ * forever.
+ */
+
+ if (timePtr != NULL) {
+ /*
+ * TIP #233 (Virtualized Time). Is virtual time in effect? And do
+ * we actually have something to scale? If yes to both then we
+ * call the handler to do this scaling.
+ */
+
+ if (timePtr->sec != 0 || timePtr->usec != 0) {
+ vTime = *timePtr;
+ tclScaleTimeProcPtr(&vTime, tclTimeClientData);
+ timePtr = &vTime;
+ }
+#if !TCL_THREADS
+ timeout.tv_sec = timePtr->sec;
+ timeout.tv_usec = timePtr->usec;
+ timeoutPtr = &timeout;
+ } else if (tsdPtr->numFdBits == 0) {
+ /*
+ * If there are no threads, no timeout, and no fds registered,
+ * then there are no events possible and we must avoid deadlock.
+ * Note that this is not entirely correct because there might be a
+ * signal that could interrupt the select call, but we don't
+ * handle that case if we aren't using threads.
+ */
+
+ return -1;
+ } else {
+ timeoutPtr = NULL;
+#endif /* !TCL_THREADS */
+ }
+
+#if TCL_THREADS
+ /*
+ * Start notifier thread and place this thread on the list of
+ * interested threads, signal the notifier thread, and wait for a
+ * response or a timeout.
+ */
+ StartNotifierThread("Tcl_WaitForEvent");
+
+ pthread_mutex_lock(&notifierMutex);
+
+ if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
+#if defined(__APPLE__) && defined(__LP64__)
+ /*
+ * On 64-bit Darwin, pthread_cond_timedwait() appears to have
+ * a bug that causes it to wait forever when passed an
+ * absolute time which has already been exceeded by the system
+ * time; as a workaround, when given a very brief timeout,
+ * just do a poll. [Bug 1457797]
+ */
+ || timePtr->usec < 10
+#endif /* __APPLE__ && __LP64__ */
+ )) {
+ /*
+ * Cannot emulate a polling select with a polling condition
+ * variable. Instead, pretend to wait for files and tell the
+ * notifier thread what we are doing. The notifier thread makes
+ * sure it goes through select with its select mask in the same
+ * state as ours currently is. We block until that happens.
+ */
+
+ waitForFiles = 1;
+ tsdPtr->pollState = POLL_WANT;
+ timePtr = NULL;
+ } else {
+ waitForFiles = (tsdPtr->numFdBits > 0);
+ tsdPtr->pollState = 0;
+ }
+
+ if (waitForFiles) {
+ /*
+ * Add the ThreadSpecificData structure of this thread to the list
+ * of ThreadSpecificData structures of all threads that are
+ * waiting on file events.
+ */
+
+ tsdPtr->nextPtr = waitingListPtr;
+ if (waitingListPtr) {
+ waitingListPtr->prevPtr = tsdPtr;
+ }
+ tsdPtr->prevPtr = 0;
+ waitingListPtr = tsdPtr;
+ tsdPtr->onList = 1;
+
+ if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
+ Tcl_Panic("Tcl_WaitForEvent: %s",
+ "unable to write to triggerPipe");
+ }
+ }
+
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exception);
+
+ if (!tsdPtr->eventReady) {
+#ifdef __CYGWIN__
+ if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
+ DWORD timeout;
+
+ if (timePtr) {
+ timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
+ } else {
+ timeout = 0xFFFFFFFF;
+ }
+ pthread_mutex_unlock(&notifierMutex);
+ MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
+ pthread_mutex_lock(&notifierMutex);
+ }
+#else /* !__CYGWIN__ */
+ if (timePtr != NULL) {
+ Tcl_Time now;
+ struct timespec ptime;
+
+ 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(&tsdPtr->waitCV, &notifierMutex, &ptime);
+ } else {
+ pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
+ }
+#endif /* __CYGWIN__ */
+ }
+ tsdPtr->eventReady = 0;
+
+#ifdef __CYGWIN__
+ while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
+ /*
+ * Retrieve and dispatch the message.
+ */
+
+ DWORD result = GetMessageW(&msg, NULL, 0, 0);
+
+ if (result == 0) {
+ PostQuitMessage(msg.wParam);
+ /* What to do here? */
+ } else if (result != (DWORD) -1) {
+ TranslateMessage(&msg);
+ DispatchMessageW(&msg);
+ }
+ }
+ ResetEvent(tsdPtr->event);
+#endif /* __CYGWIN__ */
+
+ if (waitForFiles && tsdPtr->onList) {
+ /*
+ * Remove the ThreadSpecificData structure of this thread from the
+ * waiting list. Alert the notifier thread to recompute its select
+ * masks - skipping this caused a hang when trying to close a pipe
+ * which the notifier thread was still doing a select on.
+ */
+
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
+ Tcl_Panic("Tcl_WaitForEvent: %s",
+ "unable to write to triggerPipe");
+ }
+ }
+#else /* !TCL_THREADS */
+ tsdPtr->readyMasks = tsdPtr->checkMasks;
+ numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
+ &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
+ timeoutPtr);
+
+ /*
+ * Some systems don't clear the masks after an error, so we have to do
+ * it here.
+ */
+
+ if (numFound == -1) {
+ FD_ZERO(&tsdPtr->readyMasks.readable);
+ FD_ZERO(&tsdPtr->readyMasks.writable);
+ FD_ZERO(&tsdPtr->readyMasks.exception);
+ }
+#endif /* TCL_THREADS */
+
+ /*
+ * Queue all detected file events before returning.
+ */
+
+ for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
+ filePtr = filePtr->nextPtr) {
+ mask = 0;
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
+ mask |= TCL_READABLE;
+ }
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
+ mask |= TCL_WRITABLE;
+ }
+ if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
+ mask |= TCL_EXCEPTION;
+ }
+
+ if (!mask) {
+ continue;
+ }
+
+ /*
+ * Don't bother to queue an event if the mask was previously
+ * non-zero since an event must still be on the queue.
+ */
+
+ if (filePtr->readyMask == 0) {
+ FileHandlerEvent *fileEvPtr =
+ ckalloc(sizeof(FileHandlerEvent));
+
+ fileEvPtr->header.proc = FileHandlerEventProc;
+ fileEvPtr->fd = filePtr->fd;
+ Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
+ }
+ filePtr->readyMask = mask;
+ }
+#if TCL_THREADS
+ pthread_mutex_unlock(&notifierMutex);
+#endif /* TCL_THREADS */
+ return 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifierThreadProc --
+ *
+ * This routine is the initial (and only) function executed by the
+ * special notifier thread. Its job is to wait for file descriptors to
+ * become readable or writable or to have an exception condition and then
+ * to notify other threads who are interested in this information by
+ * signalling a condition variable. Other threads can signal this
+ * notifier thread of a change in their interests by writing a single
+ * byte to a special pipe that the notifier thread is monitoring.
+ *
+ * Result:
+ * None. Once started, this routine never exits. It dies with the overall
+ * process.
+ *
+ * Side effects:
+ * The trigger pipe used to signal the notifier thread is created when
+ * the notifier thread first starts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#if TCL_THREADS
+static TCL_NORETURN void
+NotifierThreadProc(
+ ClientData clientData) /* Not used. */
+{
+ ThreadSpecificData *tsdPtr;
+ fd_set readableMask;
+ fd_set writableMask;
+ fd_set exceptionMask;
+ int i;
+ int fds[2], receivePipe;
+ long found;
+ struct timeval poll = {0., 0.}, *timePtr;
+ char buf[2];
+ int numFdBits = 0;
+
+ if (pipe(fds) != 0) {
+ Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
+ }
+
+ receivePipe = fds[0];
+
+ if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make receive pipe non blocking");
+ }
+ if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make trigger pipe non blocking");
+ }
+ if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) {
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make receive pipe close-on-exec");
+ }
+ if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) {
+ Tcl_Panic("NotifierThreadProc: %s",
+ "could not make trigger pipe close-on-exec");
+ }
+
+ /*
+ * Install the write end of the pipe into the global variable.
+ */
+
+ pthread_mutex_lock(&notifierMutex);
+ triggerPipe = fds[1];
+
+ /*
+ * Signal any threads that are waiting.
+ */
+
+ pthread_cond_broadcast(&notifierCV);
+ pthread_mutex_unlock(&notifierMutex);
+
+ /*
+ * Look for file events and report them to interested threads.
+ */
+
+ while (1) {
+ FD_ZERO(&readableMask);
+ FD_ZERO(&writableMask);
+ FD_ZERO(&exceptionMask);
+
+ /*
+ * Compute the logical OR of the masks from all the waiting
+ * notifiers.
+ */
+
+ pthread_mutex_lock(&notifierMutex);
+ timePtr = NULL;
+ for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
+ FD_SET(i, &readableMask);
+ }
+ if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
+ FD_SET(i, &writableMask);
+ }
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
+ FD_SET(i, &exceptionMask);
+ }
+ }
+ if (tsdPtr->numFdBits > numFdBits) {
+ numFdBits = tsdPtr->numFdBits;
+ }
+ if (tsdPtr->pollState & POLL_WANT) {
+ /*
+ * Here we make sure we go through select() with the same mask
+ * bits that were present when the thread tried to poll.
+ */
+
+ tsdPtr->pollState |= POLL_DONE;
+ timePtr = &poll;
+ }
+ }
+ pthread_mutex_unlock(&notifierMutex);
+
+ /*
+ * Set up the mask to include the receive pipe.
+ */
+
+ if (receivePipe >= numFdBits) {
+ numFdBits = receivePipe + 1;
+ }
+ FD_SET(receivePipe, &readableMask);
+
+ if (select(numFdBits, &readableMask, &writableMask, &exceptionMask,
+ timePtr) == -1) {
+ /*
+ * Try again immediately on an error.
+ */
+
+ continue;
+ }
+
+ /*
+ * Alert any threads that are waiting on a ready file descriptor.
+ */
+
+ pthread_mutex_lock(&notifierMutex);
+ for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
+ found = 0;
+
+ for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
+ if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
+ && FD_ISSET(i, &readableMask)) {
+ FD_SET(i, &tsdPtr->readyMasks.readable);
+ found = 1;
+ }
+ if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
+ && FD_ISSET(i, &writableMask)) {
+ FD_SET(i, &tsdPtr->readyMasks.writable);
+ found = 1;
+ }
+ if (FD_ISSET(i, &tsdPtr->checkMasks.exception)
+ && FD_ISSET(i, &exceptionMask)) {
+ FD_SET(i, &tsdPtr->readyMasks.exception);
+ found = 1;
+ }
+ }
+
+ if (found || (tsdPtr->pollState & POLL_DONE)) {
+ AlertSingleThread(tsdPtr);
+ }
+ }
+ pthread_mutex_unlock(&notifierMutex);
+
+ /*
+ * Consume the next byte from the notifier pipe if the pipe was
+ * readable. Note that there may be multiple bytes pending, but to
+ * avoid a race condition we only read one at a time.
+ */
+
+ do {
+ i = read(receivePipe, buf, 1);
+ if (i <= 0) {
+ break;
+ } else if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
+ /*
+ * Someone closed the write end of the pipe or sent us a Quit
+ * message [Bug: 4139] and then closed the write end of the
+ * pipe so we need to shut down the notifier thread.
+ */
+
+ break;
+ }
+ } while (1);
+ if ((i == 0) || (buf[0] == 'q')) {
+ break;
+ }
+ }
+
+ /*
+ * Clean up the read end of the pipe and signal any threads waiting on
+ * termination of the notifier thread.
+ */
+
+ close(receivePipe);
+ pthread_mutex_lock(&notifierMutex);
+ triggerPipe = -1;
+ pthread_cond_broadcast(&notifierCV);
+ pthread_mutex_unlock(&notifierMutex);
+
+ TclpThreadExit(0);
+}
+#endif /* TCL_THREADS */
+
+#endif /* (!NOTIFIER_EPOLL && !NOTIFIER_KQUEUE) || !TCL_THREADS */
+#endif /* !HAVE_COREFOUNDATION */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index b4b2739..435579a 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -61,7 +61,7 @@
* This structure describes per-instance state of a file based channel.
*/
-typedef struct FileState {
+typedef struct {
Tcl_Channel channel; /* Channel associated with this file. */
int fd; /* File handle. */
int validMask; /* OR'ed combination of TCL_READABLE,
@@ -76,7 +76,7 @@ typedef struct FileState {
* a platform-independant manner.
*/
-typedef struct TtyAttrs {
+typedef struct {
int baud;
int parity;
int data;
@@ -383,7 +383,7 @@ FileSeekProc(
*/
oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
- if (oldLoc == Tcl_LongAsWide(-1)) {
+ if (oldLoc == -1) {
/*
* Bad things are happening. Error out...
*/
@@ -398,14 +398,14 @@ FileSeekProc(
* Check for expressability in our return type, and roll-back otherwise.
*/
- if (newLoc > Tcl_LongAsWide(INT_MAX)) {
+ if (newLoc > INT_MAX) {
*errorCodePtr = EOVERFLOW;
TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
return -1;
} else {
- *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
+ *errorCodePtr = (newLoc == -1) ? errno : 0;
}
- return (int) Tcl_WideAsLong(newLoc);
+ return (int) newLoc;
}
/*
@@ -605,7 +605,6 @@ TtySetOptionProc(
return TCL_OK;
}
-
/*
* Option -handshake none|xonxoff|rtscts|dtrdsr
*/
@@ -706,6 +705,7 @@ TtySetOptionProc(
/*
* Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
*/
+
if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
#if defined(TIOCMGET) && defined(TIOCMSET)
int i, control, flag;
@@ -882,6 +882,7 @@ TtyGetOptionProc(
* 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;
@@ -894,12 +895,10 @@ TtyGetOptionProc(
if (valid) {
return TCL_OK;
}
- return Tcl_BadChannelOption(interp, optionName, "mode"
- " queue ttystatus xchar"
- );
+ return Tcl_BadChannelOption(interp, optionName,
+ "mode queue ttystatus xchar");
}
-
static const struct {int baud; speed_t speed;} speeds[] = {
#ifdef B0
{0, B0},
@@ -1023,7 +1022,7 @@ static const struct {int baud; speed_t speed;} speeds[] = {
#endif
{-1, 0}
};
-
+
/*
*---------------------------------------------------------------------------
*
@@ -1315,7 +1314,8 @@ TtyParseMode(
static void
TtyInit(
- int fd) /* Open file descriptor for serial port to be initialized. */
+ int fd) /* Open file descriptor for serial port to be
+ * initialized. */
{
struct termios iostate;
tcgetattr(fd, &iostate);
@@ -1325,8 +1325,7 @@ TtyInit(
|| iostate.c_lflag != 0
|| iostate.c_cflag & CREAD
|| iostate.c_cc[VMIN] != 1
- || iostate.c_cc[VTIME] != 0)
- {
+ || iostate.c_cc[VTIME] != 0) {
iostate.c_iflag = IGNBRK;
iostate.c_oflag = 0;
iostate.c_lflag = 0;
@@ -1726,166 +1725,6 @@ Tcl_GetOpenFile(
return TCL_ERROR;
}
-#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
- * in tclMacOSXNotify.c */
-/*
- *----------------------------------------------------------------------
- *
- * TclUnixWaitForFile --
- *
- * This function waits synchronously for a file to become readable or
- * writable, with an optional timeout.
- *
- * Results:
- * The return value is an OR'ed combination of TCL_READABLE,
- * TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
- * present on file at the time of the return. This function will not
- * return until either "timeout" milliseconds have elapsed or at least
- * one of the conditions given by mask has occurred for file (a return
- * value of 0 means that a timeout occurred). No normal events will be
- * serviced during the execution of this function.
- *
- * Side effects:
- * Time passes.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclUnixWaitForFile(
- int fd, /* Handle for file on which to wait. */
- int mask, /* What to wait for: OR'ed combination of
- * TCL_READABLE, TCL_WRITABLE, and
- * TCL_EXCEPTION. */
- int timeout) /* Maximum amount of time to wait for one of
- * the conditions in mask to occur, in
- * milliseconds. A value of 0 means don't wait
- * at all, and a value of -1 means wait
- * forever. */
-{
- Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
- struct timeval blockTime, *timeoutPtr;
- int numFound, result = 0;
- fd_set readableMask;
- fd_set writableMask;
- fd_set exceptionMask;
-
-#ifndef _DARWIN_C_SOURCE
- /*
- * Sanity check fd.
- */
-
- if (fd >= FD_SETSIZE) {
- Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
- /* must never get here, or select masks overrun will occur below */
- }
-#endif
-
- /*
- * If there is a non-zero finite timeout, compute the time when we give
- * up.
- */
-
- if (timeout > 0) {
- Tcl_GetTime(&now);
- abortTime.sec = now.sec + timeout/1000;
- abortTime.usec = now.usec + (timeout%1000)*1000;
- if (abortTime.usec >= 1000000) {
- abortTime.usec -= 1000000;
- abortTime.sec += 1;
- }
- timeoutPtr = &blockTime;
- } else if (timeout == 0) {
- timeoutPtr = &blockTime;
- blockTime.tv_sec = 0;
- blockTime.tv_usec = 0;
- } else {
- timeoutPtr = NULL;
- }
-
- /*
- * Initialize the select masks.
- */
-
- FD_ZERO(&readableMask);
- FD_ZERO(&writableMask);
- FD_ZERO(&exceptionMask);
-
- /*
- * Loop in a mini-event loop of our own, waiting for either the file to
- * become ready or a timeout to occur.
- */
-
- while (1) {
- if (timeout > 0) {
- blockTime.tv_sec = abortTime.sec - now.sec;
- blockTime.tv_usec = abortTime.usec - now.usec;
- if (blockTime.tv_usec < 0) {
- blockTime.tv_sec -= 1;
- blockTime.tv_usec += 1000000;
- }
- if (blockTime.tv_sec < 0) {
- blockTime.tv_sec = 0;
- blockTime.tv_usec = 0;
- }
- }
-
- /*
- * Setup the select masks for the fd.
- */
-
- if (mask & TCL_READABLE) {
- FD_SET(fd, &readableMask);
- }
- if (mask & TCL_WRITABLE) {
- FD_SET(fd, &writableMask);
- }
- if (mask & TCL_EXCEPTION) {
- FD_SET(fd, &exceptionMask);
- }
-
- /*
- * Wait for the event or a timeout.
- */
-
- numFound = select(fd + 1, &readableMask, &writableMask,
- &exceptionMask, timeoutPtr);
- if (numFound == 1) {
- if (FD_ISSET(fd, &readableMask)) {
- SET_BITS(result, TCL_READABLE);
- }
- if (FD_ISSET(fd, &writableMask)) {
- SET_BITS(result, TCL_WRITABLE);
- }
- if (FD_ISSET(fd, &exceptionMask)) {
- SET_BITS(result, TCL_EXCEPTION);
- }
- result &= mask;
- if (result) {
- break;
- }
- }
- if (timeout == 0) {
- break;
- }
- if (timeout < 0) {
- continue;
- }
-
- /*
- * The select returned early, so we need to recompute the timeout.
- */
-
- Tcl_GetTime(&now);
- if ((abortTime.sec < now.sec)
- || (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
- break;
- }
- }
- return result;
-}
-#endif /* HAVE_COREFOUNDATION */
-
/*
*----------------------------------------------------------------------
*
diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c
index 2a68f7f..aa25c6b 100644
--- a/unix/tclUnixCompat.c
+++ b/unix/tclUnixCompat.c
@@ -47,9 +47,9 @@
* library calls.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
-typedef struct ThreadSpecificData {
+typedef struct {
struct passwd pwd;
#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
#define NEED_PW_CLEANER 1
@@ -182,7 +182,7 @@ struct passwd *
TclpGetPwNam(
const char *name)
{
-#if !defined(TCL_THREADS)
+#if !TCL_THREADS
return getpwnam(name);
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -262,7 +262,7 @@ struct passwd *
TclpGetPwUid(
uid_t uid)
{
-#if !defined(TCL_THREADS)
+#if !TCL_THREADS
return getpwuid(uid);
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -365,7 +365,7 @@ struct group *
TclpGetGrNam(
const char *name)
{
-#if !defined(TCL_THREADS)
+#if !TCL_THREADS
return getgrnam(name);
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -445,7 +445,7 @@ struct group *
TclpGetGrGid(
gid_t gid)
{
-#if !defined(TCL_THREADS)
+#if !TCL_THREADS
return getgrgid(gid);
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -548,7 +548,7 @@ struct hostent *
TclpGetHostByName(
const char *name)
{
-#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
+#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYNAME)
return gethostbyname(name);
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -618,7 +618,7 @@ TclpGetHostByAddr(
int length,
int type)
{
-#if !defined(TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
+#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYADDR)
return gethostbyaddr(addr, length, type);
#else
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -988,8 +988,8 @@ CopyString(
int
TclWinCPUID(
- unsigned int index, /* Which CPUID value to retrieve. */
- unsigned int *regsPtr) /* Registers after the CPUID. */
+ int index, /* Which CPUID value to retrieve. */
+ int *regsPtr) /* Registers after the CPUID. */
{
int status = TCL_ERROR;
diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c
index ae20ee0..7205085 100644
--- a/unix/tclUnixFCmd.c
+++ b/unix/tclUnixFCmd.c
@@ -256,7 +256,7 @@ Realpath(
#endif /* PURIFY */
#ifndef NO_REALPATH
-#if defined(__APPLE__) && defined(TCL_THREADS) && \
+#if defined(__APPLE__) && TCL_THREADS && \
defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/*
@@ -1369,7 +1369,7 @@ GetGroupAttribute(
groupPtr = TclpGetGrGid(statBuf.st_gid);
if (groupPtr == NULL) {
- *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_gid);
+ *attributePtrPtr = Tcl_NewWideIntObj(statBuf.st_gid);
} else {
Tcl_DString ds;
const char *utf;
@@ -1423,7 +1423,7 @@ GetOwnerAttribute(
pwPtr = TclpGetPwUid(statBuf.st_uid);
if (pwPtr == NULL) {
- *attributePtrPtr = Tcl_NewIntObj((int) statBuf.st_uid);
+ *attributePtrPtr = Tcl_NewWideIntObj(statBuf.st_uid);
} else {
Tcl_DString ds;
@@ -1507,11 +1507,10 @@ SetGroupAttribute(
Tcl_DString ds;
struct group *groupPtr = NULL;
const char *string;
- int length;
- string = Tcl_GetStringFromObj(attributePtr, &length);
+ string = TclGetString(attributePtr);
- native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
+ native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
groupPtr = TclpGetGrNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -1574,11 +1573,10 @@ SetOwnerAttribute(
Tcl_DString ds;
struct passwd *pwPtr = NULL;
const char *string;
- int length;
- string = Tcl_GetStringFromObj(attributePtr, &length);
+ string = TclGetString(attributePtr);
- native = Tcl_UtfToExternalDString(NULL, string, length, &ds);
+ native = Tcl_UtfToExternalDString(NULL, string, attributePtr->length, &ds);
pwPtr = TclpGetPwNam(native); /* INTL: Native. */
Tcl_DStringFree(&ds);
@@ -1946,9 +1944,9 @@ TclpObjNormalizePath(
int nextCheckpoint)
{
const char *currentPathEndPosition;
- int pathLen;
char cur;
- const char *path = Tcl_GetStringFromObj(pathPtr, &pathLen);
+ const char *path = TclGetString(pathPtr);
+ size_t pathLen = pathPtr->length;
Tcl_DString ds;
const char *nativePath;
#ifndef NO_REALPATH
@@ -2177,15 +2175,15 @@ TclUnixOpenTemporaryFile(
{
Tcl_DString template, tmp;
const char *string;
- int len, fd;
+ int fd;
/*
* We should also check against making more then TMP_MAX of these.
*/
if (dirObj) {
- string = Tcl_GetStringFromObj(dirObj, &len);
- Tcl_UtfToExternalDString(NULL, string, len, &template);
+ string = TclGetString(dirObj);
+ Tcl_UtfToExternalDString(NULL, string, dirObj->length, &template);
} else {
Tcl_DStringInit(&template);
Tcl_DStringAppend(&template, DefaultTempDir(), -1); /* INTL: native */
@@ -2194,8 +2192,8 @@ TclUnixOpenTemporaryFile(
TclDStringAppendLiteral(&template, "/");
if (basenameObj) {
- string = Tcl_GetStringFromObj(basenameObj, &len);
- Tcl_UtfToExternalDString(NULL, string, len, &tmp);
+ string = TclGetString(basenameObj);
+ Tcl_UtfToExternalDString(NULL, string, basenameObj->length, &tmp);
TclDStringAppendDString(&template, &tmp);
Tcl_DStringFree(&tmp);
} else {
@@ -2206,8 +2204,8 @@ TclUnixOpenTemporaryFile(
#ifdef HAVE_MKSTEMPS
if (extensionObj) {
- string = Tcl_GetStringFromObj(extensionObj, &len);
- Tcl_UtfToExternalDString(NULL, string, len, &tmp);
+ string = TclGetString(extensionObj);
+ Tcl_UtfToExternalDString(NULL, string, extensionObj->length, &tmp);
TclDStringAppendDString(&template, &tmp);
fd = mkstemps(Tcl_DStringValue(&template), Tcl_DStringLength(&tmp));
Tcl_DStringFree(&tmp);
@@ -2304,7 +2302,8 @@ winPathFromObj(
}
static const int attributeArray[] = {
- 0x20, 0, 2, 0, 0, 1, 4};
+ 0x20, 0, 2, 0, 0, 1, 4
+};
/*
*----------------------------------------------------------------------
@@ -2341,8 +2340,8 @@ GetUnixFileAttributes(
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewIntObj((fileAttributes&attributeArray[objIndex])!=0);
-
+ *attributePtrPtr = Tcl_NewBooleanObj(
+ fileAttributes & attributeArray[objIndex]);
return TCL_OK;
}
@@ -2399,7 +2398,7 @@ SetUnixFileAttributes(
return TCL_ERROR;
}
- ckfree(winPath);
+ ckfree(winPath);
return TCL_OK;
}
#elif defined(HAVE_CHFLAGS) && defined(UF_IMMUTABLE)
@@ -2441,8 +2440,7 @@ GetUnixFileAttributes(
return TCL_ERROR;
}
- *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags&UF_IMMUTABLE);
-
+ *attributePtrPtr = Tcl_NewBooleanObj(statBuf.st_flags & UF_IMMUTABLE);
return TCL_OK;
}
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index 5684b16..8cb93b4 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -262,14 +262,15 @@ TclpMatchInDirectory(
TclDIR *d;
Tcl_DirEntry *entryPtr;
const char *dirName;
- int dirLength, nativeDirLen;
+ size_t dirLength, nativeDirLen;
int matchHidden, matchHiddenPat;
Tcl_StatBuf statBuf;
Tcl_DString ds; /* native encoding of dir */
Tcl_DString dsOrig; /* utf-8 encoding of dir */
Tcl_DStringInit(&dsOrig);
- dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+ dirName = TclGetString(fileNamePtr);
+ dirLength = fileNamePtr->length;
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
/*
@@ -937,7 +938,6 @@ TclpObjLink(
*/
if (linkAction & TCL_CREATE_SYMBOLIC_LINK) {
- int targetLen;
Tcl_DString ds;
Tcl_Obj *transPtr;
@@ -951,8 +951,8 @@ TclpObjLink(
if (transPtr == NULL) {
return NULL;
}
- target = Tcl_GetStringFromObj(transPtr, &targetLen);
- target = Tcl_UtfToExternalDString(NULL, target, targetLen, &ds);
+ target = TclGetString(transPtr);
+ target = Tcl_UtfToExternalDString(NULL, target, transPtr->length, &ds);
Tcl_DecrRefCount(transPtr);
if (symlink(target, src) != 0) {
@@ -1080,7 +1080,7 @@ TclNativeCreateNativeRep(
const char *str;
Tcl_DString ds;
Tcl_Obj *validPathPtr;
- int len;
+ size_t len;
if (TclFSCwdIsNative()) {
/*
@@ -1105,7 +1105,8 @@ TclNativeCreateNativeRep(
Tcl_IncrRefCount(validPathPtr);
}
- str = Tcl_GetStringFromObj(validPathPtr, &len);
+ str = TclGetString(validPathPtr);
+ len = validPathPtr->length;
Tcl_UtfToExternalDString(NULL, str, len, &ds);
len = Tcl_DStringLength(&ds) + sizeof(char);
if (strlen(Tcl_DStringValue(&ds)) < len - sizeof(char)) {
diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c
index 4fd41a7..b6b66da 100644
--- a/unix/tclUnixInit.c
+++ b/unix/tclUnixInit.c
@@ -39,11 +39,6 @@ DLLIMPORT extern __stdcall void FreeLibrary(void *);
DLLIMPORT extern __stdcall void *GetProcAddress(void *, const char *);
DLLIMPORT extern __stdcall void GetSystemInfo(void *);
-#define NUMPLATFORMS 4
-static const char *const platforms[NUMPLATFORMS] = {
- "Win32s", "Windows 95", "Windows NT", "Windows CE"
-};
-
#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
@@ -115,7 +110,7 @@ static char pkgPath[sizeof(TCL_PACKAGE_PATH)+200] = TCL_PACKAGE_PATH;
* first list checked for a mapping from env encoding to Tcl encoding name.
*/
-typedef struct LocaleTable {
+typedef struct {
const char *lang;
const char *encoding;
} LocaleTable;
@@ -321,7 +316,7 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp,
#endif /* HAVE_COREFOUNDATION */
#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \
- (defined(TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
+ (TCL_THREADS && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
(defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \
(defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\
)))
@@ -391,14 +386,6 @@ TclpInitPlatform(void)
#endif /* SIGPIPE */
#if defined(__FreeBSD__) && defined(__GNUC__)
- /*
- * Adjust the rounding mode to be more conventional. Note that FreeBSD
- * only provides the __fpsetreg() used by the following two for the GNU
- * Compiler. When using, say, Intel's icc they break. (Partially based on
- * patch in BSD ports system from root@celsius.bychok.com)
- */
-
- fpsetround(FP_RN);
(void) fpsetmask(0L);
#endif
@@ -461,7 +448,7 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 32
@@ -550,9 +537,10 @@ TclpInitLibraryPath(
Tcl_DStringFree(&buffer);
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
- str = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, str, (size_t)(*lengthPtr)+1);
+ str = TclGetString(pathPtr);
+ *lengthPtr = pathPtr->length;
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, str, *lengthPtr + 1);
Tcl_DecrRefCount(pathPtr);
}
@@ -589,12 +577,6 @@ TclpSetInitialEncodings(void)
Tcl_DStringFree(&encodingName);
}
-void
-TclpSetInterfaces(void)
-{
- /* do nothing */
-}
-
static const char *
SearchKnownEncodings(
const char *encoding)
@@ -775,7 +757,7 @@ InitMacLocaleInfoVar(
if (!Tcl_CreateNamespace(interp, "::tcl::mac", NULL, NULL)) {
Tcl_ResetResult(interp);
}
- Tcl_SetVar(interp, "::tcl::mac::locale", loc, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "::tcl::mac::locale", NULL, loc, TCL_GLOBAL_ONLY);
}
CFRelease(localeRef);
}
@@ -811,9 +793,9 @@ TclpSetVariables(
const char *str;
CFBundleRef bundleRef;
- Tcl_SetVar(interp, "tclDefaultLibrary", tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath, TCL_GLOBAL_ONLY);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tclDefaultLibrary", NULL, tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
str = TclGetEnv("DYLD_FRAMEWORK_PATH", &ds);
@@ -829,9 +811,9 @@ TclpSetVariables(
*p = ' ';
}
} while (*p++);
- Tcl_SetVar(interp, "tcl_pkgPath", Tcl_DStringValue(&ds),
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, Tcl_DStringValue(&ds),
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
Tcl_DStringFree(&ds);
}
@@ -846,9 +828,9 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
@@ -859,20 +841,20 @@ TclpSetVariables(
(unsigned char*) tclLibPath, MAXPATHLEN) &&
! TclOSstat(tclLibPath, &statBuf) &&
S_ISDIR(statBuf.st_mode)) {
- Tcl_SetVar(interp, "tcl_pkgPath", tclLibPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, tclLibPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
- Tcl_SetVar(interp, "tcl_pkgPath", " ",
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, " ",
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
}
CFRelease(frameworksURL);
}
}
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath,
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath,
TCL_GLOBAL_ONLY | TCL_APPEND_VALUE);
} else
#endif /* HAVE_COREFOUNDATION */
{
- Tcl_SetVar(interp, "tcl_pkgPath", pkgPath, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "tcl_pkgPath", NULL, pkgPath, TCL_GLOBAL_ONLY);
}
#ifdef DJGPP
@@ -897,10 +879,7 @@ TclpSetVariables(
GetSystemInfo(&sysInfo);
- if (osInfo.dwPlatformId < NUMPLATFORMS) {
- Tcl_SetVar2(interp, "tcl_platform", "os",
- platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
- }
+ Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
sprintf(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (sysInfo.wProcessorArchitecture < NUMPROCESSORS) {
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index a8dbebe..3817071 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -1,273 +1,41 @@
-#define AT_FORK_INIT_VALUE 0
-#define RESET_ATFORK_MUTEX 1
/*
- * tclUnixNotify.c --
+ * tclUnixNotfy.c --
*
- * This file contains the implementation of the select()-based
- * Unix-specific notifier, which is the lowest-level part of the Tcl
- * event loop. This file works together with generic/tclNotify.c.
+ * This file contains subroutines shared by all notifier backend
+ * implementations on *nix platforms.
*
* Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
+#include <poll.h>
#include "tclInt.h"
-#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
- * in tclMacOSXNotify.c */
-#include <signal.h>
-
-/*
- * This structure is used to keep track of the notifier info for a registered
- * file.
- */
-
-typedef struct FileHandler {
- int fd;
- int mask; /* Mask of desired events: TCL_READABLE,
- * etc. */
- int readyMask; /* Mask of events that have been seen since
- * the last time file handlers were invoked
- * for this file. */
- Tcl_FileProc *proc; /* Function to call, in the style of
- * Tcl_CreateFileHandler. */
- ClientData clientData; /* Argument to pass to proc. */
- struct FileHandler *nextPtr;/* Next in list of all files we care about. */
-} FileHandler;
-
-/*
- * The following structure is what is added to the Tcl event queue when file
- * handlers are ready to fire.
- */
-
-typedef struct FileHandlerEvent {
- Tcl_Event header; /* Information that is standard for all
- * events. */
- int fd; /* File descriptor that is ready. Used to find
- * the FileHandler structure for the file
- * (can't point directly to the FileHandler
- * structure because it could go away while
- * the event is queued). */
-} FileHandlerEvent;
-
-/*
- * The following structure contains a set of select() masks to track readable,
- * writable, and exception conditions.
- */
-
-typedef struct SelectMasks {
- fd_set readable;
- fd_set writable;
- fd_set exception;
-} SelectMasks;
-
-/*
- * The following static structure contains the state information for the
- * select based implementation of the Tcl notifier. One of these structures is
- * created for each thread that is using the notifier.
- */
-
-typedef struct ThreadSpecificData {
- FileHandler *firstFileHandlerPtr;
- /* Pointer to head of file handler list. */
- SelectMasks checkMasks; /* This structure is used to build up the
- * masks to be used in the next call to
- * select. Bits are set in response to calls
- * to Tcl_CreateFileHandler. */
- SelectMasks readyMasks; /* This array reflects the readable/writable
- * conditions that were found to exist by the
- * last call to select. */
- int numFdBits; /* Number of valid bits in checkMasks (one
- * more than highest fd for which
- * Tcl_WatchFile has been called). */
-#ifdef TCL_THREADS
- int onList; /* True if it is in this list */
- unsigned int pollState; /* pollState is used to implement a polling
- * handshake between each thread and the
- * notifier thread. Bits defined below. */
- struct ThreadSpecificData *nextPtr, *prevPtr;
- /* All threads that are currently waiting on
- * an event have their ThreadSpecificData
- * structure on a doubly-linked listed formed
- * from these pointers. You must hold the
- * notifierMutex lock before accessing these
- * fields. */
-#ifdef __CYGWIN__
- void *event; /* Any other thread alerts a notifier
- * that an event is ready to be processed
- * by sending this event. */
- void *hwnd; /* Messaging window. */
-#else /* !__CYGWIN__ */
- pthread_cond_t waitCV; /* Any other thread alerts a notifier that an
- * event is ready to be processed by signaling
- * this condition variable. */
-#endif /* __CYGWIN__ */
- int waitCVinitialized; /* Variable to flag initialization of the structure */
- int eventReady; /* True if an event is ready to be processed.
- * Used as condition flag together with waitCV
- * above. */
-#endif /* TCL_THREADS */
-} ThreadSpecificData;
-
-static Tcl_ThreadDataKey dataKey;
-
-#ifdef TCL_THREADS
-/*
- * The following static indicates the number of threads that have initialized
- * notifiers.
- *
- * You must hold the notifierMutex lock before accessing this variable.
- */
-
-static int notifierCount = 0;
-
-/*
- * The following variable points to the head of a doubly-linked list of
- * ThreadSpecificData structures for all threads that are currently waiting on
- * an event.
- *
- * You must hold the notifierMutex lock before accessing this list.
- */
-
-static ThreadSpecificData *waitingListPtr = NULL;
-
-/*
- * The notifier thread spends all its time in select() waiting for a file
- * descriptor associated with one of the threads on the waitingListPtr list to
- * do something interesting. But if the contents of the waitingListPtr list
- * ever changes, we need to wake up and restart the select() system call. You
- * can wake up the notifier thread by writing a single byte to the file
- * descriptor defined below. This file descriptor is the input-end of a pipe
- * and the notifier thread is listening for data on the output-end of the same
- * pipe. Hence writing to this file descriptor will cause the select() system
- * call to return and wake up the notifier thread.
- *
- * You must hold the notifierMutex lock before writing to the pipe.
- */
-
-static int triggerPipe = -1;
-
-/*
- * The notifierMutex locks access to all of the global notifier state.
- */
-
-static pthread_mutex_t notifierInitMutex = PTHREAD_MUTEX_INITIALIZER;
-static pthread_mutex_t notifierMutex = PTHREAD_MUTEX_INITIALIZER;
-/*
- * The following static indicates if the notifier thread is running.
- *
- * You must hold the notifierInitMutex before accessing this variable.
- */
-
-static int notifierThreadRunning = 0;
-
-/*
- * The notifier thread signals the notifierCV when it has finished
- * initializing the triggerPipe and right before the notifier thread
- * terminates.
- */
-
-static pthread_cond_t notifierCV = PTHREAD_COND_INITIALIZER;
-
-/*
- * The pollState bits
- * POLL_WANT is set by each thread before it waits on its condition
- * variable. It is checked by the notifier before it does select.
- * POLL_DONE is set by the notifier if it goes into select after seeing
- * POLL_WANT. The idea is to ensure it tries a select with the
- * same bits the initial thread had set.
- */
-
-#define POLL_WANT 0x1
-#define POLL_DONE 0x2
-
-/*
- * This is the thread ID of the notifier thread that does select.
- */
-
-static Tcl_ThreadId notifierThread;
-
-#endif /* TCL_THREADS */
/*
* Static routines defined in this file.
*/
-#ifdef TCL_THREADS
-static void NotifierThreadProc(ClientData clientData);
-#if defined(HAVE_PTHREAD_ATFORK)
-static int atForkInit = AT_FORK_INIT_VALUE;
-static void AtForkPrepare(void);
-static void AtForkParent(void);
-static void AtForkChild(void);
-#endif /* HAVE_PTHREAD_ATFORK */
-#endif /* TCL_THREADS */
-static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
-
-/*
- * Import of Windows API when building threaded with Cygwin.
- */
-
-#if defined(TCL_THREADS) && defined(__CYGWIN__)
-typedef struct {
- void *hwnd;
- unsigned int *message;
- int wParam;
- int lParam;
- int time;
- int x;
- int y;
-} MSG;
-
-typedef struct {
- unsigned int style;
- void *lpfnWndProc;
- int cbClsExtra;
- int cbWndExtra;
- void *hInstance;
- void *hIcon;
- void *hCursor;
- void *hbrBackground;
- void *lpszMenuName;
- const void *lpszClassName;
-} WNDCLASS;
-
-extern void __stdcall CloseHandle(void *);
-extern void *__stdcall CreateEventW(void *, unsigned char, unsigned char,
- void *);
-extern void * __stdcall CreateWindowExW(void *, const void *, const void *,
- DWORD, int, int, int, int, void *, void *, void *, void *);
-extern DWORD __stdcall DefWindowProcW(void *, int, void *, void *);
-extern unsigned char __stdcall DestroyWindow(void *);
-extern int __stdcall DispatchMessageW(const MSG *);
-extern unsigned char __stdcall GetMessageW(MSG *, void *, int, int);
-extern void __stdcall MsgWaitForMultipleObjects(DWORD, void *,
- unsigned char, DWORD, DWORD);
-extern unsigned char __stdcall PeekMessageW(MSG *, void *, int, int, int);
-extern unsigned char __stdcall PostMessageW(void *, unsigned int, void *,
- void *);
-extern void __stdcall PostQuitMessage(int);
-extern void *__stdcall RegisterClassW(const WNDCLASS *);
-extern unsigned char __stdcall ResetEvent(void *);
-extern unsigned char __stdcall TranslateMessage(const MSG *);
-
-/*
- * Threaded-cygwin specific constants and functions in this file:
- */
-
-static const WCHAR NotfyClassName[] = L"TclNotifier";
-static DWORD __stdcall NotifierProc(void *hwnd, unsigned int message,
- void *wParam, void *lParam);
-#endif /* TCL_THREADS && __CYGWIN__ */
+static int FileHandlerEventProc(Tcl_Event *evPtr, int flags);
+#if !TCL_THREADS
+# undef NOTIFIER_EPOLL
+# undef NOTIFIER_KQUEUE
+# define NOTIFIER_SELECT
+#elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)
+# define NOTIFIER_SELECT
+static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
+# if defined(HAVE_PTHREAD_ATFORK)
+static void AtForkChild(void);
+# endif /* HAVE_PTHREAD_ATFORK */
-#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
* StartNotifierThread --
*
- * Start a notfier thread and wait for the notifier pipe to be created.
+ * Start a notifier thread and wait for the notifier pipe to be created.
*
* Results:
* None.
@@ -303,169 +71,7 @@ StartNotifierThread(const char *proc)
pthread_mutex_unlock(&notifierInitMutex);
}
}
-#endif /* TCL_THREADS */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_InitNotifier --
- *
- * Initializes the platform specific notifier state.
- *
- * Results:
- * Returns a handle to the notifier state for this thread.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-ClientData
-Tcl_InitNotifier(void)
-{
- if (tclNotifierHooks.initNotifierProc) {
- return tclNotifierHooks.initNotifierProc();
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
-#ifdef TCL_THREADS
- tsdPtr->eventReady = 0;
-
- /*
- * Initialize thread specific condition variable for this thread.
- */
- if (tsdPtr->waitCVinitialized == 0) {
-#ifdef __CYGWIN__
- WNDCLASS class;
-
- class.style = 0;
- class.cbClsExtra = 0;
- class.cbWndExtra = 0;
- class.hInstance = TclWinGetTclInstance();
- class.hbrBackground = NULL;
- class.lpszMenuName = NULL;
- class.lpszClassName = NotfyClassName;
- class.lpfnWndProc = NotifierProc;
- class.hIcon = NULL;
- class.hCursor = NULL;
-
- RegisterClassW(&class);
- tsdPtr->hwnd = CreateWindowExW(NULL, class.lpszClassName,
- class.lpszClassName, 0, 0, 0, 0, 0, NULL, NULL,
- TclWinGetTclInstance(), NULL);
- tsdPtr->event = CreateEventW(NULL, 1 /* manual */,
- 0 /* !signaled */, NULL);
-#else
- pthread_cond_init(&tsdPtr->waitCV, NULL);
-#endif /* __CYGWIN__ */
- tsdPtr->waitCVinitialized = 1;
- }
-
- pthread_mutex_lock(&notifierInitMutex);
-#if defined(HAVE_PTHREAD_ATFORK)
- /*
- * Install pthread_atfork handlers to clean up the notifier in the
- * child of a fork.
- */
-
- if (!atForkInit) {
- int result = pthread_atfork(AtForkPrepare, AtForkParent, AtForkChild);
-
- if (result) {
- Tcl_Panic("Tcl_InitNotifier: pthread_atfork failed");
- }
- atForkInit = 1;
- }
-#endif /* HAVE_PTHREAD_ATFORK */
-
- notifierCount++;
-
- pthread_mutex_unlock(&notifierInitMutex);
-
-#endif /* TCL_THREADS */
- return tsdPtr;
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_FinalizeNotifier --
- *
- * This function is called to cleanup the notifier state before a thread
- * is terminated.
- *
- * Results:
- * None.
- *
- * Side effects:
- * May terminate the background notifier thread if this is the last
- * notifier instance.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_FinalizeNotifier(
- ClientData clientData) /* Not used. */
-{
- if (tclNotifierHooks.finalizeNotifierProc) {
- tclNotifierHooks.finalizeNotifierProc(clientData);
- return;
- } else {
-#ifdef TCL_THREADS
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- pthread_mutex_lock(&notifierInitMutex);
- notifierCount--;
-
- /*
- * If this is the last thread to use the notifier, close the notifier
- * pipe and wait for the background thread to terminate.
- */
-
- if (notifierCount == 0) {
-
- if (triggerPipe != -1) {
- if (write(triggerPipe, "q", 1) != 1) {
- Tcl_Panic("Tcl_FinalizeNotifier: %s",
- "unable to write q to triggerPipe");
- }
- close(triggerPipe);
- pthread_mutex_lock(&notifierMutex);
- while(triggerPipe != -1) {
- pthread_cond_wait(&notifierCV, &notifierMutex);
- }
- pthread_mutex_unlock(&notifierMutex);
- if (notifierThreadRunning) {
- int result = pthread_join((pthread_t) notifierThread, NULL);
-
- if (result) {
- Tcl_Panic("Tcl_FinalizeNotifier: unable to join notifier "
- "thread");
- }
- notifierThreadRunning = 0;
- }
- }
- }
-
- /*
- * Clean up any synchronization objects in the thread local storage.
- */
-
-#ifdef __CYGWIN__
- DestroyWindow(tsdPtr->hwnd);
- CloseHandle(tsdPtr->event);
-#else /* __CYGWIN__ */
- pthread_cond_destroy(&tsdPtr->waitCV);
-#endif /* __CYGWIN__ */
- tsdPtr->waitCVinitialized = 0;
-
- pthread_mutex_unlock(&notifierInitMutex);
-#endif /* TCL_THREADS */
- }
-}
+#endif /* NOTIFIER_SELECT */
/*
*----------------------------------------------------------------------
@@ -481,7 +87,13 @@ Tcl_FinalizeNotifier(
* None.
*
* Side effects:
- * Signals the notifier condition variable for the specified notifier.
+ * select(2) notifier:
+ * signals the notifier condition variable for the specified
+ * notifier.
+ * epoll(7) notifier:
+ * write(2)s to the eventfd(2) of the specified thread.
+ * kqueue(2) notifier:
+ * write(2)s to the trigger pipe(2) of the specified thread.
*
*----------------------------------------------------------------------
*/
@@ -494,7 +106,8 @@ Tcl_AlertNotifier(
tclNotifierHooks.alertNotifierProc(clientData);
return;
} else {
-#ifdef TCL_THREADS
+#ifdef NOTIFIER_SELECT
+#if TCL_THREADS
ThreadSpecificData *tsdPtr = clientData;
pthread_mutex_lock(&notifierMutex);
@@ -507,6 +120,22 @@ Tcl_AlertNotifier(
# endif /* __CYGWIN__ */
pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
+#else /* !NOTIFIER_SELECT */
+ ThreadSpecificData *tsdPtr = clientData;
+#if defined(NOTIFIER_EPOLL) && defined(HAVE_EVENTFD)
+ uint64_t eventFdVal = 1;
+ if (write(tsdPtr->triggerEventFd, &eventFdVal,
+ sizeof(eventFdVal)) != sizeof(eventFdVal)) {
+ Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerEventFd",
+ (void *)tsdPtr);
+ }
+#else
+ if (write(tsdPtr->triggerPipe[1], "", 1) != 1) {
+ Tcl_Panic("Tcl_AlertNotifier: unable to write to %p->triggerPipe",
+ (void *)tsdPtr);
+ }
+#endif /* NOTIFIER_EPOLL && HAVE_EVENTFD */
+#endif /* NOTIFIER_SELECT */
}
}
@@ -569,173 +198,11 @@ Tcl_ServiceModeHook(
tclNotifierHooks.serviceModeHookProc(mode);
return;
} else if (mode == TCL_SERVICE_ALL) {
+#ifdef NOTIFIER_SELECT
#if TCL_THREADS
StartNotifierThread("Tcl_ServiceModeHook");
#endif
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_CreateFileHandler --
- *
- * This function registers a file handler with the select notifier.
- *
- * Results:
- * None.
- *
- * Side effects:
- * Creates a new file handler structure.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_CreateFileHandler(
- int fd, /* Handle of stream to watch. */
- int mask, /* OR'ed combination of TCL_READABLE,
- * TCL_WRITABLE, and TCL_EXCEPTION: indicates
- * conditions under which proc should be
- * called. */
- Tcl_FileProc *proc, /* Function to call for each selected
- * event. */
- ClientData clientData) /* Arbitrary data to pass to proc. */
-{
- if (tclNotifierHooks.createFileHandlerProc) {
- tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
- return;
- } else {
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- FileHandler *filePtr;
-
- for (filePtr = tsdPtr->firstFileHandlerPtr; filePtr != NULL;
- filePtr = filePtr->nextPtr) {
- if (filePtr->fd == fd) {
- break;
- }
- }
- if (filePtr == NULL) {
- filePtr = ckalloc(sizeof(FileHandler));
- filePtr->fd = fd;
- filePtr->readyMask = 0;
- filePtr->nextPtr = tsdPtr->firstFileHandlerPtr;
- tsdPtr->firstFileHandlerPtr = filePtr;
- }
- filePtr->proc = proc;
- filePtr->clientData = clientData;
- filePtr->mask = mask;
-
- /*
- * Update the check masks for this file.
- */
-
- if (mask & TCL_READABLE) {
- FD_SET(fd, &tsdPtr->checkMasks.readable);
- } else {
- FD_CLR(fd, &tsdPtr->checkMasks.readable);
- }
- if (mask & TCL_WRITABLE) {
- FD_SET(fd, &tsdPtr->checkMasks.writable);
- } else {
- FD_CLR(fd, &tsdPtr->checkMasks.writable);
- }
- if (mask & TCL_EXCEPTION) {
- FD_SET(fd, &tsdPtr->checkMasks.exception);
- } else {
- FD_CLR(fd, &tsdPtr->checkMasks.exception);
- }
- if (tsdPtr->numFdBits <= fd) {
- tsdPtr->numFdBits = fd+1;
- }
- }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_DeleteFileHandler --
- *
- * Cancel a previously-arranged callback arrangement for a file.
- *
- * Results:
- * None.
- *
- * Side effects:
- * If a callback was previously registered on file, remove it.
- *
- *----------------------------------------------------------------------
- */
-
-void
-Tcl_DeleteFileHandler(
- int fd) /* Stream id for which to remove callback
- * function. */
-{
- if (tclNotifierHooks.deleteFileHandlerProc) {
- tclNotifierHooks.deleteFileHandlerProc(fd);
- return;
- } else {
- FileHandler *filePtr, *prevPtr;
- int i;
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- /*
- * Find the entry for the given file (and return if there isn't one).
- */
-
- for (prevPtr = NULL, filePtr = tsdPtr->firstFileHandlerPtr; ;
- prevPtr = filePtr, filePtr = filePtr->nextPtr) {
- if (filePtr == NULL) {
- return;
- }
- if (filePtr->fd == fd) {
- break;
- }
- }
-
- /*
- * Update the check masks for this file.
- */
-
- if (filePtr->mask & TCL_READABLE) {
- FD_CLR(fd, &tsdPtr->checkMasks.readable);
- }
- if (filePtr->mask & TCL_WRITABLE) {
- FD_CLR(fd, &tsdPtr->checkMasks.writable);
- }
- if (filePtr->mask & TCL_EXCEPTION) {
- FD_CLR(fd, &tsdPtr->checkMasks.exception);
- }
-
- /*
- * Find current max fd.
- */
-
- if (fd+1 == tsdPtr->numFdBits) {
- int numFdBits = 0;
-
- for (i = fd-1; i >= 0; i--) {
- if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
- || FD_ISSET(i, &tsdPtr->checkMasks.writable)
- || FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
- numFdBits = i+1;
- break;
- }
- }
- tsdPtr->numFdBits = numFdBits;
- }
-
- /*
- * Clean up information in the callback record.
- */
-
- if (prevPtr == NULL) {
- tsdPtr->firstFileHandlerPtr = filePtr->nextPtr;
- } else {
- prevPtr->nextPtr = filePtr->nextPtr;
- }
- ckfree(filePtr);
+#endif /* NOTIFIER_SELECT */
}
}
@@ -813,592 +280,62 @@ FileHandlerEventProc(
return 1;
}
-#if defined(TCL_THREADS) && defined(__CYGWIN__)
-
-static DWORD __stdcall
-NotifierProc(
- void *hwnd,
- unsigned int message,
- void *wParam,
- void *lParam)
-{
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- if (message != 1024) {
- return DefWindowProcW(hwnd, message, wParam, lParam);
- }
-
- /*
- * Process all of the runnable events.
- */
-
- tsdPtr->eventReady = 1;
- Tcl_ServiceAll();
- return 0;
-}
-#endif /* TCL_THREADS && __CYGWIN__ */
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_WaitForEvent --
- *
- * This function is called by Tcl_DoOneEvent to wait for new events on
- * the message queue. If the block time is 0, then Tcl_WaitForEvent just
- * polls without blocking.
- *
- * Results:
- * Returns -1 if the select would block forever, otherwise returns 0.
- *
- * Side effects:
- * Queues file events that are detected by the select.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_WaitForEvent(
- const Tcl_Time *timePtr) /* Maximum block time, or NULL. */
-{
- if (tclNotifierHooks.waitForEventProc) {
- return tclNotifierHooks.waitForEventProc(timePtr);
- } else {
- FileHandler *filePtr;
- int mask;
- Tcl_Time vTime;
-#ifdef TCL_THREADS
- int waitForFiles;
-# ifdef __CYGWIN__
- MSG msg;
-# endif /* __CYGWIN__ */
-#else
- /*
- * Impl. notes: timeout & timeoutPtr are used if, and only if threads
- * are not enabled. They are the arguments for the regular select()
- * used when the core is not thread-enabled.
- */
-
- struct timeval timeout, *timeoutPtr;
- int numFound;
-#endif /* TCL_THREADS */
- ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-
- /*
- * Set up the timeout structure. Note that if there are no events to
- * check for, we return with a negative result rather than blocking
- * forever.
- */
-
- if (timePtr != NULL) {
- /*
- * TIP #233 (Virtualized Time). Is virtual time in effect? And do
- * we actually have something to scale? If yes to both then we
- * call the handler to do this scaling.
- */
-
- if (timePtr->sec != 0 || timePtr->usec != 0) {
- vTime = *timePtr;
- tclScaleTimeProcPtr(&vTime, tclTimeClientData);
- timePtr = &vTime;
- }
-#ifndef TCL_THREADS
- timeout.tv_sec = timePtr->sec;
- timeout.tv_usec = timePtr->usec;
- timeoutPtr = &timeout;
- } else if (tsdPtr->numFdBits == 0) {
- /*
- * If there are no threads, no timeout, and no fds registered,
- * then there are no events possible and we must avoid deadlock.
- * Note that this is not entirely correct because there might be a
- * signal that could interrupt the select call, but we don't
- * handle that case if we aren't using threads.
- */
-
- return -1;
- } else {
- timeoutPtr = NULL;
-#endif /* !TCL_THREADS */
- }
-
-#ifdef TCL_THREADS
- /*
- * Start notifier thread and place this thread on the list of
- * interested threads, signal the notifier thread, and wait for a
- * response or a timeout.
- */
- StartNotifierThread("Tcl_WaitForEvent");
-
- pthread_mutex_lock(&notifierMutex);
-
- if (timePtr != NULL && timePtr->sec == 0 && (timePtr->usec == 0
-#if defined(__APPLE__) && defined(__LP64__)
- /*
- * On 64-bit Darwin, pthread_cond_timedwait() appears to have
- * a bug that causes it to wait forever when passed an
- * absolute time which has already been exceeded by the system
- * time; as a workaround, when given a very brief timeout,
- * just do a poll. [Bug 1457797]
- */
- || timePtr->usec < 10
-#endif /* __APPLE__ && __LP64__ */
- )) {
- /*
- * Cannot emulate a polling select with a polling condition
- * variable. Instead, pretend to wait for files and tell the
- * notifier thread what we are doing. The notifier thread makes
- * sure it goes through select with its select mask in the same
- * state as ours currently is. We block until that happens.
- */
-
- waitForFiles = 1;
- tsdPtr->pollState = POLL_WANT;
- timePtr = NULL;
- } else {
- waitForFiles = (tsdPtr->numFdBits > 0);
- tsdPtr->pollState = 0;
- }
-
- if (waitForFiles) {
- /*
- * Add the ThreadSpecificData structure of this thread to the list
- * of ThreadSpecificData structures of all threads that are
- * waiting on file events.
- */
-
- tsdPtr->nextPtr = waitingListPtr;
- if (waitingListPtr) {
- waitingListPtr->prevPtr = tsdPtr;
- }
- tsdPtr->prevPtr = 0;
- waitingListPtr = tsdPtr;
- tsdPtr->onList = 1;
-
- if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
- Tcl_Panic("Tcl_WaitForEvent: %s",
- "unable to write to triggerPipe");
- }
- }
-
- FD_ZERO(&tsdPtr->readyMasks.readable);
- FD_ZERO(&tsdPtr->readyMasks.writable);
- FD_ZERO(&tsdPtr->readyMasks.exception);
-
- if (!tsdPtr->eventReady) {
-#ifdef __CYGWIN__
- if (!PeekMessageW(&msg, NULL, 0, 0, 0)) {
- DWORD timeout;
-
- if (timePtr) {
- timeout = timePtr->sec * 1000 + timePtr->usec / 1000;
- } else {
- timeout = 0xFFFFFFFF;
- }
- pthread_mutex_unlock(&notifierMutex);
- MsgWaitForMultipleObjects(1, &tsdPtr->event, 0, timeout, 1279);
- pthread_mutex_lock(&notifierMutex);
- }
-#else
- if (timePtr != NULL) {
- Tcl_Time now;
- struct timespec ptime;
-
- 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(&tsdPtr->waitCV, &notifierMutex, &ptime);
- } else {
- pthread_cond_wait(&tsdPtr->waitCV, &notifierMutex);
- }
-#endif /* __CYGWIN__ */
- }
- tsdPtr->eventReady = 0;
-
-#ifdef __CYGWIN__
- while (PeekMessageW(&msg, NULL, 0, 0, 0)) {
- /*
- * Retrieve and dispatch the message.
- */
-
- DWORD result = GetMessageW(&msg, NULL, 0, 0);
-
- if (result == 0) {
- PostQuitMessage(msg.wParam);
- /* What to do here? */
- } else if (result != (DWORD) -1) {
- TranslateMessage(&msg);
- DispatchMessageW(&msg);
- }
- }
- ResetEvent(tsdPtr->event);
-#endif /* __CYGWIN__ */
-
- if (waitForFiles && tsdPtr->onList) {
- /*
- * Remove the ThreadSpecificData structure of this thread from the
- * waiting list. Alert the notifier thread to recompute its select
- * masks - skipping this caused a hang when trying to close a pipe
- * which the notifier thread was still doing a select on.
- */
-
- if (tsdPtr->prevPtr) {
- tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
- } else {
- waitingListPtr = tsdPtr->nextPtr;
- }
- if (tsdPtr->nextPtr) {
- tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
- }
- tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
- tsdPtr->onList = 0;
- if ((write(triggerPipe, "", 1) == -1) && (errno != EAGAIN)) {
- Tcl_Panic("Tcl_WaitForEvent: %s",
- "unable to write to triggerPipe");
- }
- }
-
-#else
- tsdPtr->readyMasks = tsdPtr->checkMasks;
- numFound = select(tsdPtr->numFdBits, &tsdPtr->readyMasks.readable,
- &tsdPtr->readyMasks.writable, &tsdPtr->readyMasks.exception,
- timeoutPtr);
-
- /*
- * Some systems don't clear the masks after an error, so we have to do
- * it here.
- */
-
- if (numFound == -1) {
- FD_ZERO(&tsdPtr->readyMasks.readable);
- FD_ZERO(&tsdPtr->readyMasks.writable);
- FD_ZERO(&tsdPtr->readyMasks.exception);
- }
-#endif /* TCL_THREADS */
-
- /*
- * Queue all detected file events before returning.
- */
-
- for (filePtr = tsdPtr->firstFileHandlerPtr; (filePtr != NULL);
- filePtr = filePtr->nextPtr) {
- mask = 0;
- if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.readable)) {
- mask |= TCL_READABLE;
- }
- if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.writable)) {
- mask |= TCL_WRITABLE;
- }
- if (FD_ISSET(filePtr->fd, &tsdPtr->readyMasks.exception)) {
- mask |= TCL_EXCEPTION;
- }
-
- if (!mask) {
- continue;
- }
-
- /*
- * Don't bother to queue an event if the mask was previously
- * non-zero since an event must still be on the queue.
- */
-
- if (filePtr->readyMask == 0) {
- FileHandlerEvent *fileEvPtr =
- ckalloc(sizeof(FileHandlerEvent));
-
- fileEvPtr->header.proc = FileHandlerEventProc;
- fileEvPtr->fd = filePtr->fd;
- Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
- }
- filePtr->readyMask = mask;
- }
-#ifdef TCL_THREADS
- pthread_mutex_unlock(&notifierMutex);
-#endif /* TCL_THREADS */
- return 0;
- }
-}
-
-#ifdef TCL_THREADS
+#ifdef NOTIFIER_SELECT
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
- * NotifierThreadProc --
+ * AlertSingleThread --
*
- * This routine is the initial (and only) function executed by the
- * special notifier thread. Its job is to wait for file descriptors to
- * become readable or writable or to have an exception condition and then
- * to notify other threads who are interested in this information by
- * signalling a condition variable. Other threads can signal this
- * notifier thread of a change in their interests by writing a single
- * byte to a special pipe that the notifier thread is monitoring.
+ * Notify a single thread that is waiting on a file descriptor to become
+ * readable or writable or to have an exception condition.
+ * notifierMutex must be held.
*
* Result:
- * None. Once started, this routine never exits. It dies with the overall
- * process.
+ * None.
*
* Side effects:
- * The trigger pipe used to signal the notifier thread is created when
- * the notifier thread first starts.
+ * The condition variable associated with the thread is broadcasted.
*
*----------------------------------------------------------------------
*/
static void
-NotifierThreadProc(
- ClientData clientData) /* Not used. */
+AlertSingleThread(
+ ThreadSpecificData *tsdPtr)
{
- ThreadSpecificData *tsdPtr;
- fd_set readableMask;
- fd_set writableMask;
- fd_set exceptionMask;
- int fds[2];
- int i, numFdBits = 0, receivePipe;
- long found;
- struct timeval poll = {0., 0.}, *timePtr;
- char buf[2];
-
- if (pipe(fds) != 0) {
- Tcl_Panic("NotifierThreadProc: %s", "could not create trigger pipe");
- }
-
- receivePipe = fds[0];
-
- if (TclUnixSetBlockingMode(receivePipe, TCL_MODE_NONBLOCKING) < 0) {
- Tcl_Panic("NotifierThreadProc: %s",
- "could not make receive pipe non blocking");
- }
- if (TclUnixSetBlockingMode(fds[1], TCL_MODE_NONBLOCKING) < 0) {
- Tcl_Panic("NotifierThreadProc: %s",
- "could not make trigger pipe non blocking");
- }
- if (fcntl(receivePipe, F_SETFD, FD_CLOEXEC) < 0) {
- Tcl_Panic("NotifierThreadProc: %s",
- "could not make receive pipe close-on-exec");
- }
- if (fcntl(fds[1], F_SETFD, FD_CLOEXEC) < 0) {
- Tcl_Panic("NotifierThreadProc: %s",
- "could not make trigger pipe close-on-exec");
+ tsdPtr->eventReady = 1;
+ if (tsdPtr->onList) {
+ /*
+ * Remove the ThreadSpecificData structure of this thread from the
+ * waiting list. This prevents us from continuously spinning on
+ * epoll_wait until the other threads runs and services the file
+ * event.
+ */
+
+ if (tsdPtr->prevPtr) {
+ tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
+ } else {
+ waitingListPtr = tsdPtr->nextPtr;
+ }
+ if (tsdPtr->nextPtr) {
+ tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
+ }
+ tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
+ tsdPtr->onList = 0;
+ tsdPtr->pollState = 0;
}
-
- /*
- * Install the write end of the pipe into the global variable.
- */
-
- pthread_mutex_lock(&notifierMutex);
- triggerPipe = fds[1];
-
- /*
- * Signal any threads that are waiting.
- */
-
- pthread_cond_broadcast(&notifierCV);
- pthread_mutex_unlock(&notifierMutex);
-
- /*
- * Look for file events and report them to interested threads.
- */
-
- while (1) {
- FD_ZERO(&readableMask);
- FD_ZERO(&writableMask);
- FD_ZERO(&exceptionMask);
-
- /*
- * Compute the logical OR of the select masks from all the waiting
- * notifiers.
- */
-
- pthread_mutex_lock(&notifierMutex);
- timePtr = NULL;
- for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
- for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &tsdPtr->checkMasks.readable)) {
- FD_SET(i, &readableMask);
- }
- if (FD_ISSET(i, &tsdPtr->checkMasks.writable)) {
- FD_SET(i, &writableMask);
- }
- if (FD_ISSET(i, &tsdPtr->checkMasks.exception)) {
- FD_SET(i, &exceptionMask);
- }
- }
- if (tsdPtr->numFdBits > numFdBits) {
- numFdBits = tsdPtr->numFdBits;
- }
- if (tsdPtr->pollState & POLL_WANT) {
- /*
- * Here we make sure we go through select() with the same mask
- * bits that were present when the thread tried to poll.
- */
-
- tsdPtr->pollState |= POLL_DONE;
- timePtr = &poll;
- }
- }
- pthread_mutex_unlock(&notifierMutex);
-
- /*
- * Set up the select mask to include the receive pipe.
- */
-
- if (receivePipe >= numFdBits) {
- numFdBits = receivePipe + 1;
- }
- FD_SET(receivePipe, &readableMask);
-
- if (select(numFdBits, &readableMask, &writableMask, &exceptionMask,
- timePtr) == -1) {
- /*
- * Try again immediately on an error.
- */
-
- continue;
- }
-
- /*
- * Alert any threads that are waiting on a ready file descriptor.
- */
-
- pthread_mutex_lock(&notifierMutex);
- for (tsdPtr = waitingListPtr; tsdPtr; tsdPtr = tsdPtr->nextPtr) {
- found = 0;
-
- for (i = tsdPtr->numFdBits-1; i >= 0; --i) {
- if (FD_ISSET(i, &tsdPtr->checkMasks.readable)
- && FD_ISSET(i, &readableMask)) {
- FD_SET(i, &tsdPtr->readyMasks.readable);
- found = 1;
- }
- if (FD_ISSET(i, &tsdPtr->checkMasks.writable)
- && FD_ISSET(i, &writableMask)) {
- FD_SET(i, &tsdPtr->readyMasks.writable);
- found = 1;
- }
- if (FD_ISSET(i, &tsdPtr->checkMasks.exception)
- && FD_ISSET(i, &exceptionMask)) {
- FD_SET(i, &tsdPtr->readyMasks.exception);
- found = 1;
- }
- }
-
- if (found || (tsdPtr->pollState & POLL_DONE)) {
- tsdPtr->eventReady = 1;
- if (tsdPtr->onList) {
- /*
- * Remove the ThreadSpecificData structure of this thread
- * from the waiting list. This prevents us from
- * continuously spining on select until the other threads
- * runs and services the file event.
- */
-
- if (tsdPtr->prevPtr) {
- tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
- } else {
- waitingListPtr = tsdPtr->nextPtr;
- }
- if (tsdPtr->nextPtr) {
- tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
- }
- tsdPtr->nextPtr = tsdPtr->prevPtr = NULL;
- tsdPtr->onList = 0;
- tsdPtr->pollState = 0;
- }
#ifdef __CYGWIN__
- PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
-#else /* __CYGWIN__ */
- pthread_cond_broadcast(&tsdPtr->waitCV);
+ PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
+#else /* !__CYGWIN__ */
+ pthread_cond_broadcast(&tsdPtr->waitCV);
#endif /* __CYGWIN__ */
- }
- }
- pthread_mutex_unlock(&notifierMutex);
-
- /*
- * Consume the next byte from the notifier pipe if the pipe was
- * readable. Note that there may be multiple bytes pending, but to
- * avoid a race condition we only read one at a time.
- */
-
- if (FD_ISSET(receivePipe, &readableMask)) {
- i = read(receivePipe, buf, 1);
-
- if ((i == 0) || ((i == 1) && (buf[0] == 'q'))) {
- /*
- * Someone closed the write end of the pipe or sent us a Quit
- * message [Bug: 4139] and then closed the write end of the
- * pipe so we need to shut down the notifier thread.
- */
-
- break;
- }
- }
- }
-
- /*
- * Clean up the read end of the pipe and signal any threads waiting on
- * termination of the notifier thread.
- */
-
- close(receivePipe);
- pthread_mutex_lock(&notifierMutex);
- triggerPipe = -1;
- pthread_cond_broadcast(&notifierCV);
- pthread_mutex_unlock(&notifierMutex);
-
- TclpThreadExit(0);
}
#if defined(HAVE_PTHREAD_ATFORK)
/*
*----------------------------------------------------------------------
*
- * AtForkPrepare --
- *
- * Lock the notifier in preparation for a fork.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AtForkPrepare(void)
-{
-#if RESET_ATFORK_MUTEX == 0
- pthread_mutex_lock(&notifierInitMutex);
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * AtForkParent --
- *
- * Unlock the notifier in the parent after a fork.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-AtForkParent(void)
-{
-#if RESET_ATFORK_MUTEX == 0
- pthread_mutex_unlock(&notifierInitMutex);
-#endif
-}
-
-/*
- *----------------------------------------------------------------------
- *
* AtForkChild --
*
* Unlock and reinstall the notifier in the child after a fork.
@@ -1418,18 +355,15 @@ AtForkChild(void)
if (notifierThreadRunning == 1) {
pthread_cond_destroy(&notifierCV);
}
-#if RESET_ATFORK_MUTEX == 0
- pthread_mutex_unlock(&notifierInitMutex);
-#else
pthread_mutex_init(&notifierInitMutex, NULL);
pthread_mutex_init(&notifierMutex, NULL);
-#endif
pthread_cond_init(&notifierCV, NULL);
/*
- * notifierThreadRunning == 1: thread is running, (there might be data in notifier lists)
+ * notifierThreadRunning == 1: thread is running, (there might be data in
+ * notifier lists)
* atForkInit == 0: InitNotifier was never called
- * notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls
+ * notifierCount != 0: unbalanced InitNotifier() / FinalizeNotifier calls
* waitingListPtr != 0: there are threads currently waiting for events.
*/
@@ -1450,19 +384,20 @@ AtForkChild(void)
waitingListPtr = NULL;
/*
- * The tsdPtr from before the fork is copied as well. But since
- * we are paranoic, we don't trust its condvar and reset it.
+ * The tsdPtr from before the fork is copied as well. But since we
+ * are paranoic, we don't trust its condvar and reset it.
*/
#ifdef __CYGWIN__
DestroyWindow(tsdPtr->hwnd);
- tsdPtr->hwnd = CreateWindowExW(NULL, NotfyClassName,
- NotfyClassName, 0, 0, 0, 0, 0, NULL, NULL,
+ tsdPtr->hwnd = CreateWindowExW(NULL, className,
+ className, 0, 0, 0, 0, 0, NULL, NULL,
TclWinGetTclInstance(), NULL);
ResetEvent(tsdPtr->event);
-#else
+#else /* !__CYGWIN__ */
pthread_cond_destroy(&tsdPtr->waitCV);
pthread_cond_init(&tsdPtr->waitCV, NULL);
-#endif
+#endif /* __CYGWIN__ */
+
/*
* In case, we had multiple threads running before the fork,
* make sure, we don't try to reach out to their thread local data.
@@ -1482,8 +417,155 @@ AtForkChild(void)
#endif /* TCL_THREADS */
-#endif /* !HAVE_COREFOUNDATION */
+#endif /* NOTIFIER_SELECT */
+#ifndef HAVE_COREFOUNDATION /* Darwin/Mac OS X CoreFoundation notifier is
+ * in tclMacOSXNotify.c */
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclUnixWaitForFile --
+ *
+ * This function waits synchronously for a file to become readable or
+ * writable, with an optional timeout.
+ *
+ * Results:
+ * The return value is an OR'ed combination of TCL_READABLE,
+ * TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
+ * present on file at the time of the return. This function will not
+ * return until either "timeout" milliseconds have elapsed or at least
+ * one of the conditions given by mask has occurred for file (a return
+ * value of 0 means that a timeout occurred). No normal events will be
+ * serviced during the execution of this function.
+ *
+ * Side effects:
+ * Time passes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclUnixWaitForFile(
+ int fd, /* Handle for file on which to wait. */
+ int mask, /* What to wait for: OR'ed combination of
+ * TCL_READABLE, TCL_WRITABLE, and
+ * TCL_EXCEPTION. */
+ int timeout) /* Maximum amount of time to wait for one of
+ * the conditions in mask to occur, in
+ * milliseconds. A value of 0 means don't wait
+ * at all, and a value of -1 means wait
+ * forever. */
+{
+ Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
+ struct timeval blockTime, *timeoutPtr;
+ struct pollfd pollFds[1];
+ int numFound, result = 0, pollTimeout;
+
+ /*
+ * If there is a non-zero finite timeout, compute the time when we give
+ * up.
+ */
+
+ if (timeout > 0) {
+ Tcl_GetTime(&now);
+ abortTime.sec = now.sec + timeout / 1000;
+ abortTime.usec = now.usec + (timeout % 1000) * 1000;
+ if (abortTime.usec >= 1000000) {
+ abortTime.usec -= 1000000;
+ abortTime.sec += 1;
+ }
+ timeoutPtr = &blockTime;
+ } else if (timeout == 0) {
+ timeoutPtr = &blockTime;
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ } else {
+ timeoutPtr = NULL;
+ }
+
+ /*
+ * Setup the pollfd structure for the fd.
+ */
+
+ pollFds[0].fd = fd;
+ pollFds[0].events = pollFds[0].revents = 0;
+ if (mask & TCL_READABLE) {
+ pollFds[0].events |= (POLLIN | POLLHUP);
+ }
+ if (mask & TCL_WRITABLE) {
+ pollFds[0].events |= POLLOUT;
+ }
+ if (mask & TCL_EXCEPTION) {
+ pollFds[0].events |= POLLERR;
+ }
+
+ /*
+ * Loop in a mini-event loop of our own, waiting for either the file to
+ * become ready or a timeout to occur.
+ */
+
+ do {
+ if (timeout > 0) {
+ blockTime.tv_sec = abortTime.sec - now.sec;
+ blockTime.tv_usec = abortTime.usec - now.usec;
+ if (blockTime.tv_usec < 0) {
+ blockTime.tv_sec -= 1;
+ blockTime.tv_usec += 1000000;
+ }
+ if (blockTime.tv_sec < 0) {
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ }
+ }
+
+ /*
+ * Wait for the event or a timeout.
+ */
+
+ if (!timeoutPtr) {
+ pollTimeout = -1;
+ } else if (!timeoutPtr->tv_sec && !timeoutPtr->tv_usec) {
+ pollTimeout = 0;
+ } else {
+ pollTimeout = (int) timeoutPtr->tv_sec * 1000;
+ if (timeoutPtr->tv_usec) {
+ pollTimeout += (int) timeoutPtr->tv_usec / 1000;
+ }
+ }
+ numFound = poll(pollFds, 1, pollTimeout);
+ if (numFound == 1) {
+ result = 0;
+ if (pollFds[0].revents & (POLLIN | POLLHUP)) {
+ result |= TCL_READABLE;
+ }
+ if (pollFds[0].revents & POLLOUT) {
+ result |= TCL_WRITABLE;
+ }
+ if (pollFds[0].revents & POLLERR) {
+ result |= TCL_EXCEPTION;
+ }
+ if (result) {
+ break;
+ }
+ }
+ if (timeout == 0) {
+ break;
+ }
+ if (timeout < 0) {
+ continue;
+ }
+
+ /*
+ * The select returned early, so we need to recompute the timeout.
+ */
+
+ Tcl_GetTime(&now);
+ } while ((abortTime.sec > now.sec)
+ || (abortTime.sec == now.sec && abortTime.usec > now.usec));
+ return result;
+}
+#endif /* !HAVE_COREFOUNDATION */
+
/*
* Local Variables:
* mode: c
diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c
index 8b26694..93faec8 100644
--- a/unix/tclUnixPipe.c
+++ b/unix/tclUnixPipe.c
@@ -30,7 +30,7 @@
* This structure describes per-instance state of a pipe based channel.
*/
-typedef struct PipeState {
+typedef struct {
Tcl_Channel channel; /* Channel associated with this file. */
TclFile inFile; /* Output from pipe. */
TclFile outFile; /* Input to pipe. */
@@ -872,7 +872,7 @@ TclGetAndDetachPids(
pipePtr = Tcl_GetChannelInstanceData(chan);
TclNewObj(pidsObj);
for (i = 0; i < pipePtr->numPids; i++) {
- Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewIntObj(
+ Tcl_ListObjAppendElement(NULL, pidsObj, Tcl_NewWideIntObj(
PTR2INT(pipePtr->pidPtr[i])));
Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
}
@@ -1268,7 +1268,7 @@ Tcl_PidObjCmd(
}
if (objc == 1) {
- Tcl_SetObjResult(interp, Tcl_NewLongObj((long) getpid()));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(getpid()));
} else {
/*
* Get the channel and make sure that it refers to a pipe.
@@ -1290,7 +1290,7 @@ Tcl_PidObjCmd(
resultPtr = Tcl_NewObj();
for (i = 0; i < pipePtr->numPids; i++) {
Tcl_ListObjAppendElement(NULL, resultPtr,
- Tcl_NewIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
+ Tcl_NewWideIntObj(PTR2INT(TclpGetPid(pipePtr->pidPtr[i]))));
}
Tcl_SetObjResult(interp, resultPtr);
}
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index af0b4dc..c982585 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -156,13 +156,9 @@ typedef off_t Tcl_SeekOffset;
#ifdef HAVE_STDINT_H
# include <stdint.h>
#endif
-#ifdef HAVE_UNISTD_H
-# include <unistd.h>
-#else
-# include "../compat/unistd.h"
-#endif
+#include <unistd.h>
-extern int TclUnixSetBlockingMode(int fd, int mode);
+MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
#include <utime.h>
@@ -192,13 +188,7 @@ extern int TclUnixSetBlockingMode(int fd, int mode);
*---------------------------------------------------------------------------
*/
-#ifndef NO_FLOAT_H
-# include <float.h>
-#else
-#ifndef NO_VALUES_H
-# include <values.h>
-#endif
-#endif
+#include <float.h>
#ifndef FLT_MAX
# ifdef MAXFLOAT
@@ -619,10 +609,8 @@ extern char ** environ;
# undef HAVE_COPYFILE
# endif
# if MAC_OS_X_VERSION_MAX_ALLOWED < 1030
-# ifdef TCL_THREADS
- /* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
-# define NO_REALPATH 1
-# endif
+ /* prior to 10.3, realpath is not threadsafe, c.f. bug 711232 */
+# define NO_REALPATH 1
# undef HAVE_LANGINFO
# endif
# endif /* MAC_OS_X_VERSION_MAX_ALLOWED */
@@ -695,7 +683,7 @@ typedef int socklen_t;
#define TclpExit exit
-#ifdef TCL_THREADS
+#if !defined(TCL_THREADS) || TCL_THREADS
# include <pthread.h>
#endif /* TCL_THREADS */
@@ -715,14 +703,14 @@ typedef int socklen_t;
#include <pwd.h>
#include <grp.h>
-extern struct passwd * TclpGetPwNam(const char *name);
-extern struct group * TclpGetGrNam(const char *name);
-extern struct passwd * TclpGetPwUid(uid_t uid);
-extern struct group * TclpGetGrGid(gid_t gid);
-extern struct hostent * TclpGetHostByName(const char *name);
-extern struct hostent * TclpGetHostByAddr(const char *addr,
+MODULE_SCOPE struct passwd * TclpGetPwNam(const char *name);
+MODULE_SCOPE struct group * TclpGetGrNam(const char *name);
+MODULE_SCOPE struct passwd * TclpGetPwUid(uid_t uid);
+MODULE_SCOPE struct group * TclpGetGrGid(gid_t gid);
+MODULE_SCOPE struct hostent * TclpGetHostByName(const char *name);
+MODULE_SCOPE struct hostent * TclpGetHostByAddr(const char *addr,
int length, int type);
-extern void *TclpMakeTcpClientChannelMode(
+MODULE_SCOPE void *TclpMakeTcpClientChannelMode(
void *tcpSocket, int mode);
#endif /* _TCLUNIXPORT */
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 90c72c0..bd54a2e 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -53,6 +53,8 @@ typedef struct TcpFdList {
struct TcpState {
Tcl_Channel channel; /* Channel associated with this file. */
+ int testFlags; /* bit field for tests. Is set by testsocket
+ * test procedure */
TcpFdList fds; /* The file descriptors of the sockets. */
int flags; /* ORed combination of the bitfields defined
* below. */
@@ -94,6 +96,15 @@ struct TcpState {
#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */
/*
+ * These bits may be ORed together into the "testFlags" field of a TcpState
+ * structure.
+ */
+
+#define TCP_ASYNC_TEST_MODE (1<<0) /* Async testing activated. Do not
+ * automatically continue connection
+ * process. */
+
+/*
* The following defines the maximum length of the listen queue. This is the
* number of outstanding yet-to-be-serviced requests for a connection on a
* server socket, more than this number of outstanding requests and the
@@ -206,7 +217,7 @@ printaddrinfo(
static void
InitializeHostName(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
const char *native = NULL;
@@ -242,9 +253,6 @@ InitializeHostName(
native = u.nodename;
}
}
- if (native == NULL) {
- native = tclEmptyStringRep;
- }
#else /* !NO_UNAME */
/*
* Uname doesn't exist; try gethostname instead.
@@ -273,9 +281,15 @@ InitializeHostName(
#endif /* NO_UNAME */
*encodingPtr = Tcl_GetEncoding(NULL, NULL);
- *lengthPtr = strlen(native);
- *valuePtr = ckalloc(*lengthPtr + 1);
- memcpy(*valuePtr, native, (size_t)(*lengthPtr) + 1);
+ if (native) {
+ *lengthPtr = strlen(native);
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, native, *lengthPtr + 1);
+ } else {
+ *lengthPtr = 0;
+ *valuePtr = ckalloc(1);
+ *valuePtr[0] = '\0';
+ }
}
/*
@@ -445,6 +459,20 @@ WaitForConnect(
return 0;
}
+ /*
+ * In socket test mode do not continue with the connect.
+ * Exceptions are:
+ * - Call by recv/send and blocking socket
+ * (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING))
+ */
+
+ if (GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)
+ && !(errorCodePtr != NULL
+ && !GOT_BITS(statePtr->flags, TCP_NONBLOCKING))) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ }
+
if (errorCodePtr == NULL || GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
timeout = 0;
} else {
@@ -1470,7 +1498,7 @@ TclpMakeTcpClientChannelMode(
/*
*----------------------------------------------------------------------
*
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpServerEx --
*
* Opens a TCP server socket and creates a channel around it.
*
@@ -1485,16 +1513,17 @@ TclpMakeTcpClientChannelMode(
*/
Tcl_Channel
-Tcl_OpenTcpServer(
+Tcl_OpenTcpServerEx(
Tcl_Interp *interp, /* For error reporting - may be NULL. */
- int port, /* Port number to open. */
+ const char *service, /* Port number to open. */
const char *myHost, /* Name of local host. */
+ unsigned int flags, /* Flags. */
Tcl_TcpAcceptProc *acceptProc,
/* Callback for accepting connections from new
* clients. */
ClientData acceptProcData) /* Data for the callback. */
{
- int status = 0, sock = -1, reuseaddr = 1, chosenport = 0;
+ int status = 0, sock = -1, optvalue, port, chosenport;
struct addrinfo *addrlist = NULL, *addrPtr; /* socket address */
TcpState *statePtr = NULL;
char channelName[SOCK_CHAN_LENGTH];
@@ -1509,7 +1538,45 @@ Tcl_OpenTcpServer(
enum { LOOKUP, SOCKET, BIND, LISTEN } howfar = LOOKUP;
int my_errno = 0;
- if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
+ /*
+ * If we were called with port 0 to listen on a random port number, we
+ * copy the port number from the first member of the addrinfo list to all
+ * subsequent members, so that IPv4 and IPv6 listen on the same port. This
+ * might fail to bind() with EADDRINUSE if a port is free on the first
+ * address family in the list but already used on the other. In this case
+ * we revert everything we've done so far and start from scratch hoping
+ * that next time we'll find a port number that is usable on all address
+ * families. We try this at most MAXRETRY times to avoid an endless loop
+ * if all ports are taken.
+ */
+
+ int retry = 0;
+#define MAXRETRY 10
+
+ repeat:
+ if (retry > 0) {
+ if (statePtr != NULL) {
+ TcpCloseProc(statePtr, NULL);
+ statePtr = NULL;
+ }
+ if (addrlist != NULL) {
+ freeaddrinfo(addrlist);
+ addrlist = NULL;
+ }
+ if (retry >= MAXRETRY) {
+ goto error;
+ }
+ }
+ retry++;
+ chosenport = 0;
+
+ if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
+ errorMsg = "invalid port number";
+ goto error;
+ }
+
+ if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1,
+ &errorMsg)) {
my_errno = errno;
goto error;
}
@@ -1539,12 +1606,30 @@ Tcl_OpenTcpServer(
TclSockMinimumBuffers(INT2PTR(sock), SOCKET_BUFSIZE);
/*
- * Set up to reuse server addresses automatically and bind to the
- * specified port.
+ * Set up to reuse server addresses and/or ports if requested.
*/
- (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
- (char *) &reuseaddr, sizeof(reuseaddr));
+ if (GOT_BITS(flags, TCL_TCPSERVER_REUSEADDR)) {
+ optvalue = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &optvalue, sizeof(optvalue));
+ }
+
+ if (GOT_BITS(flags, TCL_TCPSERVER_REUSEPORT)) {
+#ifndef SO_REUSEPORT
+ /*
+ * If the platform doesn't support the SO_REUSEPORT flag we can't
+ * do much beside erroring out.
+ */
+
+ errorMsg = "SO_REUSEPORT isn't supported by this platform";
+ goto error;
+#else
+ optvalue = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEPORT,
+ (char *) &optvalue, sizeof(optvalue));
+#endif
+ }
/*
* Make sure we use the same port number when opening two server
@@ -1580,6 +1665,9 @@ Tcl_OpenTcpServer(
}
close(sock);
sock = -1;
+ if (port == 0 && errno == EADDRINUSE) {
+ goto repeat;
+ }
continue;
}
if (port == 0 && chosenport == 0) {
@@ -1603,6 +1691,9 @@ Tcl_OpenTcpServer(
}
close(sock);
sock = -1;
+ if (port == 0 && errno == EADDRINUSE) {
+ goto repeat;
+ }
continue;
}
if (statePtr == NULL) {
diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c
index c5ac52a..e59a0e3 100644
--- a/unix/tclUnixTest.c
+++ b/unix/tclUnixTest.c
@@ -37,7 +37,7 @@
* exercised by the "testfilehandler" command.
*/
-typedef struct Pipe {
+typedef struct {
TclFile readFile; /* File handle for reading from the pipe. NULL
* means pipe doesn't exist yet. */
TclFile writeFile; /* File handle for writing from the pipe. */
@@ -68,10 +68,10 @@ static Tcl_CmdProc TestfilehandlerCmd;
static Tcl_CmdProc TestfilewaitCmd;
static Tcl_CmdProc TestfindexecutableCmd;
static Tcl_ObjCmdProc TestforkObjCmd;
-static Tcl_CmdProc TestgetdefencdirCmd;
+static Tcl_ObjCmdProc TestgetencpathObjCmd;
static Tcl_CmdProc TestgetopenfileCmd;
static Tcl_CmdProc TestgotsigCmd;
-static Tcl_CmdProc TestsetdefencdirCmd;
+static Tcl_ObjCmdProc TestsetencpathObjCmd;
static Tcl_FileProc TestFileHandlerProc;
static void AlarmHandler(int signum);
@@ -108,9 +108,9 @@ TclplatformtestInit(
NULL, NULL);
Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd,
NULL, NULL);
- Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd,
+ Tcl_CreateObjCommand(interp, "testgetencpath", TestgetencpathObjCmd,
NULL, NULL);
- Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd,
+ Tcl_CreateObjCommand(interp, "testsetencpath", TestsetencpathObjCmd,
NULL, NULL);
Tcl_CreateCommand(interp, "testalarm", TestalarmCmd,
NULL, NULL);
@@ -499,9 +499,9 @@ TestgetopenfileCmd(
/*
*----------------------------------------------------------------------
*
- * TestsetdefencdirCmd --
+ * TestsetencpathCmd --
*
- * This function implements the "testsetdefenc" command. It is used to
+ * This function implements the "testsetencpath" command. It is used to
* test Tcl_SetDefaultEncodingDir().
*
* Results:
@@ -514,19 +514,18 @@ TestgetopenfileCmd(
*/
static int
-TestsetdefencdirCmd(
+TestsetencpathObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Argument strings. */
{
- if (argc != 2) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
- " defaultDir\"", NULL);
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "defaultDir");
return TCL_ERROR;
}
- Tcl_SetDefaultEncodingDir(argv[1]);
+ Tcl_SetEncodingSearchPath(objv[1]);
return TCL_OK;
}
@@ -552,7 +551,7 @@ TestforkObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
- Tcl_Obj *const *objv) /* Argument strings. */
+ Tcl_Obj *const *objv) /* Argument strings. */
{
pid_t pid;
@@ -571,17 +570,17 @@ TestforkObjCmd(
if (pid==0) {
Tcl_InitNotifier();
}
- Tcl_SetObjResult(interp, Tcl_NewIntObj(pid));
+ Tcl_SetObjResult(interp, Tcl_NewWideIntObj(pid));
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
- * TestgetdefencdirCmd --
+ * TestgetencpathObjCmd --
*
- * This function implements the "testgetdefenc" command. It is used to
- * test Tcl_GetDefaultEncodingDir().
+ * This function implements the "testgetencpath" command. It is used to
+ * test Tcl_GetEncodingSearchPath().
*
* Results:
* A standard Tcl result.
@@ -593,18 +592,18 @@ TestforkObjCmd(
*/
static int
-TestgetdefencdirCmd(
+TestgetencpathObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
- int argc, /* Number of arguments. */
- const char **argv) /* Argument strings. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const *objv) /* Argument strings. */
{
- if (argc != 1) {
- Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL);
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
return TCL_ERROR;
}
- Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL);
+ Tcl_SetObjResult(interp, Tcl_GetEncodingSearchPath());
return TCL_OK;
}
@@ -762,7 +761,7 @@ TestchmodCmd(
if (translated == NULL) {
return TCL_ERROR;
}
- if (chmod(translated, (unsigned) mode) != 0) {
+ if (chmod(translated, mode) != 0) {
Tcl_AppendResult(interp, translated, ": ", Tcl_PosixError(interp),
NULL);
return TCL_ERROR;
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 0609230..60340b0 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -13,13 +13,160 @@
#include "tclInt.h"
-#ifdef TCL_THREADS
+#if TCL_THREADS
+
+/*
+ * TIP #509. Ensures that Tcl's mutexes are reentrant.
+ *
+ *----------------------------------------------------------------------
+ *
+ * PMutexInit --
+ *
+ * Sets up the memory pointed to by its argument so that it contains the
+ * implementation of a recursive lock. Caller supplies the space.
+ *
+ *----------------------------------------------------------------------
+ *
+ * PMutexDestroy --
+ *
+ * Tears down the implementation of a recursive lock (but does not
+ * deallocate the space holding the lock).
+ *
+ *----------------------------------------------------------------------
+ *
+ * PMutexLock --
+ *
+ * Locks a recursive lock. (Similar to pthread_mutex_lock)
+ *
+ *----------------------------------------------------------------------
+ *
+ * PMutexUnlock --
+ *
+ * Unlocks a recursive lock. (Similar to pthread_mutex_unlock)
+ *
+ *----------------------------------------------------------------------
+ *
+ * PCondWait --
+ *
+ * Waits on a condition variable linked a recursive lock. (Similar to
+ * pthread_cond_wait)
+ *
+ *----------------------------------------------------------------------
+ *
+ * PCondTimedWait --
+ *
+ * Waits for a limited amount of time on a condition variable linked to a
+ * recursive lock. (Similar to pthread_cond_timedwait)
+ *
+ *----------------------------------------------------------------------
+ */
-typedef struct ThreadSpecificData {
+#ifndef HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
+#define HAVE_DECL_PTHREAD_MUTEX_RECURSIVE 0
+#endif
+
+#if HAVE_DECL_PTHREAD_MUTEX_RECURSIVE
+/*
+ * Pthread has native reentrant (AKA recursive) mutexes. Use them for
+ * Tcl_Mutex.
+ */
+
+typedef pthread_mutex_t PMutex;
+
+static void
+PMutexInit(
+ PMutex *pmutexPtr)
+{
+ pthread_mutexattr_t attr;
+
+ pthread_mutexattr_init(&attr);
+ pthread_mutexattr_settype(&attr, PTHREAD_MUTEX_RECURSIVE);
+ pthread_mutex_init(pmutexPtr, &attr);
+}
+
+#define PMutexDestroy pthread_mutex_destroy
+#define PMutexLock pthread_mutex_lock
+#define PMutexUnlock pthread_mutex_unlock
+#define PCondWait pthread_cond_wait
+#define PCondTimedWait pthread_cond_timedwait
+
+#else /* !HAVE_PTHREAD_MUTEX_RECURSIVE */
+
+/*
+ * No native support for reentrant mutexes. Emulate them with regular mutexes
+ * and thread-local counters.
+ */
+
+typedef struct PMutex {
+ pthread_mutex_t mutex;
+ pthread_t thread;
+ int counter;
+} PMutex;
+
+static void
+PMutexInit(
+ PMutex *pmutexPtr)
+{
+ pthread_mutex_init(&pmutexPtr->mutex, NULL);
+ pmutexPtr->thread = 0;
+ pmutexPtr->counter = 0;
+}
+
+static void
+PMutexDestroy(
+ PMutex *pmutexPtr)
+{
+ pthread_mutex_destroy(&pmutexPtr->mutex);
+}
+
+static void
+PMutexLock(
+ PMutex *pmutexPtr)
+{
+ if (pmutexPtr->thread != pthread_self() || pmutexPtr->counter == 0) {
+ pthread_mutex_lock(&pmutexPtr->mutex);
+ pmutexPtr->thread = pthread_self();
+ pmutexPtr->counter = 0;
+ }
+ pmutexPtr->counter++;
+}
+
+static void
+PMutexUnlock(
+ PMutex *pmutexPtr)
+{
+ pmutexPtr->counter--;
+ if (pmutexPtr->counter == 0) {
+ pmutexPtr->thread = 0;
+ pthread_mutex_unlock(&pmutexPtr->mutex);
+ }
+}
+
+static void
+PCondWait(
+ pthread_cond_t *pcondPtr,
+ PMutex *pmutexPtr)
+{
+ pthread_cond_wait(pcondPtr, &pmutexPtr->mutex);
+}
+
+static void
+PCondTimedWait(
+ pthread_cond_t *pcondPtr,
+ PMutex *pmutexPtr,
+ struct timespec *ptime)
+{
+ pthread_cond_timedwait(pcondPtr, &pmutexPtr->mutex, ptime);
+}
+#endif /* HAVE_PTHREAD_MUTEX_RECURSIVE */
+
+#ifndef TCL_NO_DEPRECATED
+typedef struct {
char nabuf[16];
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
+#endif /* TCL_NO_DEPRECATED */
/*
* masterLock is used to serialize creation of mutexes, condition variables,
@@ -41,15 +188,15 @@ static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;
* obvious reasons, cannot use any dyamically allocated storage.
*/
-static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
-static pthread_mutex_t *allocLockPtr = &allocLock;
-
-/*
- * These are for the critical sections inside this file.
- */
+static PMutex allocLock;
+static pthread_once_t allocLockInitOnce = PTHREAD_ONCE_INIT;
-#define MASTER_LOCK pthread_mutex_lock(&masterLock)
-#define MASTER_UNLOCK pthread_mutex_unlock(&masterLock)
+static void
+allocLockInit(void)
+{
+ PMutexInit(&allocLock);
+}
+static PMutex *allocLockPtr = &allocLock;
#endif /* TCL_THREADS */
@@ -79,7 +226,7 @@ TclpThreadCreate(
int flags) /* Flags controlling behaviour of the new
* thread. */
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
pthread_attr_t attr;
pthread_t theThread;
int result;
@@ -114,17 +261,17 @@ TclpThreadCreate(
}
#endif /* HAVE_PTHREAD_ATTR_SETSTACKSIZE */
- if (! (flags & TCL_THREAD_JOINABLE)) {
- pthread_attr_setdetachstate (&attr, PTHREAD_CREATE_DETACHED);
+ if (!(flags & TCL_THREAD_JOINABLE)) {
+ pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
}
if (pthread_create(&theThread, &attr,
- (void * (*)(void *))proc, (void *)clientData) &&
+ (void * (*)(void *)) proc, (void *) clientData) &&
pthread_create(&theThread, NULL,
- (void * (*)(void *))proc, (void *)clientData)) {
+ (void * (*)(void *)) proc, (void *) clientData)) {
result = TCL_ERROR;
} else {
- *idPtr = (Tcl_ThreadId)theThread;
+ *idPtr = (Tcl_ThreadId) theThread;
result = TCL_OK;
}
pthread_attr_destroy(&attr);
@@ -157,7 +304,7 @@ Tcl_JoinThread(
* thread we wait upon will be written into.
* May be NULL. */
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
int result;
unsigned long retcode, *retcodePtr = &retcode;
@@ -171,7 +318,6 @@ Tcl_JoinThread(
#endif
}
-#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
@@ -192,9 +338,12 @@ void
TclpThreadExit(
int status)
{
+#if TCL_THREADS
pthread_exit(INT2PTR(status));
-}
+#else /* TCL_THREADS */
+ exit(status);
#endif /* TCL_THREADS */
+}
/*
*----------------------------------------------------------------------
@@ -215,7 +364,7 @@ TclpThreadExit(
Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
return (Tcl_ThreadId) pthread_self();
#else
return (Tcl_ThreadId) 0;
@@ -244,7 +393,7 @@ Tcl_GetCurrentThread(void)
void
TclpInitLock(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
pthread_mutex_lock(&initLock);
#endif
}
@@ -252,7 +401,7 @@ TclpInitLock(void)
/*
*----------------------------------------------------------------------
*
- * TclpFinalizeLock
+ * TclFinalizeLock
*
* This procedure is used to destroy all private resources used in this
* file.
@@ -270,7 +419,7 @@ TclpInitLock(void)
void
TclFinalizeLock(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* You do not need to destroy mutexes that were created with the
* PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
@@ -301,7 +450,7 @@ TclFinalizeLock(void)
void
TclpInitUnlock(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
pthread_mutex_unlock(&initLock);
#endif
}
@@ -330,11 +479,10 @@ TclpInitUnlock(void)
void
TclpMasterLock(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
pthread_mutex_lock(&masterLock);
#endif
}
-
/*
*----------------------------------------------------------------------
@@ -356,7 +504,7 @@ TclpMasterLock(void)
void
TclpMasterUnlock(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
pthread_mutex_unlock(&masterLock);
#endif
}
@@ -383,15 +531,17 @@ TclpMasterUnlock(void)
Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
-#ifdef TCL_THREADS
- pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;
+#if TCL_THREADS
+ PMutex **allocLockPtrPtr = &allocLockPtr;
+
+ pthread_once(&allocLockInitOnce, allocLockInit);
return (Tcl_Mutex *) allocLockPtrPtr;
#else
return NULL;
#endif
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
*----------------------------------------------------------------------
@@ -416,26 +566,26 @@ Tcl_GetAllocMutex(void)
void
Tcl_MutexLock(
- Tcl_Mutex *mutexPtr) /* Really (pthread_mutex_t **) */
+ Tcl_Mutex *mutexPtr) /* Really (PMutex **) */
{
- pthread_mutex_t *pmutexPtr;
+ PMutex *pmutexPtr;
if (*mutexPtr == NULL) {
- MASTER_LOCK;
+ pthread_mutex_lock(&masterLock);
if (*mutexPtr == NULL) {
/*
* Double inside master lock check to avoid a race condition.
*/
- pmutexPtr = ckalloc(sizeof(pthread_mutex_t));
- pthread_mutex_init(pmutexPtr, NULL);
- *mutexPtr = (Tcl_Mutex)pmutexPtr;
+ pmutexPtr = ckalloc(sizeof(PMutex));
+ PMutexInit(pmutexPtr);
+ *mutexPtr = (Tcl_Mutex) pmutexPtr;
TclRememberMutex(mutexPtr);
}
- MASTER_UNLOCK;
+ pthread_mutex_unlock(&masterLock);
}
- pmutexPtr = *((pthread_mutex_t **)mutexPtr);
- pthread_mutex_lock(pmutexPtr);
+ pmutexPtr = *((PMutex **) mutexPtr);
+ PMutexLock(pmutexPtr);
}
/*
@@ -457,11 +607,11 @@ Tcl_MutexLock(
void
Tcl_MutexUnlock(
- Tcl_Mutex *mutexPtr) /* Really (pthread_mutex_t **) */
+ Tcl_Mutex *mutexPtr) /* Really (PMutex **) */
{
- pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr;
+ PMutex *pmutexPtr = *(PMutex **) mutexPtr;
- pthread_mutex_unlock(pmutexPtr);
+ PMutexUnlock(pmutexPtr);
}
/*
@@ -487,10 +637,10 @@ void
TclpFinalizeMutex(
Tcl_Mutex *mutexPtr)
{
- pthread_mutex_t *pmutexPtr = *(pthread_mutex_t **) mutexPtr;
+ PMutex *pmutexPtr = *(PMutex **) mutexPtr;
if (pmutexPtr != NULL) {
- pthread_mutex_destroy(pmutexPtr);
+ PMutexDestroy(pmutexPtr);
ckfree(pmutexPtr);
*mutexPtr = NULL;
}
@@ -521,15 +671,15 @@ TclpFinalizeMutex(
void
Tcl_ConditionWait(
Tcl_Condition *condPtr, /* Really (pthread_cond_t **) */
- Tcl_Mutex *mutexPtr, /* Really (pthread_mutex_t **) */
+ Tcl_Mutex *mutexPtr, /* Really (PMutex **) */
const Tcl_Time *timePtr) /* Timeout on waiting period */
{
pthread_cond_t *pcondPtr;
- pthread_mutex_t *pmutexPtr;
+ PMutex *pmutexPtr;
struct timespec ptime;
if (*condPtr == NULL) {
- MASTER_LOCK;
+ pthread_mutex_lock(&masterLock);
/*
* Double check inside mutex to avoid race, then initialize condition
@@ -542,12 +692,12 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
}
- MASTER_UNLOCK;
+ pthread_mutex_unlock(&masterLock);
}
- pmutexPtr = *((pthread_mutex_t **)mutexPtr);
- pcondPtr = *((pthread_cond_t **)condPtr);
+ pmutexPtr = *((PMutex **) mutexPtr);
+ pcondPtr = *((pthread_cond_t **) condPtr);
if (timePtr == NULL) {
- pthread_cond_wait(pcondPtr, pmutexPtr);
+ PCondWait(pcondPtr, pmutexPtr);
} else {
Tcl_Time now;
@@ -560,7 +710,7 @@ Tcl_ConditionWait(
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);
+ PCondTimedWait(pcondPtr, pmutexPtr, &ptime);
}
}
@@ -587,12 +737,13 @@ void
Tcl_ConditionNotify(
Tcl_Condition *condPtr)
{
- pthread_cond_t *pcondPtr = *((pthread_cond_t **)condPtr);
+ pthread_cond_t *pcondPtr = *((pthread_cond_t **) condPtr);
+
if (pcondPtr != NULL) {
pthread_cond_broadcast(pcondPtr);
} else {
/*
- * Noone has used the condition variable, so there are no waiters.
+ * No-one has used the condition variable, so there are no waiters.
*/
}
}
@@ -620,7 +771,7 @@ void
TclpFinalizeCondition(
Tcl_Condition *condPtr)
{
- pthread_cond_t *pcondPtr = *(pthread_cond_t **)condPtr;
+ pthread_cond_t *pcondPtr = *(pthread_cond_t **) condPtr;
if (pcondPtr != NULL) {
pthread_cond_destroy(pcondPtr);
@@ -651,6 +802,7 @@ TclpFinalizeCondition(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
Tcl_DirEntry *
TclpReaddir(
TclDIR * dir)
@@ -663,7 +815,7 @@ char *
TclpInetNtoa(
struct in_addr addr)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
unsigned char *b = (unsigned char*) &addr.s_addr;
@@ -673,34 +825,34 @@ TclpInetNtoa(
return inet_ntoa(addr);
#endif
}
+#endif /* TCL_NO_DEPRECATED */
-#ifdef TCL_THREADS
+#if TCL_THREADS
/*
* Additions by AOL for specialized thread memory allocator.
*/
#ifdef USE_THREAD_ALLOC
-static volatile int initialized = 0;
static pthread_key_t key;
-typedef struct allocMutex {
+typedef struct {
Tcl_Mutex tlock;
- pthread_mutex_t plock;
-} allocMutex;
+ PMutex plock;
+} AllocMutex;
Tcl_Mutex *
TclpNewAllocMutex(void)
{
- struct allocMutex *lockPtr;
- register pthread_mutex_t *plockPtr;
+ AllocMutex *lockPtr;
+ register PMutex *plockPtr;
- lockPtr = malloc(sizeof(struct allocMutex));
+ lockPtr = malloc(sizeof(AllocMutex));
if (lockPtr == NULL) {
Tcl_Panic("could not allocate lock");
}
plockPtr = &lockPtr->plock;
lockPtr->tlock = (Tcl_Mutex) plockPtr;
- pthread_mutex_init(&lockPtr->plock, NULL);
+ PMutexInit(&lockPtr->plock);
return &lockPtr->tlock;
}
@@ -708,15 +860,22 @@ void
TclpFreeAllocMutex(
Tcl_Mutex *mutex) /* The alloc mutex to free. */
{
- allocMutex* lockPtr = (allocMutex*) mutex;
+ AllocMutex *lockPtr = (AllocMutex *) mutex;
+
if (!lockPtr) {
return;
}
- pthread_mutex_destroy(&lockPtr->plock);
+ PMutexDestroy(&lockPtr->plock);
free(lockPtr);
}
void
+TclpInitAllocCache(void)
+{
+ pthread_key_create(&key, NULL);
+}
+
+void
TclpFreeAllocCache(
void *ptr)
{
@@ -729,28 +888,19 @@ TclpFreeAllocCache(
TclFreeAllocCache(ptr);
pthread_setspecific(key, NULL);
- } else if (initialized) {
+ } else {
/*
* Called by TclFinalizeThreadAlloc() during the process
* finalization initiated from Tcl_Finalize()
*/
pthread_key_delete(key);
- initialized = 0;
}
}
void *
TclpGetAllocCache(void)
{
- if (!initialized) {
- pthread_mutex_lock(allocLockPtr);
- if (!initialized) {
- pthread_key_create(&key, NULL);
- initialized = 1;
- }
- pthread_mutex_unlock(allocLockPtr);
- }
return pthread_getspecific(key);
}
@@ -767,7 +917,7 @@ TclpThreadCreateKey(void)
{
pthread_key_t *ptkeyPtr;
- ptkeyPtr = TclpSysAlloc(sizeof *ptkeyPtr, 0);
+ ptkeyPtr = TclpSysAlloc(sizeof(pthread_key_t), 0);
if (NULL == ptkeyPtr) {
Tcl_Panic("unable to allocate thread key!");
}
diff --git a/unix/tclUnixThrd.h b/unix/tclUnixThrd.h
deleted file mode 100644
index f03b530..0000000
--- a/unix/tclUnixThrd.h
+++ /dev/null
@@ -1,19 +0,0 @@
-/*
- * tclUnixThrd.h --
- *
- * This header file defines things for thread support.
- *
- * Copyright (c) 1998 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#ifndef _TCLUNIXTHRD
-#define _TCLUNIXTHRD
-
-#ifdef TCL_THREADS
-
-
-#endif /* TCL_THREADS */
-#endif /* _TCLUNIXTHRD */
diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c
index 6a3766d..6a73ac2 100644
--- a/unix/tclUnixTime.c
+++ b/unix/tclUnixTime.c
@@ -22,8 +22,9 @@
* variable is the key to this buffer.
*/
+#ifndef TCL_NO_DEPRECATED
static Tcl_ThreadDataKey tmKey;
-typedef struct ThreadSpecificData {
+typedef struct {
struct tm gmtime_buf;
struct tm localtime_buf;
} ThreadSpecificData;
@@ -45,6 +46,8 @@ static char *lastTZ = NULL; /* Holds the last setting of the TZ
static void SetTZIfNecessary(void);
static void CleanupMemory(ClientData clientData);
+#endif /* TCL_NO_DEPRECATED */
+
static void NativeScaleTime(Tcl_Time *timebuf,
ClientData clientData);
static void NativeGetTime(Tcl_Time *timebuf,
@@ -263,6 +266,7 @@ Tcl_GetTime(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
struct tm *
TclpGetDate(
const time_t *time,
@@ -352,6 +356,7 @@ TclpLocaltime(
return &tsdPtr->localtime_buf;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -486,6 +491,7 @@ NativeGetTime(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
static void
SetTZIfNecessary(void)
{
@@ -531,6 +537,7 @@ CleanupMemory(
{
ckfree(lastTZ);
}
+#endif /* TCL_NO_DEPRECATED */
/*
* Local Variables:
diff --git a/unix/tclXtNotify.c b/unix/tclXtNotify.c
index a5d92d6..26db9f2 100644
--- a/unix/tclXtNotify.c
+++ b/unix/tclXtNotify.c
@@ -42,7 +42,7 @@ typedef struct FileHandler {
* handlers are ready to fire.
*/
-typedef struct FileHandlerEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
int fd; /* File descriptor that is ready. Used to find
diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c
index f7c2652..cb70b58 100644
--- a/unix/tclXtTest.c
+++ b/unix/tclXtTest.c
@@ -48,7 +48,7 @@ int
Tclxttest_Init(
Tcl_Interp *interp) /* Interpreter for application. */
{
- if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
+ if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
return TCL_ERROR;
}
XtToolkitInitialize();
diff --git a/unix/tclooConfig.sh b/unix/tclooConfig.sh
index 2279542..4c2068c 100644
--- a/unix/tclooConfig.sh
+++ b/unix/tclooConfig.sh
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
-TCLOO_VERSION=1.1.0
+TCLOO_VERSION=1.2.0
diff --git a/win/Makefile.in b/win/Makefile.in
index e6b9801..f97582a 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -138,6 +138,11 @@ 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@
+TCL_ZIP_FILE = @TCL_ZIP_FILE@
+TCL_VFS_PATH = libtcl.vfs/tcl_library
+TCL_VFS_ROOT = libtcl.vfs
+
+
TCL_STUB_LIB_FILE = @TCL_STUB_LIB_FILE@
TCL_DLL_FILE = @TCL_DLL_FILE@
TCL_LIB_FILE = @TCL_LIB_FILE@
@@ -148,7 +153,8 @@ REG_LIB_FILE = @LIBPREFIX@tclreg$(REGVER)${LIBSUFFIX}
TEST_DLL_FILE = tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE = tcltest${EXESUFFIX}
TEST_LIB_FILE = @LIBPREFIX@tcltest$(VER)${LIBSUFFIX}
-TEST_LOAD_PRMS = package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde];\
+TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
+ package ifneeded dde 1.4.1 [list load [file normalize ${DDE_DLL_FILE}] dde];\
package ifneeded registry 1.3.3 [list load [file normalize ${REG_DLL_FILE}] registry]
TEST_LOAD_FACILITIES = package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
$(TEST_LOAD_PRMS)
@@ -158,6 +164,7 @@ SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
STATIC_LIBRARIES = $(TCL_LIB_FILE)
TCLSH = tclsh$(VER)${EXESUFFIX}
+WINE = @WINE@
CAT32 = cat32$(EXEEXT)
MAN2TCL = man2tcl$(EXEEXT)
@@ -201,9 +208,49 @@ MKDIR = mkdir -p
SHELL = @SHELL@
RM = rm -f
COPY = cp
+LN = ln
+
+###
+# Tip 430 - ZipFS Modifications
+###
+
+TCL_ZIP_FILE = @TCL_ZIP_FILE@
+TCL_VFS_PATH = libtcl.vfs/tcl_library
+TCL_VFS_ROOT = libtcl.vfs
+
+HOST_CC = @CC_FOR_BUILD@
+HOST_EXEEXT = @EXEEXT_FOR_BUILD@
+HOST_OBJEXT = @OBJEXT_FOR_BUILD@
+ZIPFS_BUILD = @ZIPFS_BUILD@
+NATIVE_ZIP = @ZIP_PROG@
+ZIP_PROG_OPTIONS = @ZIP_PROG_OPTIONS@
+ZIP_PROG_VFSSEARCH = @ZIP_PROG_VFSSEARCH@
+SHARED_BUILD = @SHARED_BUILD@
+INSTALL_MSGS = @INSTALL_MSGS@
+INSTALL_LIBRARIES = @INSTALL_LIBRARIES@
+
+# Minizip
+MINIZIP_OBJS = \
+ adler32.$(HOST_OBJEXT) \
+ compress.$(HOST_OBJEXT) \
+ crc32.$(HOST_OBJEXT) \
+ deflate.$(HOST_OBJEXT) \
+ infback.$(HOST_OBJEXT) \
+ inffast.$(HOST_OBJEXT) \
+ inflate.$(HOST_OBJEXT) \
+ inftrees.$(HOST_OBJEXT) \
+ ioapi.$(HOST_OBJEXT) \
+ iowin32.$(HOST_OBJEXT) \
+ trees.$(HOST_OBJEXT) \
+ uncompr.$(HOST_OBJEXT) \
+ zip.$(HOST_OBJEXT) \
+ zutil.$(HOST_OBJEXT) \
+ minizip.$(HOST_OBJEXT)
+
+ZIP_INSTALL_OBJS = @ZIP_INSTALL_OBJS@
CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
--I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH \
+-I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \
-DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
${AC_FLAGS} ${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS}
@@ -211,7 +258,7 @@ CC_OBJNAME = @CC_OBJNAME@
CC_EXENAME = @CC_EXENAME@
STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \
--I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
+-I"${GENERIC_DIR_NATIVE}" -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \
-I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \
${COMPILE_DEBUG_FLAGS}
@@ -291,6 +338,7 @@ GENERIC_OBJS = \
tclPosixStr.$(OBJEXT) \
tclPreserve.$(OBJEXT) \
tclProc.$(OBJEXT) \
+ tclProcess.$(OBJEXT) \
tclRegexp.$(OBJEXT) \
tclResolve.$(OBJEXT) \
tclResult.$(OBJEXT) \
@@ -308,6 +356,7 @@ GENERIC_OBJS = \
tclUtf.$(OBJEXT) \
tclUtil.$(OBJEXT) \
tclVar.$(OBJEXT) \
+ tclZipfs.$(OBJEXT) \
tclZlib.$(OBJEXT)
TOMMATH_OBJS = \
@@ -335,6 +384,9 @@ TOMMATH_OBJS = \
bn_mp_exch.${OBJEXT} \
bn_mp_expt_d.${OBJEXT} \
bn_mp_expt_d_ex.${OBJEXT} \
+ bn_mp_get_int.${OBJEXT} \
+ bn_mp_get_long.${OBJEXT} \
+ bn_mp_get_long_long.${OBJEXT} \
bn_mp_grow.${OBJEXT} \
bn_mp_init.${OBJEXT} \
bn_mp_init_copy.${OBJEXT} \
@@ -359,11 +411,17 @@ TOMMATH_OBJS = \
bn_mp_rshd.${OBJEXT} \
bn_mp_set.${OBJEXT} \
bn_mp_set_int.${OBJEXT} \
+ bn_mp_set_long.${OBJEXT} \
+ bn_mp_set_long_long.${OBJEXT} \
bn_mp_shrink.${OBJEXT} \
bn_mp_sqr.${OBJEXT} \
bn_mp_sqrt.${OBJEXT} \
bn_mp_sub.${OBJEXT} \
bn_mp_sub_d.${OBJEXT} \
+ bn_mp_tc_and.${OBJEXT} \
+ bn_mp_tc_div_2d.${OBJEXT} \
+ bn_mp_tc_or.${OBJEXT} \
+ bn_mp_tc_xor.${OBJEXT} \
bn_mp_to_unsigned_bin.${OBJEXT} \
bn_mp_to_unsigned_bin_n.${OBJEXT} \
bn_mp_toom_mul.${OBJEXT} \
@@ -401,7 +459,8 @@ REG_OBJS = tclWinReg.$(OBJEXT)
STUB_OBJS = \
tclStubLib.$(OBJEXT) \
tclTomMathStubLib.$(OBJEXT) \
- tclOOStubLib.$(OBJEXT)
+ tclOOStubLib.$(OBJEXT) \
+ tclWinPanic.$(OBJEXT)
TCLSH_OBJS = tclAppInit.$(OBJEXT)
@@ -453,7 +512,7 @@ tcltest.cmd:
tcltest: $(TCLSH) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd
-binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions $(TCLSH)
+binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)
winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
@@ -461,9 +520,37 @@ libraries:
doc:
+tclzipfile: ${TCL_ZIP_FILE}
+
+${TCL_ZIP_FILE}: ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE}
+ @rm -rf ${TCL_VFS_ROOT}
+ @mkdir -p ${TCL_VFS_PATH}
+ @echo "creating ${TCL_VFS_PATH} (prepare compression)"
+ @( \
+ $(LN) $$(find $(TOP_DIR)/library/* -maxdepth 0 -type f) ${TCL_VFS_PATH}/ && \
+ (for D in $$(find $(TOP_DIR)/library/* -maxdepth 0 -type d); do \
+ mkdir -p "${TCL_VFS_PATH}/$$(basename $$D)"; \
+ $(LN) -s $$D/* ${TCL_VFS_PATH}/$$(basename $$D)/; \
+ done) && \
+ $(LN) ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl && \
+ $(LN) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde/ && \
+ $(LN) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg/ \
+ ) || ( \
+ $(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}; \
+ $(COPY) -a ${TCL_VFS_PATH}/manifest.txt ${TCL_VFS_PATH}/pkgIndex.tcl; \
+ $(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde; \
+ $(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg; \
+ )
+ (zip=`(realpath '${NATIVE_ZIP}' || readlink -m '${NATIVE_ZIP}') 2>/dev/null || \
+ (echo '${NATIVE_ZIP}' | sed "s?^\./?$$(pwd)/?")`; \
+ cd ${TCL_VFS_ROOT} && \
+ $$zip ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH} >/dev/null && \
+ echo "${TCL_ZIP_FILE} successful created with $$zip" && \
+ cd ..)
+
$(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
- tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+ tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
@VC_MANIFEST_EMBED_EXE@
cat32.$(OBJEXT): cat.c
@@ -480,10 +567,15 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
@MAKE_STUB_LIB@ ${STUB_OBJS}
@POST_MAKE_LIB@
-${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
+${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE}
@$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
@VC_MANIFEST_EMBED_DLL@
+ @if test "${ZIPFS_BUILD}" = "1" ; then \
+ cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}; \
+ ${NATIVE_ZIP} -A ${TCL_DLL_FILE} \
+ || echo 'ignore zip-error by adjust sfx process (not executable?)'; \
+ fi
${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
@$(RM) ${TCL_LIB_FILE}
@@ -537,6 +629,17 @@ testMain.${OBJEXT}: tclAppInit.c
tclMain2.${OBJEXT}: tclMain.c
$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
+# TIP #430, ZipFS Support
+tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c
+ $(CC) -c $(CC_SWITCHES) -DBUILD_tcl \
+ -DCFG_RUNTIME_PATH=\"$(bindir_native)\" \
+ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
+ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
+ -DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \
+ -DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
+ $(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip @DEPARG@ $(CC_OBJNAME)
+
+
# TIP #59, embedding of configuration information into the binary library.
#
# Part of Tcl's configuration information are the paths where it was installed
@@ -558,6 +661,8 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c
-DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \
-DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \
-DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \
+ -DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
+ -DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
-DBUILD_tcl \
@DEPARG@ $(CC_OBJNAME)
@@ -573,6 +678,9 @@ tclTomMathStubLib.${OBJEXT}: tclTomMathStubLib.c
tclOOStubLib.${OBJEXT}: tclOOStubLib.c
$(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+tclWinPanic.${OBJEXT}: tclWinPanic.c
+ $(CC) -c $(CC_SWITCHES) -DSTATIC_BUILD @DEPARG@ $(CC_OBJNAME)
+
# Implicit rule for all object files that will end up in the Tcl library
%.${OBJEXT}: %.c
@@ -581,6 +689,59 @@ tclOOStubLib.${OBJEXT}: tclOOStubLib.c
.rc.$(RES):
$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
+
+
+#--------------------------------------------------------------------------
+# Minizip implementation
+#--------------------------------------------------------------------------
+adler32.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c
+
+compress.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c
+
+crc32.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c
+
+deflate.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c
+
+ioapi.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -DIOAPI_NO_64 -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c
+
+iowin32.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c
+
+infback.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c
+
+inffast.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c
+
+inflate.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c
+
+inftrees.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c
+
+trees.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c
+
+uncompr.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c
+
+zip.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c
+
+zutil.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c
+
+minizip.$(HOST_OBJEXT):
+ $(HOST_CC) -o $@ -I$(ZLIB_DIR) -DIOAPI_NO_64 -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c
+
+minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
+ $(HOST_CC) -o $@ $(MINIZIP_OBJS)
+
# The following target generates the file generic/tclDate.c from the yacc
# grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
# not available in all environments. The name of the .c file is different than
@@ -601,7 +762,15 @@ gentommath_h:
"$(TOMMATH_DIR_NATIVE)/tommath.h" \
> "$(GENERIC_DIR_NATIVE)/tclTomMath.h"
-install: all install-binaries install-libraries install-doc install-packages
+INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
+INSTALL_DOC_TARGETS = install-doc
+INSTALL_PACKAGE_TARGETS = install-packages
+INSTALL_DEV_TARGETS = install-headers
+INSTALL_EXTRA_TARGETS =
+INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
+ $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)
+
+install: $(INSTALL_TARGETS)
install-binaries: binaries
@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
@@ -656,6 +825,11 @@ install-binaries: binaries
$(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
fi
+install-libraries-zipfs-shared: libraries
+
+install-libraries-zipfs-static: install-libraries-zipfs-shared
+ $(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"
+
install-libraries: libraries install-tzdata install-msgs
@for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
$(SCRIPT_INSTALL_DIR); \
@@ -666,7 +840,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
+ @for i in opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6 ../tcl8/8.7; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -674,25 +848,11 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @echo "Installing header files";
- @for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
- "$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
- "$(GENERIC_DIR)/tclPlatDecls.h" \
- "$(GENERIC_DIR)/tclTomMath.h" \
- "$(GENERIC_DIR)/tclTomMathDecls.h"; \
- do \
- $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
- done;
@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
done;
- @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 package http 2.9.0 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm;
@echo "Installing library opt0.4 directory";
@@ -700,10 +860,10 @@ install-libraries: libraries install-tzdata install-msgs
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
- @echo "Installing package msgcat 1.6.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm;
- @echo "Installing package tcltest 2.5.0 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.5.0.tm;
+ @echo "Installing package msgcat 1.7.0 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.7/msgcat-1.7.0.tm;
+ @echo "Installing package tcltest 2.4.0 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
@$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
@@ -725,6 +885,26 @@ install-msgs:
install-doc: doc
+install-headers:
+ @for i in "$(INCLUDE_INSTALL_DIR)"; \
+ do \
+ if [ ! -d "$$i" ] ; then \
+ echo "Making directory $$i"; \
+ $(MKDIR) "$$i"; \
+ chmod 755 "$$i"; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
+ @for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
+ $(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
+ $(GENERIC_DIR)/tclPlatDecls.h \
+ $(GENERIC_DIR)/tclTomMath.h \
+ $(GENERIC_DIR)/tclTomMathDecls.h ; \
+ do \
+ $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \
+ done;
+
# Optional target to install private headers
install-private-headers: libraries
@for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
@@ -752,19 +932,19 @@ test: test-tcl test-packages
test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
- -load "$(TEST_LOAD_FACILITIES)" | ./$(CAT32)
+ $(WINE) ./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
+ -load "$(TEST_LOAD_FACILITIES)" | $(WINE) ./$(CAT32)
# Useful target to launch a built tclsh with the proper path,...
runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
- ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT)
+ $(WINE) ./$(TCLSH) $(TESTFLAGS) -load "$(TEST_LOAD_FACILITIES)" $(SCRIPT)
# 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)
+ $(WINE) ./$(TCLSH) $(SCRIPT)
# This target can be used to run tclsh inside either gdb or insight
gdb: binaries
@@ -784,10 +964,13 @@ clean: cleanhelp clean-packages
$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
$(RM) $(TCLSH) $(CAT32) $(TEST_EXE_FILE) $(TEST_DLL_FILE) tcltest.cmd tcltest
$(RM) *.pch *.ilk *.pdb
+ $(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT}
+ $(RM) *.zip
+ $(RMDIR) *.vfs
distclean: distclean-packages clean
$(RM) Makefile config.status config.cache config.log tclConfig.sh \
- tcl.hpj config.status.lineno
+ tcl.hpj config.status.lineno tclsh.exe.manifest
#
# Bundled package targets
@@ -806,7 +989,7 @@ packages:
if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
( cd $(PKG_DIR)/$$pkg; \
echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
- $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \
+ $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared; ) \
fi ; \
echo "Building package '$$pkg'"; \
( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
@@ -916,5 +1099,6 @@ html-tk: $(TCLSH)
.PHONY: gdb depend cleanhelp clean distclean packages install-packages
.PHONY: test-packages clean-packages distclean-packages genstubs html
.PHONY: html-tcl html-tk
+.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile
# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/win/README b/win/README
index 5e060ef..972923c 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 8.6 for Windows
+Tcl 8.7 for Windows
1. Introduction
---------------
@@ -16,7 +16,7 @@ The information in this file is maintained on the web at:
In order to compile Tcl for Windows, you need the following:
- Tcl 8.6 Source Distribution (plus any patches)
+ Tcl 8.7 Source Distribution (plus any patches)
and
@@ -79,9 +79,9 @@ Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
-Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is
+Note that in order to run tclsh87.exe, you must ensure that tcl87.dll is
on your path, in the system directory, or in the directory containing
-tclsh86.exe.
+tclsh87.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/buildall.vc.bat b/win/buildall.vc.bat
index deb9e39..cb136be 100644..100755
--- a/win/buildall.vc.bat
+++ b/win/buildall.vc.bat
@@ -38,7 +38,9 @@ if defined WINDOWSSDKDIR (goto :startBuilding)
:: might not be correct. You should call it yourself prior to running
:: this batchfile.
::
-call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
+REM call "C:\Program Files\Microsoft Developer Studio\vc98\bin\vcvars32.bat"
+set "VSCMD_START_DIR=%CD%"
+call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\Common7\Tools\VsDevCmd.bat"
if errorlevel 1 (goto no_vcvars)
:startBuilding
diff --git a/win/coffbase.txt b/win/coffbase.txt
deleted file mode 100644
index 3314f26..0000000
--- a/win/coffbase.txt
+++ /dev/null
@@ -1,43 +0,0 @@
-;
-; This file defines the virtual base addresses for the Dynamic Link Libraries
-; 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.
-
-tcl 0x10000000 0x00200000
-tcldde 0x10200000 0x00010000
-tclreg 0x10210000 0x00010000
-tk 0x10220000 0x00200000
-expect 0x10480000 0x00080000
-itcl 0x10500000 0x00080000
-itk 0x10580000 0x00080000
-bltlite 0x10600000 0x00080000
-blt 0x10680000 0x00080000
-iocpsock 0x10700000 0x00080000
-tls 0x10780000 0x00100000
-winico 0x10880000 0x00010000
-sample 0x108B0000 0x00010000
-tile 0x10900000 0x00080000
-memchan 0x109D0000 0x00010000
-tdom 0x109E0000 0x00080000
-tclvfs 0x10A70000 0x00010000
-tkvideo 0x10B00000 0x00010000
-tclsdl 0x10B20000 0x00080000
-vqtcl 0x10C00000 0x00010000
-tdbc 0x10C40000 0x00010000
-thread 0x10C80000 0x00020000
-nsf 0x10ca0000 0x00080000
-;
-; insert new packages here
-;
-snack 0x1E000000 0x00400000
-sound 0x1E400000 0x00400000
-snackogg 0x1E800000 0x00200000
diff --git a/win/configure b/win/configure
index 3024594..982f96a 100755
--- a/win/configure
+++ b/win/configure
@@ -1,81 +1,459 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.59.
+# Generated by GNU Autoconf 2.69.
+#
+#
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
+#
#
-# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
-DUALCASE=1; export DUALCASE # for MKS sh
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
+else
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
+ else
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
+ fi
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
fi
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+# Use a proper internal environment variable to ensure we don't fall
+ # into an infinite loop, continuously re-executing ourselves.
+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+ _as_can_reexec=no; export _as_can_reexec;
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+ fi
+ # We don't want this to propagate to other subprocesses.
+ { _as_can_reexec=; unset _as_can_reexec;}
+if test "x$CONFIG_SHELL" = x; then
+ as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
+ emulate sh
+ NULLCMD=:
+ # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '\${1+\"\$@\"}'='\"\$@\"'
+ setopt NO_GLOB_SUBST
+else
+ case \`(set -o) 2>/dev/null\` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
+fi
+"
+ as_required="as_fn_return () { (exit \$1); }
+as_fn_success () { as_fn_return 0; }
+as_fn_failure () { as_fn_return 1; }
+as_fn_ret_success () { return 0; }
+as_fn_ret_failure () { return 1; }
+
+exitcode=0
+as_fn_success || { exitcode=1; echo as_fn_success failed.; }
+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }
+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }
+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }
+if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
+
+else
+ exitcode=1; echo positional parameters were not saved.
+fi
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
+ as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
+ as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
+ eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
+ test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1
+test \$(( 1 + 1 )) = 2 || exit 1"
+ if (eval "$as_required") 2>/dev/null; then :
+ as_have_required=yes
+else
+ as_have_required=no
+fi
+ if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :
+
+else
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+as_found=false
+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ as_found=:
+ case $as_dir in #(
+ /*)
+ for as_base in sh bash ksh sh5; do
+ # Try only shells that exist, to save several forks.
+ as_shell=$as_dir/$as_base
+ if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ CONFIG_SHELL=$as_shell as_have_required=yes
+ if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :
+ break 2
+fi
+fi
+ done;;
+ esac
+ as_found=false
+done
+$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&
+ { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :
+ CONFIG_SHELL=$SHELL as_have_required=yes
+fi; }
+IFS=$as_save_IFS
+
+
+ if test "x$CONFIG_SHELL" != x; then :
+ export CONFIG_SHELL
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
+fi
+
+ if test x$as_have_required = xno; then :
+ $as_echo "$0: This script requires a shell more modern than all"
+ $as_echo "$0: the shells that I found on your system."
+ if test x${ZSH_VERSION+set} = xset ; then
+ $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"
+ $as_echo "$0: be upgraded to zsh 4.3.4 or later."
else
- $as_unset $as_var
+ $as_echo "$0: Please tell bug-autoconf@gnu.org about your system,
+$0: including any error possibly output before this
+$0: message. Then install a modern shell, or manually run
+$0: the script under such a shell if you do have one."
fi
-done
+ exit 1
+fi
+fi
+fi
+SHELL=${CONFIG_SHELL-/bin/sh}
+export SHELL
+# Unset more variables known to interfere with behavior of common tools.
+CLICOLOR_FORCE= GREP_OPTIONS=
+unset CLICOLOR_FORCE GREP_OPTIONS
+
+## --------------------- ##
+## M4sh Shell Functions. ##
+## --------------------- ##
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$1; test $as_status -eq 0 && as_status=1
+ if test "$4"; then
+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
+ fi
+ $as_echo "$as_me: error: $2" >&2
+ as_fn_exit $as_status
+} # as_fn_error
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
-
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -83,146 +461,91 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
+ as_lineno_1=$LINENO as_lineno_1a=$LINENO
+ as_lineno_2=$LINENO as_lineno_2a=$LINENO
+ eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&
+ test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {
+ # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)
+ sed -n '
+ p
+ /[$]LINENO/=
+ ' <$as_myself |
sed '
+ s/[$]LINENO.*/&-/
+ t lineno
+ b
+ :lineno
N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
+ :loop
+ s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/
t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
+ s/-\n.*//
' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2
- { (exit 1); exit 1; }; }
+ chmod +x "$as_me.lineno" ||
+ { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+ # already done that, so ensure we don't try to do so again and fall
+ # in an infinite loop. This has already happened in practice.
+ _as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
+ # original and so on. Autoconf is especially sensitive to this).
+ . "./$as_me.lineno"
# Exit status is that of the last command.
exit
}
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+ case `echo 'xy\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
else
- as_expr=false
+ rm -f conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -pR'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -pR'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
+ as_ln_s='cp -pR'
fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-as_executable_p="test -f"
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -231,38 +554,25 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
+test -n "$DJDIR" || exec 7<&0 </dev/null
+exec 6>&1
# Name of the host.
-# hostname on some systems (SVR3.2, Linux) returns a bogus exit status,
+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,
# so uname gets run too.
ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`
-exec 6>&1
-
#
# Initializations.
#
ac_default_prefix=/usr/local
+ac_clean_files=
ac_config_libobj_dir=.
+LIBOBJS=
cross_compiling=no
subdirs=
MFLAGS=
MAKEFLAGS=
-SHELL=${CONFIG_SHELL-/bin/sh}
-
-# Maximum number of lines to put in a shell here document.
-# This variable seems obsolete. It should probably be removed, and
-# only ac_max_sed_lines should be used.
-: ${ac_max_here_lines=38}
# Identity of this package.
PACKAGE_NAME=
@@ -270,51 +580,225 @@ PACKAGE_TARNAME=
PACKAGE_VERSION=
PACKAGE_STRING=
PACKAGE_BUGREPORT=
+PACKAGE_URL=
ac_unique_file="../generic/tcl.h"
# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
-#if HAVE_SYS_TYPES_H
+#ifdef HAVE_SYS_TYPES_H
# include <sys/types.h>
#endif
-#if HAVE_SYS_STAT_H
+#ifdef HAVE_SYS_STAT_H
# include <sys/stat.h>
#endif
-#if STDC_HEADERS
+#ifdef STDC_HEADERS
# include <stdlib.h>
# include <stddef.h>
#else
-# if HAVE_STDLIB_H
+# ifdef HAVE_STDLIB_H
# include <stdlib.h>
# endif
#endif
-#if HAVE_STRING_H
-# if !STDC_HEADERS && HAVE_MEMORY_H
+#ifdef HAVE_STRING_H
+# if !defined STDC_HEADERS && defined HAVE_MEMORY_H
# include <memory.h>
# endif
# include <string.h>
#endif
-#if HAVE_STRINGS_H
+#ifdef HAVE_STRINGS_H
# include <strings.h>
#endif
-#if HAVE_INTTYPES_H
+#ifdef HAVE_INTTYPES_H
# include <inttypes.h>
-#else
-# if HAVE_STDINT_H
-# include <stdint.h>
-# endif
#endif
-#if HAVE_UNISTD_H
+#ifdef HAVE_STDINT_H
+# include <stdint.h>
+#endif
+#ifdef HAVE_UNISTD_H
# include <unistd.h>
#endif"
-ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT CPP EGREP AR ac_ct_AR RANLIB ac_ct_RANLIB RC ac_ct_RC SET_MAKE TCL_THREADS CYGPATH CELIB_DIR DL_LIBS CFLAGS_DEBUG CFLAGS_OPTIMIZE CFLAGS_WARNING ZLIB_DLL_FILE ZLIB_LIBS ZLIB_OBJS CFLAGS_DEFAULT LDFLAGS_DEFAULT VC_MANIFEST_EMBED_DLL VC_MANIFEST_EMBED_EXE TCL_WIN_VERSION MACHINE TCL_VERSION TCL_MAJOR_VERSION TCL_MINOR_VERSION TCL_PATCH_LEVEL PKG_CFG_ARGS TCL_EXE TCL_LIB_FILE TCL_LIB_FLAG TCL_STATIC_LIB_FILE TCL_STATIC_LIB_FLAG TCL_IMPORT_LIB_FILE TCL_IMPORT_LIB_FLAG TCL_LIB_SPEC TCL_STUB_LIB_FILE TCL_STUB_LIB_FLAG TCL_STUB_LIB_SPEC TCL_STUB_LIB_PATH TCL_INCLUDE_SPEC TCL_BUILD_STUB_LIB_SPEC TCL_BUILD_STUB_LIB_PATH TCL_DLL_FILE TCL_SRC_DIR TCL_BIN_DIR TCL_DBGX CFG_TCL_SHARED_LIB_SUFFIX CFG_TCL_UNSHARED_LIB_SUFFIX CFG_TCL_EXPORT_FILE_SUFFIX EXTRA_CFLAGS DEPARG CC_OBJNAME CC_EXENAME LDFLAGS_DEBUG LDFLAGS_OPTIMIZE LDFLAGS_CONSOLE LDFLAGS_WINDOW STLIB_LD SHLIB_LD SHLIB_LD_LIBS SHLIB_CFLAGS SHLIB_SUFFIX TCL_SHARED_BUILD LIBS_GUI DLLSUFFIX LIBPREFIX LIBSUFFIX EXESUFFIX LIBRARIES MAKE_LIB MAKE_STUB_LIB POST_MAKE_LIB MAKE_DLL MAKE_EXE TCL_BUILD_LIB_SPEC TCL_CC_SEARCH_FLAGS TCL_LD_SEARCH_FLAGS TCL_NEEDS_EXP_FILE TCL_BUILD_EXP_FILE TCL_EXP_FILE TCL_LIB_VERSIONS_OK TCL_PACKAGE_PATH TCL_DDE_VERSION TCL_DDE_MAJOR_VERSION TCL_DDE_MINOR_VERSION TCL_REG_VERSION TCL_REG_MAJOR_VERSION TCL_REG_MINOR_VERSION RC_OUT RC_TYPE RC_INCLUDE RC_DEFINE RC_DEFINES RES LIBOBJS LTLIBOBJS'
+ac_subst_vars='LTLIBOBJS
+LIBOBJS
+RES
+RC_DEFINES
+RC_DEFINE
+RC_INCLUDE
+RC_TYPE
+RC_OUT
+TCL_REG_MINOR_VERSION
+TCL_REG_MAJOR_VERSION
+TCL_REG_VERSION
+TCL_DDE_MINOR_VERSION
+TCL_DDE_MAJOR_VERSION
+TCL_DDE_VERSION
+TCL_PACKAGE_PATH
+TCL_LIB_VERSIONS_OK
+TCL_EXP_FILE
+TCL_BUILD_EXP_FILE
+TCL_NEEDS_EXP_FILE
+TCL_LD_SEARCH_FLAGS
+TCL_CC_SEARCH_FLAGS
+TCL_BUILD_LIB_SPEC
+MAKE_EXE
+MAKE_DLL
+POST_MAKE_LIB
+MAKE_STUB_LIB
+MAKE_LIB
+LIBRARIES
+EXESUFFIX
+LIBSUFFIX
+LIBPREFIX
+DLLSUFFIX
+LIBS_GUI
+TCL_SHARED_BUILD
+SHLIB_SUFFIX
+SHLIB_CFLAGS
+SHLIB_LD_LIBS
+SHLIB_LD
+STLIB_LD
+LDFLAGS_WINDOW
+LDFLAGS_CONSOLE
+LDFLAGS_OPTIMIZE
+LDFLAGS_DEBUG
+CC_EXENAME
+CC_OBJNAME
+DEPARG
+EXTRA_CFLAGS
+CFG_TCL_EXPORT_FILE_SUFFIX
+CFG_TCL_UNSHARED_LIB_SUFFIX
+CFG_TCL_SHARED_LIB_SUFFIX
+TCL_DBGX
+TCL_BIN_DIR
+TCL_SRC_DIR
+TCL_DLL_FILE
+TCL_BUILD_STUB_LIB_PATH
+TCL_BUILD_STUB_LIB_SPEC
+TCL_INCLUDE_SPEC
+TCL_STUB_LIB_PATH
+TCL_STUB_LIB_SPEC
+TCL_STUB_LIB_FLAG
+TCL_STUB_LIB_FILE
+TCL_LIB_SPEC
+TCL_IMPORT_LIB_FLAG
+TCL_IMPORT_LIB_FILE
+TCL_STATIC_LIB_FLAG
+TCL_STATIC_LIB_FILE
+TCL_LIB_FLAG
+TCL_LIB_FILE
+TCL_EXE
+PKG_CFG_ARGS
+TCL_PATCH_LEVEL
+TCL_MINOR_VERSION
+TCL_MAJOR_VERSION
+TCL_VERSION
+MACHINE
+TCL_WIN_VERSION
+VC_MANIFEST_EMBED_EXE
+VC_MANIFEST_EMBED_DLL
+LDFLAGS_DEFAULT
+CFLAGS_DEFAULT
+INSTALL_MSGS
+INSTALL_LIBRARIES
+TCL_ZIP_FILE
+ZIPFS_BUILD
+ZIP_INSTALL_OBJS
+ZIP_PROG_VFSSEARCH
+ZIP_PROG_OPTIONS
+ZIP_PROG
+TCLSH_PROG
+EXEEXT_FOR_BUILD
+CC_FOR_BUILD
+ZLIB_OBJS
+ZLIB_LIBS
+ZLIB_DLL_FILE
+CFLAGS_WARNING
+CFLAGS_OPTIMIZE
+CFLAGS_DEBUG
+DL_LIBS
+WINE
+CYGPATH
+SHARED_BUILD
+SET_MAKE
+RC
+RANLIB
+AR
+EGREP
+GREP
+CPP
+OBJEXT
+EXEEXT
+ac_ct_CC
+CPPFLAGS
+LDFLAGS
+CFLAGS
+CC
+target_alias
+host_alias
+build_alias
+LIBS
+ECHO_T
+ECHO_N
+ECHO_C
+DEFS
+mandir
+localedir
+libdir
+psdir
+pdfdir
+dvidir
+htmldir
+infodir
+docdir
+oldincludedir
+includedir
+localstatedir
+sharedstatedir
+sysconfdir
+datadir
+datarootdir
+libexecdir
+sbindir
+bindir
+program_transform_name
+prefix
+exec_prefix
+PACKAGE_URL
+PACKAGE_BUGREPORT
+PACKAGE_STRING
+PACKAGE_VERSION
+PACKAGE_TARNAME
+PACKAGE_NAME
+PATH_SEPARATOR
+SHELL
+OBJEXT_FOR_BUILD'
ac_subst_files=''
+ac_user_opts='
+enable_option_checking
+with_encoding
+enable_shared
+enable_64bit
+enable_zipfs
+enable_symbols
+enable_embedded_manifest
+'
+ ac_precious_vars='build_alias
+host_alias
+target_alias
+CC
+CFLAGS
+LDFLAGS
+LIBS
+CPPFLAGS
+CPP'
+
# Initialize some variables set by options.
ac_init_help=
ac_init_version=false
+ac_unrecognized_opts=
+ac_unrecognized_sep=
# The variables have the same names as the options, with
# dashes changed to underlines.
cache_file=/dev/null
@@ -337,34 +821,49 @@ x_libraries=NONE
# and all the variables that are supposed to be based on exec_prefix
# by default will actually change.
# Use braces instead of parens because sh, perl, etc. also accept them.
+# (The list follows the same order as the GNU Coding Standards.)
bindir='${exec_prefix}/bin'
sbindir='${exec_prefix}/sbin'
libexecdir='${exec_prefix}/libexec'
-datadir='${prefix}/share'
+datarootdir='${prefix}/share'
+datadir='${datarootdir}'
sysconfdir='${prefix}/etc'
sharedstatedir='${prefix}/com'
localstatedir='${prefix}/var'
-libdir='${exec_prefix}/lib'
includedir='${prefix}/include'
oldincludedir='/usr/include'
-infodir='${prefix}/info'
-mandir='${prefix}/man'
+docdir='${datarootdir}/doc/${PACKAGE}'
+infodir='${datarootdir}/info'
+htmldir='${docdir}'
+dvidir='${docdir}'
+pdfdir='${docdir}'
+psdir='${docdir}'
+libdir='${exec_prefix}/lib'
+localedir='${datarootdir}/locale'
+mandir='${datarootdir}/man'
ac_prev=
+ac_dashdash=
for ac_option
do
# If the previous option needs an argument, assign it.
if test -n "$ac_prev"; then
- eval "$ac_prev=\$ac_option"
+ eval $ac_prev=\$ac_option
ac_prev=
continue
fi
- ac_optarg=`expr "x$ac_option" : 'x[^=]*=\(.*\)'`
+ case $ac_option in
+ *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;
+ *=) ac_optarg= ;;
+ *) ac_optarg=yes ;;
+ esac
# Accept the important Cygnus configure options, so we can diagnose typos.
- case $ac_option in
+ case $ac_dashdash$ac_option in
+ --)
+ ac_dashdash=yes ;;
-bindir | --bindir | --bindi | --bind | --bin | --bi)
ac_prev=bindir ;;
@@ -386,33 +885,59 @@ do
--config-cache | -C)
cache_file=config.cache ;;
- -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ -datadir | --datadir | --datadi | --datad)
ac_prev=datadir ;;
- -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
- | --da=*)
+ -datadir=* | --datadir=* | --datadi=* | --datad=*)
datadir=$ac_optarg ;;
+ -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \
+ | --dataroo | --dataro | --datar)
+ ac_prev=datarootdir ;;
+ -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \
+ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)
+ datarootdir=$ac_optarg ;;
+
-disable-* | --disable-*)
- ac_feature=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- eval "enable_$ac_feature=no" ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval enable_$ac_useropt=no ;;
+
+ -docdir | --docdir | --docdi | --doc | --do)
+ ac_prev=docdir ;;
+ -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)
+ docdir=$ac_optarg ;;
+
+ -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)
+ ac_prev=dvidir ;;
+ -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)
+ dvidir=$ac_optarg ;;
-enable-* | --enable-*)
- ac_feature=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_feature" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid feature name: $ac_feature" >&2
- { (exit 1); exit 1; }; }
- ac_feature=`echo $ac_feature | sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid feature name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"enable_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
esac
- eval "enable_$ac_feature='$ac_optarg'" ;;
+ eval enable_$ac_useropt=\$ac_optarg ;;
-exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
| --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
@@ -439,6 +964,12 @@ do
-host=* | --host=* | --hos=* | --ho=*)
host_alias=$ac_optarg ;;
+ -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)
+ ac_prev=htmldir ;;
+ -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \
+ | --ht=*)
+ htmldir=$ac_optarg ;;
+
-includedir | --includedir | --includedi | --included | --include \
| --includ | --inclu | --incl | --inc)
ac_prev=includedir ;;
@@ -463,13 +994,16 @@ do
| --libexe=* | --libex=* | --libe=*)
libexecdir=$ac_optarg ;;
+ -localedir | --localedir | --localedi | --localed | --locale)
+ ac_prev=localedir ;;
+ -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)
+ localedir=$ac_optarg ;;
+
-localstatedir | --localstatedir | --localstatedi | --localstated \
- | --localstate | --localstat | --localsta | --localst \
- | --locals | --local | --loca | --loc | --lo)
+ | --localstate | --localstat | --localsta | --localst | --locals)
ac_prev=localstatedir ;;
-localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
- | --localstate=* | --localstat=* | --localsta=* | --localst=* \
- | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)
localstatedir=$ac_optarg ;;
-mandir | --mandir | --mandi | --mand | --man | --ma | --m)
@@ -534,6 +1068,16 @@ do
| --progr-tra=* | --program-tr=* | --program-t=*)
program_transform_name=$ac_optarg ;;
+ -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)
+ ac_prev=pdfdir ;;
+ -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)
+ pdfdir=$ac_optarg ;;
+
+ -psdir | --psdir | --psdi | --psd | --ps)
+ ac_prev=psdir ;;
+ -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)
+ psdir=$ac_optarg ;;
+
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
silent=yes ;;
@@ -584,26 +1128,36 @@ do
ac_init_version=: ;;
-with-* | --with-*)
- ac_package=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- case $ac_option in
- *=*) ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`;;
- *) ac_optarg=yes ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
esac
- eval "with_$ac_package='$ac_optarg'" ;;
+ eval with_$ac_useropt=\$ac_optarg ;;
-without-* | --without-*)
- ac_package=`expr "x$ac_option" : 'x-*without-\(.*\)'`
+ ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`
# Reject names that are not valid shell variable names.
- expr "x$ac_package" : ".*[^-_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid package name: $ac_package" >&2
- { (exit 1); exit 1; }; }
- ac_package=`echo $ac_package | sed 's/-/_/g'`
- eval "with_$ac_package=no" ;;
+ expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&
+ as_fn_error $? "invalid package name: $ac_useropt"
+ ac_useropt_orig=$ac_useropt
+ ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`
+ case $ac_user_opts in
+ *"
+"with_$ac_useropt"
+"*) ;;
+ *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"
+ ac_unrecognized_sep=', ';;
+ esac
+ eval with_$ac_useropt=no ;;
--x)
# Obsolete; use --with-x.
@@ -623,27 +1177,26 @@ do
| --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
x_libraries=$ac_optarg ;;
- -*) { echo "$as_me: error: unrecognized option: $ac_option
-Try \`$0 --help' for more information." >&2
- { (exit 1); exit 1; }; }
+ -*) as_fn_error $? "unrecognized option: \`$ac_option'
+Try \`$0 --help' for more information"
;;
*=*)
ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`
# Reject names that are not valid shell variable names.
- expr "x$ac_envvar" : ".*[^_$as_cr_alnum]" >/dev/null &&
- { echo "$as_me: error: invalid variable name: $ac_envvar" >&2
- { (exit 1); exit 1; }; }
- ac_optarg=`echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"`
- eval "$ac_envvar='$ac_optarg'"
+ case $ac_envvar in #(
+ '' | [0-9]* | *[!_$as_cr_alnum]* )
+ as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;
+ esac
+ eval $ac_envvar=\$ac_optarg
export $ac_envvar ;;
*)
# FIXME: should be removed in autoconf 3.0.
- echo "$as_me: WARNING: you should use --build, --host, --target" >&2
+ $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2
expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&
- echo "$as_me: WARNING: invalid host type: $ac_option" >&2
- : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}
+ $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2
+ : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"
;;
esac
@@ -651,31 +1204,36 @@ done
if test -n "$ac_prev"; then
ac_option=--`echo $ac_prev | sed 's/_/-/g'`
- { echo "$as_me: error: missing argument to $ac_option" >&2
- { (exit 1); exit 1; }; }
+ as_fn_error $? "missing argument to $ac_option"
fi
-# Be sure to have absolute paths.
-for ac_var in exec_prefix prefix
-do
- eval ac_val=$`echo $ac_var`
- case $ac_val in
- [\\/$]* | ?:[\\/]* | NONE | '' ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+if test -n "$ac_unrecognized_opts"; then
+ case $enable_option_checking in
+ no) ;;
+ fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;
+ *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;
esac
-done
+fi
-# Be sure to have absolute paths.
-for ac_var in bindir sbindir libexecdir datadir sysconfdir sharedstatedir \
- localstatedir libdir includedir oldincludedir infodir mandir
+# Check all directory arguments for consistency.
+for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \
+ datadir sysconfdir sharedstatedir localstatedir includedir \
+ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \
+ libdir localedir mandir
do
- eval ac_val=$`echo $ac_var`
+ eval ac_val=\$$ac_var
+ # Remove trailing slashes.
+ case $ac_val in
+ */ )
+ ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`
+ eval $ac_var=\$ac_val;;
+ esac
+ # Be sure to have absolute directory names.
case $ac_val in
- [\\/$]* | ?:[\\/]* ) ;;
- *) { echo "$as_me: error: expected an absolute directory name for --$ac_var: $ac_val" >&2
- { (exit 1); exit 1; }; };;
+ [\\/$]* | ?:[\\/]* ) continue;;
+ NONE | '' ) case $ac_var in *prefix ) continue;; esac;;
esac
+ as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"
done
# There might be people who depend on the old broken behavior: `$host'
@@ -689,8 +1247,6 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- echo "$as_me: WARNING: If you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used." >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@@ -702,74 +1258,72 @@ test -n "$host_alias" && ac_tool_prefix=$host_alias-
test "$silent" = yes && exec 6>/dev/null
+ac_pwd=`pwd` && test -n "$ac_pwd" &&
+ac_ls_di=`ls -di .` &&
+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||
+ as_fn_error $? "working directory cannot be determined"
+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||
+ as_fn_error $? "pwd does not report name of working directory"
+
+
# Find the source files, if location was not specified.
if test -z "$srcdir"; then
ac_srcdir_defaulted=yes
- # Try the directory containing this script, then its parent.
- ac_confdir=`(dirname "$0") 2>/dev/null ||
-$as_expr X"$0" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$0" : 'X\(//\)[^/]' \| \
- X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$0" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ # Try the directory containing this script, then the parent directory.
+ ac_confdir=`$as_dirname -- "$as_myself" ||
+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_myself" : 'X\(//\)[^/]' \| \
+ X"$as_myself" : 'X\(//\)$' \| \
+ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_myself" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
srcdir=$ac_confdir
- if test ! -r $srcdir/$ac_unique_file; then
+ if test ! -r "$srcdir/$ac_unique_file"; then
srcdir=..
fi
else
ac_srcdir_defaulted=no
fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $ac_confdir or .." >&2
- { (exit 1); exit 1; }; }
- else
- { echo "$as_me: error: cannot find sources ($ac_unique_file) in $srcdir" >&2
- { (exit 1); exit 1; }; }
- fi
-fi
-(cd $srcdir && test -r ./$ac_unique_file) 2>/dev/null ||
- { echo "$as_me: error: sources are in $srcdir, but \`cd $srcdir' does not work" >&2
- { (exit 1); exit 1; }; }
-srcdir=`echo "$srcdir" | sed 's%\([^\\/]\)[\\/]*$%\1%'`
-ac_env_build_alias_set=${build_alias+set}
-ac_env_build_alias_value=$build_alias
-ac_cv_env_build_alias_set=${build_alias+set}
-ac_cv_env_build_alias_value=$build_alias
-ac_env_host_alias_set=${host_alias+set}
-ac_env_host_alias_value=$host_alias
-ac_cv_env_host_alias_set=${host_alias+set}
-ac_cv_env_host_alias_value=$host_alias
-ac_env_target_alias_set=${target_alias+set}
-ac_env_target_alias_value=$target_alias
-ac_cv_env_target_alias_set=${target_alias+set}
-ac_cv_env_target_alias_value=$target_alias
-ac_env_CC_set=${CC+set}
-ac_env_CC_value=$CC
-ac_cv_env_CC_set=${CC+set}
-ac_cv_env_CC_value=$CC
-ac_env_CFLAGS_set=${CFLAGS+set}
-ac_env_CFLAGS_value=$CFLAGS
-ac_cv_env_CFLAGS_set=${CFLAGS+set}
-ac_cv_env_CFLAGS_value=$CFLAGS
-ac_env_LDFLAGS_set=${LDFLAGS+set}
-ac_env_LDFLAGS_value=$LDFLAGS
-ac_cv_env_LDFLAGS_set=${LDFLAGS+set}
-ac_cv_env_LDFLAGS_value=$LDFLAGS
-ac_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_env_CPPFLAGS_value=$CPPFLAGS
-ac_cv_env_CPPFLAGS_set=${CPPFLAGS+set}
-ac_cv_env_CPPFLAGS_value=$CPPFLAGS
-ac_env_CPP_set=${CPP+set}
-ac_env_CPP_value=$CPP
-ac_cv_env_CPP_set=${CPP+set}
-ac_cv_env_CPP_value=$CPP
+if test ! -r "$srcdir/$ac_unique_file"; then
+ test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."
+ as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"
+fi
+ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"
+ac_abs_confdir=`(
+ cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"
+ pwd)`
+# When building in place, set srcdir=.
+if test "$ac_abs_confdir" = "$ac_pwd"; then
+ srcdir=.
+fi
+# Remove unnecessary trailing slashes from srcdir.
+# Double slashes in file names in object file debugging info
+# mess up M-x gdb in Emacs.
+case $srcdir in
+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;
+esac
+for ac_var in $ac_precious_vars; do
+ eval ac_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_env_${ac_var}_value=\$${ac_var}
+ eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}
+ eval ac_cv_env_${ac_var}_value=\$${ac_var}
+done
#
# Report the --help message.
@@ -792,20 +1346,17 @@ Configuration:
--help=short display options specific to this package
--help=recursive display the short help of all the included packages
-V, --version display version information and exit
- -q, --quiet, --silent do not print \`checking...' messages
+ -q, --quiet, --silent do not print \`checking ...' messages
--cache-file=FILE cache test results in FILE [disabled]
-C, --config-cache alias for \`--cache-file=config.cache'
-n, --no-create do not create output files
--srcdir=DIR find the sources in DIR [configure dir or \`..']
-_ACEOF
-
- cat <<_ACEOF
Installation directories:
--prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
+ [$ac_default_prefix]
--exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
- [PREFIX]
+ [PREFIX]
By default, \`make install' will install all the files in
\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify
@@ -815,18 +1366,25 @@ for instance \`--prefix=\$HOME'.
For better control, use the options below.
Fine tuning of the installation directories:
- --bindir=DIR user executables [EPREFIX/bin]
- --sbindir=DIR system admin executables [EPREFIX/sbin]
- --libexecdir=DIR program executables [EPREFIX/libexec]
- --datadir=DIR read-only architecture-independent data [PREFIX/share]
- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
- --localstatedir=DIR modifiable single-machine data [PREFIX/var]
- --libdir=DIR object code libraries [EPREFIX/lib]
- --includedir=DIR C header files [PREFIX/include]
- --oldincludedir=DIR C header files for non-gcc [/usr/include]
- --infodir=DIR info documentation [PREFIX/info]
- --mandir=DIR man documentation [PREFIX/man]
+ --bindir=DIR user executables [EPREFIX/bin]
+ --sbindir=DIR system admin executables [EPREFIX/sbin]
+ --libexecdir=DIR program executables [EPREFIX/libexec]
+ --sysconfdir=DIR read-only single-machine data [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data [PREFIX/var]
+ --libdir=DIR object code libraries [EPREFIX/lib]
+ --includedir=DIR C header files [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc [/usr/include]
+ --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]
+ --datadir=DIR read-only architecture-independent data [DATAROOTDIR]
+ --infodir=DIR info documentation [DATAROOTDIR/info]
+ --localedir=DIR locale-dependent data [DATAROOTDIR/locale]
+ --mandir=DIR man documentation [DATAROOTDIR/man]
+ --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE]
+ --htmldir=DIR html documentation [DOCDIR]
+ --dvidir=DIR dvi documentation [DOCDIR]
+ --pdfdir=DIR pdf documentation [DOCDIR]
+ --psdir=DIR ps documentation [DOCDIR]
_ACEOF
cat <<\_ACEOF
@@ -838,12 +1396,12 @@ if test -n "$ac_init_help"; then
cat <<\_ACEOF
Optional Features:
+ --disable-option-checking ignore unrecognized --enable/--with options
--disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
--enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --enable-threads build with threads (default: on)
--enable-shared build and link with shared libraries (default: on)
--enable-64bit enable 64bit support (where applicable)
- --enable-wince enable Win/CE support (where applicable)
+ --enable-zipfs build with Zipfs support (default: on)
--enable-symbols build with debugging symbols (default: off)
--enable-embedded-manifest
embed manifest if possible (default: yes)
@@ -852,133 +1410,355 @@ Optional Packages:
--with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
--without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
--with-encoding encoding for configuration values
- --with-celib=DIR use Windows/CE support library from DIR
Some influential environment variables:
CC C compiler command
CFLAGS C compiler flags
LDFLAGS linker flags, e.g. -L<lib dir> if you have libraries in a
nonstandard directory <lib dir>
- CPPFLAGS C/C++ preprocessor flags, e.g. -I<include dir> if you have
- headers in a nonstandard directory <include dir>
+ LIBS libraries to pass to the linker, e.g. -l<library>
+ CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if
+ you have headers in a nonstandard directory <include dir>
CPP C preprocessor
Use these variables to override the choices made by `configure' or to help
it to find libraries and programs with nonstandard names/locations.
+Report bugs to the package provider.
_ACEOF
+ac_status=$?
fi
if test "$ac_init_help" = "recursive"; then
# If there are subdirs, report their specific --help.
- ac_popdir=`pwd`
for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue
- test -d $ac_dir || continue
+ test -d "$ac_dir" ||
+ { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||
+ continue
ac_builddir=.
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
-
- cd $ac_dir
- # Check for guested configure; otherwise get Cygnus style configure.
- if test -f $ac_srcdir/configure.gnu; then
- echo
- $SHELL $ac_srcdir/configure.gnu --help=recursive
- elif test -f $ac_srcdir/configure; then
- echo
- $SHELL $ac_srcdir/configure --help=recursive
- elif test -f $ac_srcdir/configure.ac ||
- test -f $ac_srcdir/configure.in; then
- echo
- $ac_configure --help
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
+
+ cd "$ac_dir" || { ac_status=$?; continue; }
+ # Check for guested configure.
+ if test -f "$ac_srcdir/configure.gnu"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure.gnu" --help=recursive
+ elif test -f "$ac_srcdir/configure"; then
+ echo &&
+ $SHELL "$ac_srcdir/configure" --help=recursive
else
- echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
- fi
- cd $ac_popdir
+ $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2
+ fi || ac_status=$?
+ cd "$ac_pwd" || { ac_status=$?; break; }
done
fi
-test -n "$ac_init_help" && exit 0
+test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
+configure
+generated by GNU Autoconf 2.69
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
- exit 0
+ exit
fi
-exec 5>config.log
-cat >&5 <<_ACEOF
+
+## ------------------------ ##
+## Autoconf initialization. ##
+## ------------------------ ##
+
+# ac_fn_c_try_compile LINENO
+# --------------------------
+# Try to compile conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext
+ if { { ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compile") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest.$ac_objext; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_compile
+
+# ac_fn_c_try_cpp LINENO
+# ----------------------
+# Try to preprocess conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_cpp ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { { ac_try="$ac_cpp conftest.$ac_ext"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } > conftest.i && {
+ test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_cpp
+
+# ac_fn_c_try_run LINENO
+# ----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes
+# that executables *can* be run.
+ac_fn_c_try_run ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && { ac_try='./conftest$ac_exeext'
+ { { case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_try") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: program exited with status $ac_status" >&5
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=$ac_status
+fi
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_run
+
+# ac_fn_c_check_decl LINENO SYMBOL VAR INCLUDES
+# ---------------------------------------------
+# Tests whether SYMBOL is declared in INCLUDES, setting cache variable VAR
+# accordingly.
+ac_fn_c_check_decl ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ as_decl_name=`echo $2|sed 's/ *(.*//'`
+ as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'`
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5
+$as_echo_n "checking whether $as_decl_name is declared... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+#ifndef $as_decl_name
+#ifdef __cplusplus
+ (void) $as_decl_use;
+#else
+ (void) $as_decl_name;
+#endif
+#endif
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_decl
+
+# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES
+# -------------------------------------------------------
+# Tests whether HEADER exists and can be compiled using the include files in
+# INCLUDES, setting the cache variable VAR accordingly.
+ac_fn_c_check_header_compile ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+#include <$2>
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ eval "$3=yes"
+else
+ eval "$3=no"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_header_compile
+
+# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
+# -------------------------------------------
+# Tests whether TYPE exists after having included INCLUDES, setting cache
+# variable VAR accordingly.
+ac_fn_c_check_type ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
+$as_echo_n "checking for $2... " >&6; }
+if eval \${$3+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ eval "$3=no"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+if (sizeof ($2))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+$4
+int
+main ()
+{
+if (sizeof (($2)))
+ return 0;
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+ eval "$3=yes"
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+eval ac_res=\$$3
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
+$as_echo "$ac_res" >&6; }
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+
+} # ac_fn_c_check_type
+cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
_ACEOF
+exec 5>>config.log
{
cat <<_ASUNAME
## --------- ##
@@ -997,7 +1777,7 @@ uname -v = `(uname -v) 2>/dev/null || echo unknown`
/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`
/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`
/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`
-hostinfo = `(hostinfo) 2>/dev/null || echo unknown`
+/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`
/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`
/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`
/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`
@@ -1009,8 +1789,9 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- echo "PATH: $as_dir"
-done
+ $as_echo "PATH: $as_dir"
+ done
+IFS=$as_save_IFS
} >&5
@@ -1032,7 +1813,6 @@ _ACEOF
ac_configure_args=
ac_configure_args0=
ac_configure_args1=
-ac_sep=
ac_must_keep_next=false
for ac_pass in 1 2
do
@@ -1043,13 +1823,13 @@ do
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil)
continue ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=`echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*)
+ ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;
esac
case $ac_pass in
- 1) ac_configure_args0="$ac_configure_args0 '$ac_arg'" ;;
+ 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;
2)
- ac_configure_args1="$ac_configure_args1 '$ac_arg'"
+ as_fn_append ac_configure_args1 " '$ac_arg'"
if test $ac_must_keep_next = true; then
ac_must_keep_next=false # Got value, back to normal.
else
@@ -1065,104 +1845,115 @@ do
-* ) ac_must_keep_next=true ;;
esac
fi
- ac_configure_args="$ac_configure_args$ac_sep'$ac_arg'"
- # Get rid of the leading space.
- ac_sep=" "
+ as_fn_append ac_configure_args " '$ac_arg'"
;;
esac
done
done
-$as_unset ac_configure_args0 || test "${ac_configure_args0+set}" != set || { ac_configure_args0=; export ac_configure_args0; }
-$as_unset ac_configure_args1 || test "${ac_configure_args1+set}" != set || { ac_configure_args1=; export ac_configure_args1; }
+{ ac_configure_args0=; unset ac_configure_args0;}
+{ ac_configure_args1=; unset ac_configure_args1;}
# When interrupted or exit'd, cleanup temporary files, and complete
# config.log. We remove comments because anyway the quotes in there
# would cause problems or look ugly.
-# WARNING: Be sure not to use single quotes in there, as some shells,
-# such as our DU 5.0 friend, will then `close' the trap.
+# WARNING: Use '\'' to represent an apostrophe within the trap.
+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.
trap 'exit_status=$?
# Save into config.log some information that might help in debugging.
{
echo
- cat <<\_ASBOX
-## ---------------- ##
+ $as_echo "## ---------------- ##
## Cache variables. ##
-## ---------------- ##
-_ASBOX
+## ---------------- ##"
echo
# The following way of writing the cache mishandles newlines in values,
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
+ esac ;;
+ esac
+ done
(set) 2>&1 |
- case `(ac_space='"'"' '"'"'; set | grep ac_space) 2>&1` in
- *ac_space=\ *)
+ case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
sed -n \
- "s/'"'"'/'"'"'\\\\'"'"''"'"'/g;
- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='"'"'\\2'"'"'/p"
- ;;
+ "s/'\''/'\''\\\\'\'''\''/g;
+ s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"
+ ;; #(
*)
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-}
+ esac |
+ sort
+)
echo
- cat <<\_ASBOX
-## ----------------- ##
+ $as_echo "## ----------------- ##
## Output variables. ##
-## ----------------- ##
-_ASBOX
+## ----------------- ##"
echo
for ac_var in $ac_subst_vars
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
if test -n "$ac_subst_files"; then
- cat <<\_ASBOX
-## ------------- ##
-## Output files. ##
-## ------------- ##
-_ASBOX
+ $as_echo "## ------------------- ##
+## File substitutions. ##
+## ------------------- ##"
echo
for ac_var in $ac_subst_files
do
- eval ac_val=$`echo $ac_var`
- echo "$ac_var='"'"'$ac_val'"'"'"
+ eval ac_val=\$$ac_var
+ case $ac_val in
+ *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;
+ esac
+ $as_echo "$ac_var='\''$ac_val'\''"
done | sort
echo
fi
if test -s confdefs.h; then
- cat <<\_ASBOX
-## ----------- ##
+ $as_echo "## ----------- ##
## confdefs.h. ##
-## ----------- ##
-_ASBOX
+## ----------- ##"
echo
- sed "/^$/d" confdefs.h | sort
+ cat confdefs.h
echo
fi
test "$ac_signal" != 0 &&
- echo "$as_me: caught signal $ac_signal"
- echo "$as_me: exit $exit_status"
+ $as_echo "$as_me: caught signal $ac_signal"
+ $as_echo "$as_me: exit $exit_status"
} >&5
- rm -f core *.core &&
- rm -rf conftest* confdefs* conf$$* $ac_clean_files &&
+ rm -f core *.core core.conftest.* &&
+ rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&
exit $exit_status
- ' 0
+' 0
for ac_signal in 1 2 13 15; do
- trap 'ac_signal='$ac_signal'; { (exit 1); exit 1; }' $ac_signal
+ trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal
done
ac_signal=0
# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo >confdefs.h
+rm -f -r conftest* confdefs.h
+
+$as_echo "/* confdefs.h */" > confdefs.h
# Predefined preprocessor variables.
@@ -1170,112 +1961,137 @@ cat >>confdefs.h <<_ACEOF
#define PACKAGE_NAME "$PACKAGE_NAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_TARNAME "$PACKAGE_TARNAME"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_VERSION "$PACKAGE_VERSION"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_STRING "$PACKAGE_STRING"
_ACEOF
-
cat >>confdefs.h <<_ACEOF
#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"
_ACEOF
+cat >>confdefs.h <<_ACEOF
+#define PACKAGE_URL "$PACKAGE_URL"
+_ACEOF
+
# Let the site file select an alternate cache file if it wants to.
-# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
+# Prefer an explicitly selected file to automatically selected ones.
+ac_site_file1=NONE
+ac_site_file2=NONE
+if test -n "$CONFIG_SITE"; then
+ # We do not want a PATH search for config.site.
+ case $CONFIG_SITE in #((
+ -*) ac_site_file1=./$CONFIG_SITE;;
+ */*) ac_site_file1=$CONFIG_SITE;;
+ *) ac_site_file1=./$CONFIG_SITE;;
+ esac
+elif test "x$prefix" != xNONE; then
+ ac_site_file1=$prefix/share/config.site
+ ac_site_file2=$prefix/etc/config.site
+else
+ ac_site_file1=$ac_default_prefix/share/config.site
+ ac_site_file2=$ac_default_prefix/etc/config.site
fi
-for ac_site_file in $CONFIG_SITE; do
- if test -r "$ac_site_file"; then
- { echo "$as_me:$LINENO: loading site script $ac_site_file" >&5
-echo "$as_me: loading site script $ac_site_file" >&6;}
+for ac_site_file in "$ac_site_file1" "$ac_site_file2"
+do
+ test "x$ac_site_file" = xNONE && continue
+ if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5
+$as_echo "$as_me: loading site script $ac_site_file" >&6;}
sed 's/^/| /' "$ac_site_file" >&5
- . "$ac_site_file"
+ . "$ac_site_file" \
+ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "failed to load site script $ac_site_file
+See \`config.log' for more details" "$LINENO" 5; }
fi
done
if test -r "$cache_file"; then
- # Some versions of bash will fail to source /dev/null (special
- # files actually), so we avoid doing that.
- if test -f "$cache_file"; then
- { echo "$as_me:$LINENO: loading cache $cache_file" >&5
-echo "$as_me: loading cache $cache_file" >&6;}
+ # Some versions of bash will fail to source /dev/null (special files
+ # actually), so we avoid doing that. DJGPP emulates it as a regular file.
+ if test /dev/null != "$cache_file" && test -f "$cache_file"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5
+$as_echo "$as_me: loading cache $cache_file" >&6;}
case $cache_file in
- [\\/]* | ?:[\\/]* ) . $cache_file;;
- *) . ./$cache_file;;
+ [\\/]* | ?:[\\/]* ) . "$cache_file";;
+ *) . "./$cache_file";;
esac
fi
else
- { echo "$as_me:$LINENO: creating cache $cache_file" >&5
-echo "$as_me: creating cache $cache_file" >&6;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5
+$as_echo "$as_me: creating cache $cache_file" >&6;}
>$cache_file
fi
# Check that the precious variables saved in the cache have kept the same
# value.
ac_cache_corrupted=false
-for ac_var in `(set) 2>&1 |
- sed -n 's/^ac_env_\([a-zA-Z_0-9]*\)_set=.*/\1/p'`; do
+for ac_var in $ac_precious_vars; do
eval ac_old_set=\$ac_cv_env_${ac_var}_set
eval ac_new_set=\$ac_env_${ac_var}_set
- eval ac_old_val="\$ac_cv_env_${ac_var}_value"
- eval ac_new_val="\$ac_env_${ac_var}_value"
+ eval ac_old_val=\$ac_cv_env_${ac_var}_value
+ eval ac_new_val=\$ac_env_${ac_var}_value
case $ac_old_set,$ac_new_set in
set,)
- { echo "$as_me:$LINENO: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}
ac_cache_corrupted=: ;;
,set)
- { echo "$as_me:$LINENO: error: \`$ac_var' was not set in the previous run" >&5
-echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5
+$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}
ac_cache_corrupted=: ;;
,);;
*)
if test "x$ac_old_val" != "x$ac_new_val"; then
- { echo "$as_me:$LINENO: error: \`$ac_var' has changed since the previous run:" >&5
-echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
- { echo "$as_me:$LINENO: former value: $ac_old_val" >&5
-echo "$as_me: former value: $ac_old_val" >&2;}
- { echo "$as_me:$LINENO: current value: $ac_new_val" >&5
-echo "$as_me: current value: $ac_new_val" >&2;}
- ac_cache_corrupted=:
+ # differences in whitespace do not lead to failure.
+ ac_old_val_w=`echo x $ac_old_val`
+ ac_new_val_w=`echo x $ac_new_val`
+ if test "$ac_old_val_w" != "$ac_new_val_w"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5
+$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}
+ ac_cache_corrupted=:
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5
+$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}
+ eval $ac_var=\$ac_old_val
+ fi
+ { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5
+$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5
+$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}
fi;;
esac
# Pass precious variables to config.status.
if test "$ac_new_set" = set; then
case $ac_new_val in
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?\"\']*)
- ac_arg=$ac_var=`echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
+ *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;
*) ac_arg=$ac_var=$ac_new_val ;;
esac
case " $ac_configure_args " in
*" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.
- *) ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) as_fn_append ac_configure_args " '$ac_arg'" ;;
esac
fi
done
if $ac_cache_corrupted; then
- { echo "$as_me:$LINENO: error: changes in the environment can compromise the build" >&5
-echo "$as_me: error: changes in the environment can compromise the build" >&2;}
- { { echo "$as_me:$LINENO: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&5
-echo "$as_me: error: run \`make distclean' and/or \`rm $cache_file' and start over" >&2;}
- { (exit 1); exit 1; }; }
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5
+$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}
+ as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5
fi
+## -------------------- ##
+## Main body of script. ##
+## -------------------- ##
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
@@ -1286,32 +2102,15 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.6
+TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".9"
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -1362,10 +2161,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.
set dummy ${ac_tool_prefix}gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1375,35 +2174,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_CC"; then
ac_ct_CC=$CC
# Extract the first word of "gcc", so it can be a program name with args.
set dummy gcc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -1413,39 +2214,50 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- CC=$ac_ct_CC
+ if test "x$ac_ct_CC" = x; then
+ CC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ CC=$ac_ct_CC
+ fi
else
CC="$ac_cv_prog_CC"
fi
if test -z "$CC"; then
- if test -n "$ac_tool_prefix"; then
- # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
+ if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.
set dummy ${ac_tool_prefix}cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1455,77 +2267,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
-fi
-if test -z "$ac_cv_prog_CC"; then
- ac_ct_CC=$CC
- # Extract the first word of "cc", so it can be a program name with args.
-set dummy cc; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- if test -n "$ac_ct_CC"; then
- ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
-else
-as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
- ac_cv_prog_ac_ct_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
- break 2
- fi
-done
-done
-
-fi
-fi
-ac_ct_CC=$ac_cv_prog_ac_ct_CC
-if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
-else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
-fi
-
- CC=$ac_ct_CC
-else
- CC="$ac_cv_prog_CC"
-fi
+ fi
fi
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 "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1536,18 +2308,19 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
fi
ac_cv_prog_CC="cc"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
if test $ac_prog_rejected = yes; then
# We found a bogon in the path, so make sure we never use it.
@@ -1565,24 +2338,25 @@ fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$CC"; then
if test -n "$ac_tool_prefix"; then
- for ac_prog in cl
+ for ac_prog in cl.exe
do
# Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.
set dummy $ac_tool_prefix$ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CC"; then
ac_cv_prog_CC="$CC" # Let the user override the test.
@@ -1592,39 +2366,41 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
CC=$ac_cv_prog_CC
if test -n "$CC"; then
- echo "$as_me:$LINENO: result: $CC" >&5
-echo "${ECHO_T}$CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5
+$as_echo "$CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
test -n "$CC" && break
done
fi
if test -z "$CC"; then
ac_ct_CC=$CC
- for ac_prog in cl
+ for ac_prog in cl.exe
do
# Extract the first word of "$ac_prog", so it can be a program name with args.
set dummy $ac_prog; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_CC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_CC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_CC"; then
ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test.
@@ -1634,66 +2410,78 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_CC=$ac_cv_prog_ac_ct_CC
if test -n "$ac_ct_CC"; then
- echo "$as_me:$LINENO: result: $ac_ct_CC" >&5
-echo "${ECHO_T}$ac_ct_CC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5
+$as_echo "$ac_ct_CC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
test -n "$ac_ct_CC" && break
done
- CC=$ac_ct_CC
+ if test "x$ac_ct_CC" = x; then
+ CC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ CC=$ac_ct_CC
+ fi
fi
fi
-test -z "$CC" && { { echo "$as_me:$LINENO: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&5
-echo "$as_me: error: no acceptable C compiler found in \$PATH
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "no acceptable C compiler found in \$PATH
+See \`config.log' for more details" "$LINENO" 5; }
# Provide some information about the compiler.
-echo "$as_me:$LINENO:" \
- "checking for C compiler version" >&5
-ac_compiler=`set X $ac_compile; echo $2`
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler --version </dev/null >&5\"") >&5
- (eval $ac_compiler --version </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -v </dev/null >&5\"") >&5
- (eval $ac_compiler -v </dev/null >&5) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
-{ (eval echo "$as_me:$LINENO: \"$ac_compiler -V </dev/null >&5\"") >&5
- (eval $ac_compiler -V </dev/null >&5) 2>&5
+$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5
+set X $ac_compile
+ac_compiler=$2
+for ac_option in --version -v -V -qversion; do
+ { { ac_try="$ac_compiler $ac_option >&5"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compiler $ac_option >&5") 2>conftest.err
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }
+ if test -s conftest.err; then
+ sed '10a\
+... rest of stderr output deleted ...
+ 10q' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ fi
+ rm -f conftest.er1 conftest.err
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+done
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -1705,112 +2493,108 @@ main ()
}
_ACEOF
ac_clean_files_save=$ac_clean_files
-ac_clean_files="$ac_clean_files a.out a.exe b.out"
+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"
# Try to create an executable without -o first, disregard a.out.
# It will help us diagnose broken compilers, and finding out an intuition
# of exeext.
-echo "$as_me:$LINENO: checking for C compiler default output file name" >&5
-echo $ECHO_N "checking for C compiler default output file name... $ECHO_C" >&6
-ac_link_default=`echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
-if { (eval echo "$as_me:$LINENO: \"$ac_link_default\"") >&5
- (eval $ac_link_default) 2>&5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5
+$as_echo_n "checking whether the C compiler works... " >&6; }
+ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'`
+
+# The possible output files:
+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"
+
+ac_rmfiles=
+for ac_file in $ac_files
+do
+ case $ac_file in
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
+ * ) ac_rmfiles="$ac_rmfiles $ac_file";;
+ esac
+done
+rm -f $ac_rmfiles
+
+if { { ac_try="$ac_link_default"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link_default") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- # Find the output, starting from the most likely. This scheme is
-# not robust to junk in `.', hence go to wildcards (a.*) only as a last
-# resort.
-
-# Be careful to initialize this variable, since it used to be cached.
-# Otherwise an old cache value of `no' led to `EXEEXT = no' in a Makefile.
-ac_cv_exeext=
-# b.out is created by i960 compilers.
-for ac_file in a_out.exe a.exe conftest.exe a.out conftest a.* conftest.* b.out
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
+ # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.
+# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'
+# in a Makefile. We should not override ac_cv_exeext if it was cached,
+# so that the user can short-circuit this test for compilers unknown to
+# Autoconf.
+for ac_file in $ac_files ''
do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj )
- ;;
- conftest.$ac_ext )
- # This is the source file.
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )
;;
[ab].out )
# We found the default executable, but exeext='' is most
# certainly right.
break;;
*.* )
- ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- # FIXME: I believe we export ac_cv_exeext for Libtool,
- # but it would be cool to find out if it's true. Does anybody
- # maintain Libtool? --akim.
- export ac_cv_exeext
+ if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no;
+ then :; else
+ ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
+ fi
+ # We set ac_cv_exeext here because the later test for it is not
+ # safe: cross compilers may not add the suffix if given an `-o'
+ # argument, so we may need to know it at that point already.
+ # Even if this section looks crufty: it has the advantage of
+ # actually working.
break;;
* )
break;;
esac
done
+test "$ac_cv_exeext" = no && ac_cv_exeext=
+
else
- echo "$as_me: failed program was:" >&5
+ ac_file=''
+fi
+if test -z "$ac_file"; then :
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+$as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-{ { echo "$as_me:$LINENO: error: C compiler cannot create executables
-See \`config.log' for more details." >&5
-echo "$as_me: error: C compiler cannot create executables
-See \`config.log' for more details." >&2;}
- { (exit 77); exit 77; }; }
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error 77 "C compiler cannot create executables
+See \`config.log' for more details" "$LINENO" 5; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
fi
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5
+$as_echo_n "checking for C compiler default output file name... " >&6; }
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5
+$as_echo "$ac_file" >&6; }
ac_exeext=$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_file" >&5
-echo "${ECHO_T}$ac_file" >&6
-# Check the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether the C compiler works" >&5
-echo $ECHO_N "checking whether the C compiler works... $ECHO_C" >&6
-# FIXME: These cross compiler hacks should be removed for Autoconf 3.0
-# If not cross compiling, check that we can run a simple program.
-if test "$cross_compiling" != yes; then
- if { ac_try='./$ac_file'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- cross_compiling=no
- else
- if test "$cross_compiling" = maybe; then
- cross_compiling=yes
- else
- { { echo "$as_me:$LINENO: error: cannot run C compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot run C compiled programs.
-If you meant to cross compile, use \`--host'.
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
- fi
- fi
-fi
-echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
-
-rm -f a.out a.exe conftest$ac_cv_exeext b.out
+rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out
ac_clean_files=$ac_clean_files_save
-# Check the compiler produces executables we can run. If not, either
-# the compiler is broken, or we cross compile.
-echo "$as_me:$LINENO: checking whether we are cross compiling" >&5
-echo $ECHO_N "checking whether we are cross compiling... $ECHO_C" >&6
-echo "$as_me:$LINENO: result: $cross_compiling" >&5
-echo "${ECHO_T}$cross_compiling" >&6
-
-echo "$as_me:$LINENO: checking for suffix of executables" >&5
-echo $ECHO_N "checking for suffix of executables... $ECHO_C" >&6
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5
+$as_echo_n "checking for suffix of executables... " >&6; }
+if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
# If both `conftest.exe' and `conftest' are `present' (well, observable)
# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will
# work properly (i.e., refer to `conftest.exe'), while it won't with
@@ -1818,38 +2602,90 @@ if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
for ac_file in conftest.exe conftest conftest.*; do
test -f "$ac_file" || continue
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.o | *.obj ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;
*.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`
- export ac_cv_exeext
break;;
* ) break;;
esac
done
else
- { { echo "$as_me:$LINENO: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of executables: cannot compile and link
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of executables: cannot compile and link
+See \`config.log' for more details" "$LINENO" 5; }
fi
-
-rm -f conftest$ac_cv_exeext
-echo "$as_me:$LINENO: result: $ac_cv_exeext" >&5
-echo "${ECHO_T}$ac_cv_exeext" >&6
+rm -f conftest conftest$ac_cv_exeext
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5
+$as_echo "$ac_cv_exeext" >&6; }
rm -f conftest.$ac_ext
EXEEXT=$ac_cv_exeext
ac_exeext=$EXEEXT
-echo "$as_me:$LINENO: checking for suffix of object files" >&5
-echo $ECHO_N "checking for suffix of object files... $ECHO_C" >&6
-if test "${ac_cv_objext+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+#include <stdio.h>
+int
+main ()
+{
+FILE *f = fopen ("conftest.out", "w");
+ return ferror (f) || fclose (f) != 0;
+
+ ;
+ return 0;
+}
_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ac_clean_files="$ac_clean_files conftest.out"
+# Check that the compiler produces executables we can run. If not, either
+# the compiler is broken, or we cross compile.
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5
+$as_echo_n "checking whether we are cross compiling... " >&6; }
+if test "$cross_compiling" != yes; then
+ { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }
+ if { ac_try='./conftest$ac_cv_exeext'
+ { { case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_try") 2>&5
+ ac_status=$?
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; }; then
+ cross_compiling=no
+ else
+ if test "$cross_compiling" = maybe; then
+ cross_compiling=yes
+ else
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot run C compiled programs.
+If you meant to cross compile, use \`--host'.
+See \`config.log' for more details" "$LINENO" 5; }
+ fi
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5
+$as_echo "$cross_compiling" >&6; }
+
+rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out
+ac_clean_files=$ac_clean_files_save
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5
+$as_echo_n "checking for suffix of object files... " >&6; }
+if ${ac_cv_objext+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -1861,45 +2697,46 @@ main ()
}
_ACEOF
rm -f conftest.o conftest.obj
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>&5
+if { { ac_try="$ac_compile"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_compile") 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; then
- for ac_file in `(ls conftest.o conftest.obj; ls conftest.*) 2>/dev/null`; do
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; then :
+ for ac_file in conftest.o conftest.obj conftest.*; do
+ test -f "$ac_file" || continue;
case $ac_file in
- *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg ) ;;
+ *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;
*) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`
break;;
esac
done
else
- echo "$as_me: failed program was:" >&5
+ $as_echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
-{ { echo "$as_me:$LINENO: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&5
-echo "$as_me: error: cannot compute suffix of object files: cannot compile
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "cannot compute suffix of object files: cannot compile
+See \`config.log' for more details" "$LINENO" 5; }
fi
-
rm -f conftest.$ac_cv_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_objext" >&5
-echo "${ECHO_T}$ac_cv_objext" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5
+$as_echo "$ac_cv_objext" >&6; }
OBJEXT=$ac_cv_objext
ac_objext=$OBJEXT
-echo "$as_me:$LINENO: checking whether we are using the GNU C compiler" >&5
-echo $ECHO_N "checking whether we are using the GNU C compiler... $ECHO_C" >&6
-if test "${ac_cv_c_compiler_gnu+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5
+$as_echo_n "checking whether we are using the GNU C compiler... " >&6; }
+if ${ac_cv_c_compiler_gnu+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -1913,55 +2750,34 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_compiler_gnu=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_compiler_gnu=no
+ ac_compiler_gnu=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
ac_cv_c_compiler_gnu=$ac_compiler_gnu
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_compiler_gnu" >&5
-echo "${ECHO_T}$ac_cv_c_compiler_gnu" >&6
-GCC=`test $ac_compiler_gnu = yes && echo yes`
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5
+$as_echo "$ac_cv_c_compiler_gnu" >&6; }
+if test $ac_compiler_gnu = yes; then
+ GCC=yes
+else
+ GCC=
+fi
ac_test_CFLAGS=${CFLAGS+set}
ac_save_CFLAGS=$CFLAGS
-CFLAGS="-g"
-echo "$as_me:$LINENO: checking whether $CC accepts -g" >&5
-echo $ECHO_N "checking whether $CC accepts -g... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_g+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5
+$as_echo_n "checking whether $CC accepts -g... " >&6; }
+if ${ac_cv_prog_cc_g+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ ac_save_c_werror_flag=$ac_c_werror_flag
+ ac_c_werror_flag=yes
+ ac_cv_prog_cc_g=no
+ CFLAGS="-g"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -1972,39 +2788,49 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_prog_cc_g=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ CFLAGS=""
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
+
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+
+else
+ ac_c_werror_flag=$ac_save_c_werror_flag
+ CFLAGS="-g"
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
+/* end confdefs.h. */
+
+int
+main ()
+{
-ac_cv_prog_cc_g=no
+ ;
+ return 0;
+}
+_ACEOF
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_prog_cc_g=yes
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_cc_g" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_g" >&6
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+fi
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ ac_c_werror_flag=$ac_save_c_werror_flag
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5
+$as_echo "$ac_cv_prog_cc_g" >&6; }
if test "$ac_test_CFLAGS" = set; then
CFLAGS=$ac_save_CFLAGS
elif test $ac_cv_prog_cc_g = yes; then
@@ -2020,23 +2846,18 @@ else
CFLAGS=
fi
fi
-echo "$as_me:$LINENO: checking for $CC option to accept ANSI C" >&5
-echo $ECHO_N "checking for $CC option to accept ANSI C... $ECHO_C" >&6
-if test "${ac_cv_prog_cc_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5
+$as_echo_n "checking for $CC option to accept ISO C89... " >&6; }
+if ${ac_cv_prog_cc_c89+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- ac_cv_prog_cc_stdc=no
+ ac_cv_prog_cc_c89=no
ac_save_CC=$CC
-cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@@ -2059,12 +2880,17 @@ static char *f (char * (*g) (char **, int), char **p, ...)
/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has
function prototypes and stuff, but not '\xHH' hex character constants.
These don't provoke an error unfortunately, instead are silently treated
- as 'x'. The following induces an error, until -std1 is added to get
+ as 'x'. The following induces an error, until -std is added to get
proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an
array size at least. It's necessary to write '\x00'==0 to get something
- that's true only with -std1. */
+ that's true only with -std. */
int osf4_cc_array ['\x00' == 0 ? 1 : -1];
+/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters
+ inside strings and character constants. */
+#define FOO(x) 'x'
+int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1];
+
int test (int i, double x);
struct s1 {int (*f) (int a);};
struct s2 {int (*f) (double a);};
@@ -2079,205 +2905,37 @@ return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
return 0;
}
_ACEOF
-# Don't try gcc -ansi; that turns off useful extensions and
-# breaks some systems' header files.
-# AIX -qlanglvl=ansi
-# Ultrix and OSF/1 -std1
-# HP-UX 10.20 and later -Ae
-# HP-UX older versions -Aa -D_HPUX_SOURCE
-# SVR4 -Xc -D__EXTENSIONS__
-for ac_arg in "" -qlanglvl=ansi -std1 -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \
+ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
do
CC="$ac_save_CC $ac_arg"
- rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_prog_cc_stdc=$ac_arg
-break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
+ if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_prog_cc_c89=$ac_arg
fi
-rm -f conftest.err conftest.$ac_objext
+rm -f core conftest.err conftest.$ac_objext
+ test "x$ac_cv_prog_cc_c89" != "xno" && break
done
-rm -f conftest.$ac_ext conftest.$ac_objext
+rm -f conftest.$ac_ext
CC=$ac_save_CC
fi
-
-case "x$ac_cv_prog_cc_stdc" in
- x|xno)
- echo "$as_me:$LINENO: result: none needed" >&5
-echo "${ECHO_T}none needed" >&6 ;;
+# AC_CACHE_VAL
+case "x$ac_cv_prog_cc_c89" in
+ x)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5
+$as_echo "none needed" >&6; } ;;
+ xno)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5
+$as_echo "unsupported" >&6; } ;;
*)
- echo "$as_me:$LINENO: result: $ac_cv_prog_cc_stdc" >&5
-echo "${ECHO_T}$ac_cv_prog_cc_stdc" >&6
- CC="$CC $ac_cv_prog_cc_stdc" ;;
+ CC="$CC $ac_cv_prog_cc_c89"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5
+$as_echo "$ac_cv_prog_cc_c89" >&6; } ;;
esac
-
-# Some people use a C++ compiler to compile C. Since we use `exit',
-# in C++ we need to declare it. In case someone uses the same compiler
-# for both compiling C and C++ we need to have the C++ compiler decide
-# the declaration of exit, since it's the most demanding environment.
-cat >conftest.$ac_ext <<_ACEOF
-#ifndef __cplusplus
- choke me
-#endif
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- for ac_declaration in \
- '' \
- 'extern "C" void std::exit (int) throw (); using std::exit;' \
- 'extern "C" void std::exit (int); using std::exit;' \
- 'extern "C" void exit (int) throw ();' \
- 'extern "C" void exit (int);' \
- 'void exit (int);'
-do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_declaration
-#include <stdlib.h>
-int
-main ()
-{
-exit (42);
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-continue
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_declaration
-int
-main ()
-{
-exit (42);
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if test "x$ac_cv_prog_cc_c89" != xno; then :
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-done
-rm -f conftest*
-if test -n "$ac_declaration"; then
- echo '#ifdef __cplusplus' >>confdefs.h
- echo $ac_declaration >>confdefs.h
- echo '#endif' >>confdefs.h
-fi
-
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
ac_ext=c
ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
@@ -2285,18 +2943,14 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking for inline" >&5
-echo $ECHO_N "checking for inline... $ECHO_C" >&6
-if test "${ac_cv_c_inline+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5
+$as_echo_n "checking for inline... " >&6; }
+if ${ac_cv_c_inline+:} false; then :
+ $as_echo_n "(cached) " >&6
else
ac_cv_c_inline=no
for ac_kw in inline __inline__ __inline; do
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifndef __cplusplus
typedef int foo_t;
@@ -2305,41 +2959,16 @@ $ac_kw foo_t foo () {return 0; }
#endif
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_c_inline=$ac_kw; break
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
+if ac_fn_c_try_compile "$LINENO"; then :
+ ac_cv_c_inline=$ac_kw
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
+ test "$ac_cv_c_inline" != no && break
done
fi
-echo "$as_me:$LINENO: result: $ac_cv_c_inline" >&5
-echo "${ECHO_T}$ac_cv_c_inline" >&6
-
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5
+$as_echo "$ac_cv_c_inline" >&6; }
case $ac_cv_c_inline in
inline | yes) ;;
@@ -2361,15 +2990,15 @@ ac_cpp='$CPP $CPPFLAGS'
ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'
ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking how to run the C preprocessor" >&5
-echo $ECHO_N "checking how to run the C preprocessor... $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5
+$as_echo_n "checking how to run the C preprocessor... " >&6; }
# On Suns, sometimes $CPP names a directory.
if test -n "$CPP" && test -d "$CPP"; then
CPP=
fi
if test -z "$CPP"; then
- if test "${ac_cv_prog_CPP+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ if ${ac_cv_prog_CPP+:} false; then :
+ $as_echo_n "(cached) " >&6
else
# Double quotes because CPP needs to be expanded
for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp"
@@ -2383,11 +3012,7 @@ do
# <limits.h> exists even on freestanding compilers.
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp. "Syntax error" is here to catch this case.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __STDC__
# include <limits.h>
@@ -2396,78 +3021,34 @@ cat >>conftest.$ac_ext <<_ACEOF
#endif
Syntax error
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_cpp "$LINENO"; then :
+else
# Broken: fails on valid input.
continue
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
- # OK, works on sane cases. Now check whether non-existent headers
+ # OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ac_nonexistent.h>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+if ac_fn_c_try_cpp "$LINENO"; then :
# Broken: success on invalid input.
continue
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
# Passes both tests.
ac_preproc_ok=:
break
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
break
fi
@@ -2479,8 +3060,8 @@ fi
else
ac_cv_prog_CPP=$CPP
fi
-echo "$as_me:$LINENO: result: $CPP" >&5
-echo "${ECHO_T}$CPP" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5
+$as_echo "$CPP" >&6; }
ac_preproc_ok=false
for ac_c_preproc_warn_flag in '' yes
do
@@ -2490,11 +3071,7 @@ do
# <limits.h> exists even on freestanding compilers.
# On the NeXT, cc -E runs the code through the compiler's parser,
# not just through cpp. "Syntax error" is here to catch this case.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef __STDC__
# include <limits.h>
@@ -2503,85 +3080,40 @@ cat >>conftest.$ac_ext <<_ACEOF
#endif
Syntax error
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
- :
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_cpp "$LINENO"; then :
+else
# Broken: fails on valid input.
continue
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
- # OK, works on sane cases. Now check whether non-existent headers
+ # OK, works on sane cases. Now check whether nonexistent headers
# can be detected and how.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ac_nonexistent.h>
_ACEOF
-if { (eval echo "$as_me:$LINENO: \"$ac_cpp conftest.$ac_ext\"") >&5
- (eval $ac_cpp conftest.$ac_ext) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } >/dev/null; then
- if test -s conftest.err; then
- ac_cpp_err=$ac_c_preproc_warn_flag
- ac_cpp_err=$ac_cpp_err$ac_c_werror_flag
- else
- ac_cpp_err=
- fi
-else
- ac_cpp_err=yes
-fi
-if test -z "$ac_cpp_err"; then
+if ac_fn_c_try_cpp "$LINENO"; then :
# Broken: success on invalid input.
continue
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
# Passes both tests.
ac_preproc_ok=:
break
fi
-rm -f conftest.err conftest.$ac_ext
+rm -f conftest.err conftest.i conftest.$ac_ext
done
# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped.
-rm -f conftest.err conftest.$ac_ext
-if $ac_preproc_ok; then
- :
+rm -f conftest.i conftest.err conftest.$ac_ext
+if $ac_preproc_ok; then :
+
else
- { { echo "$as_me:$LINENO: error: C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." >&5
-echo "$as_me: error: C preprocessor \"$CPP\" fails sanity check
-See \`config.log' for more details." >&2;}
- { (exit 1); exit 1; }; }
+ { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5
+$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}
+as_fn_error $? "C preprocessor \"$CPP\" fails sanity check
+See \`config.log' for more details" "$LINENO" 5; }
fi
ac_ext=c
@@ -2591,31 +3123,142 @@ ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $
ac_compiler_gnu=$ac_cv_c_compiler_gnu
-echo "$as_me:$LINENO: checking for egrep" >&5
-echo $ECHO_N "checking for egrep... $ECHO_C" >&6
-if test "${ac_cv_prog_egrep+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5
+$as_echo_n "checking for grep that handles long lines and -e... " >&6; }
+if ${ac_cv_path_GREP+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if echo a | (grep -E '(a|b)') >/dev/null 2>&1
- then ac_cv_prog_egrep='grep -E'
- else ac_cv_prog_egrep='egrep'
+ if test -z "$GREP"; then
+ ac_path_GREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in grep ggrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
+ as_fn_executable_p "$ac_path_GREP" || continue
+# Check for GNU ac_path_GREP and select it if it is found.
+ # Check for GNU $ac_path_GREP
+case `"$ac_path_GREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'GREP' >> "conftest.nl"
+ "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_GREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_GREP="$ac_path_GREP"
+ ac_path_GREP_max=$ac_count
fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_GREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_GREP"; then
+ as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_GREP=$GREP
+fi
+
fi
-echo "$as_me:$LINENO: result: $ac_cv_prog_egrep" >&5
-echo "${ECHO_T}$ac_cv_prog_egrep" >&6
- EGREP=$ac_cv_prog_egrep
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5
+$as_echo "$ac_cv_path_GREP" >&6; }
+ GREP="$ac_cv_path_GREP"
-echo "$as_me:$LINENO: checking for ANSI C header files" >&5
-echo $ECHO_N "checking for ANSI C header files... $ECHO_C" >&6
-if test "${ac_cv_header_stdc+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5
+$as_echo_n "checking for egrep... " >&6; }
+if ${ac_cv_path_EGREP+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ if echo a | $GREP -E '(a|b)' >/dev/null 2>&1
+ then ac_cv_path_EGREP="$GREP -E"
+ else
+ if test -z "$EGREP"; then
+ ac_path_EGREP_found=false
+ # Loop through the user's path and test for each of PROGNAME-LIST
+ as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_prog in egrep; do
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
+ as_fn_executable_p "$ac_path_EGREP" || continue
+# Check for GNU ac_path_EGREP and select it if it is found.
+ # Check for GNU $ac_path_EGREP
+case `"$ac_path_EGREP" --version 2>&1` in
+*GNU*)
+ ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;;
+*)
+ ac_count=0
+ $as_echo_n 0123456789 >"conftest.in"
+ while :
+ do
+ cat "conftest.in" "conftest.in" >"conftest.tmp"
+ mv "conftest.tmp" "conftest.in"
+ cp "conftest.in" "conftest.nl"
+ $as_echo 'EGREP' >> "conftest.nl"
+ "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break
+ diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break
+ as_fn_arith $ac_count + 1 && ac_count=$as_val
+ if test $ac_count -gt ${ac_path_EGREP_max-0}; then
+ # Best one so far, save it but keep looking for a better one
+ ac_cv_path_EGREP="$ac_path_EGREP"
+ ac_path_EGREP_max=$ac_count
+ fi
+ # 10*(2^10) chars as input seems more than enough
+ test $ac_count -gt 10 && break
+ done
+ rm -f conftest.in conftest.tmp conftest.nl conftest.out;;
+esac
+
+ $ac_path_EGREP_found && break 3
+ done
+ done
+ done
+IFS=$as_save_IFS
+ if test -z "$ac_cv_path_EGREP"; then
+ as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5
+ fi
+else
+ ac_cv_path_EGREP=$EGREP
+fi
+
+ fi
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5
+$as_echo "$ac_cv_path_EGREP" >&6; }
+ EGREP="$ac_cv_path_EGREP"
+
+
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5
+$as_echo_n "checking for ANSI C header files... " >&6; }
+if ${ac_cv_header_stdc+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
#include <stdarg.h>
@@ -2630,51 +3273,23 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_header_stdc=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_header_stdc=no
+ ac_cv_header_stdc=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test $ac_cv_header_stdc = yes; then
# SunOS 4.x string.h does not declare mem*, contrary to ANSI.
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <string.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "memchr" >/dev/null 2>&1; then
- :
+ $EGREP "memchr" >/dev/null 2>&1; then :
+
else
ac_cv_header_stdc=no
fi
@@ -2684,18 +3299,14 @@ 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 <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdlib.h>
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "free" >/dev/null 2>&1; then
- :
+ $EGREP "free" >/dev/null 2>&1; then :
+
else
ac_cv_header_stdc=no
fi
@@ -2705,16 +3316,13 @@ fi
if test $ac_cv_header_stdc = yes; then
# /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
:
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <ctype.h>
+#include <stdlib.h>
#if ((' ' & 0x0FF) == 0x020)
# define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
@@ -2734,41 +3342,26 @@ main ()
for (i = 0; i < 256; i++)
if (XOR (islower (i), ISLOWER (i))
|| toupper (i) != TOUPPER (i))
- exit(2);
- exit (0);
+ return 2;
+ return 0;
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- :
-else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+if ac_fn_c_try_run "$LINENO"; then :
-( exit $ac_status )
-ac_cv_header_stdc=no
+else
+ ac_cv_header_stdc=no
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
fi
-echo "$as_me:$LINENO: result: $ac_cv_header_stdc" >&5
-echo "${ECHO_T}$ac_cv_header_stdc" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5
+$as_echo "$ac_cv_header_stdc" >&6; }
if test $ac_cv_header_stdc = yes; then
-cat >>confdefs.h <<\_ACEOF
-#define STDC_HEADERS 1
-_ACEOF
+$as_echo "#define STDC_HEADERS 1" >>confdefs.h
fi
@@ -2776,10 +3369,10 @@ fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}ar", so it can be a program name with args.
set dummy ${ac_tool_prefix}ar; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_AR+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_AR+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$AR"; then
ac_cv_prog_AR="$AR" # Let the user override the test.
@@ -2789,35 +3382,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AR="${ac_tool_prefix}ar"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
AR=$ac_cv_prog_AR
if test -n "$AR"; then
- echo "$as_me:$LINENO: result: $AR" >&5
-echo "${ECHO_T}$AR" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AR" >&5
+$as_echo "$AR" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_AR"; then
ac_ct_AR=$AR
# Extract the first word of "ar", so it can be a program name with args.
set dummy ar; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_AR+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_AR+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_AR"; then
ac_cv_prog_ac_ct_AR="$ac_ct_AR" # Let the user override the test.
@@ -2827,27 +3422,38 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_AR="ar"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_AR=$ac_cv_prog_ac_ct_AR
if test -n "$ac_ct_AR"; then
- echo "$as_me:$LINENO: result: $ac_ct_AR" >&5
-echo "${ECHO_T}$ac_ct_AR" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_AR" >&5
+$as_echo "$ac_ct_AR" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- AR=$ac_ct_AR
+ if test "x$ac_ct_AR" = x; then
+ AR=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ AR=$ac_ct_AR
+ fi
else
AR="$ac_cv_prog_AR"
fi
@@ -2855,10 +3461,10 @@ fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args.
set dummy ${ac_tool_prefix}ranlib; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_RANLIB+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RANLIB+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$RANLIB"; then
ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
@@ -2868,35 +3474,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
RANLIB=$ac_cv_prog_RANLIB
if test -n "$RANLIB"; then
- echo "$as_me:$LINENO: result: $RANLIB" >&5
-echo "${ECHO_T}$RANLIB" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5
+$as_echo "$RANLIB" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_RANLIB"; then
ac_ct_RANLIB=$RANLIB
# Extract the first word of "ranlib", so it can be a program name with args.
set dummy ranlib; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RANLIB+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_RANLIB"; then
ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test.
@@ -2906,27 +3514,38 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_RANLIB="ranlib"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB
if test -n "$ac_ct_RANLIB"; then
- echo "$as_me:$LINENO: result: $ac_ct_RANLIB" >&5
-echo "${ECHO_T}$ac_ct_RANLIB" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5
+$as_echo "$ac_ct_RANLIB" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- RANLIB=$ac_ct_RANLIB
+ if test "x$ac_ct_RANLIB" = x; then
+ RANLIB=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ RANLIB=$ac_ct_RANLIB
+ fi
else
RANLIB="$ac_cv_prog_RANLIB"
fi
@@ -2934,10 +3553,10 @@ fi
if test -n "$ac_tool_prefix"; then
# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
set dummy ${ac_tool_prefix}windres; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_RC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_RC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$RC"; then
ac_cv_prog_RC="$RC" # Let the user override the test.
@@ -2947,35 +3566,37 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_RC="${ac_tool_prefix}windres"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
RC=$ac_cv_prog_RC
if test -n "$RC"; then
- echo "$as_me:$LINENO: result: $RC" >&5
-echo "${ECHO_T}$RC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RC" >&5
+$as_echo "$RC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
+
fi
if test -z "$ac_cv_prog_RC"; then
ac_ct_RC=$RC
# Extract the first word of "windres", so it can be a program name with args.
set dummy windres; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_ac_ct_RC+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_ac_ct_RC+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$ac_ct_RC"; then
ac_cv_prog_ac_ct_RC="$ac_ct_RC" # Let the user override the test.
@@ -2985,27 +3606,38 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_RC="windres"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
fi
fi
ac_ct_RC=$ac_cv_prog_ac_ct_RC
if test -n "$ac_ct_RC"; then
- echo "$as_me:$LINENO: result: $ac_ct_RC" >&5
-echo "${ECHO_T}$ac_ct_RC" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RC" >&5
+$as_echo "$ac_ct_RC" >&6; }
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
fi
- RC=$ac_ct_RC
+ if test "x$ac_ct_RC" = x; then
+ RC=""
+ else
+ case $cross_compiling:$ac_tool_warned in
+yes:)
+{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5
+$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}
+ac_tool_warned=yes ;;
+esac
+ RC=$ac_ct_RC
+ fi
else
RC="$ac_cv_prog_RC"
fi
@@ -3015,32 +3647,34 @@ fi
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------
-echo "$as_me:$LINENO: checking whether ${MAKE-make} sets \$(MAKE)" >&5
-echo $ECHO_N "checking whether ${MAKE-make} sets \$(MAKE)... $ECHO_C" >&6
-set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y,:./+-,___p_,'`
-if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5
+$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; }
+set x ${MAKE-make}
+ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'`
+if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then :
+ $as_echo_n "(cached) " >&6
else
cat >conftest.make <<\_ACEOF
+SHELL = /bin/sh
all:
- @echo 'ac_maketemp="$(MAKE)"'
+ @echo '@@@%%%=$(MAKE)=@@@%%%'
_ACEOF
-# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
-eval `${MAKE-make} -f conftest.make 2>/dev/null | grep temp=`
-if test -n "$ac_maketemp"; then
- eval ac_cv_prog_make_${ac_make}_set=yes
-else
- eval ac_cv_prog_make_${ac_make}_set=no
-fi
+# GNU make sometimes prints "make[1]: Entering ...", which would confuse us.
+case `${MAKE-make} -f conftest.make 2>/dev/null` in
+ *@@@%%%=?*=@@@%%%*)
+ eval ac_cv_prog_make_${ac_make}_set=yes;;
+ *)
+ eval ac_cv_prog_make_${ac_make}_set=no;;
+esac
rm -f conftest.make
fi
-if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
SET_MAKE=
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
SET_MAKE="MAKE=${MAKE-make}"
fi
@@ -3052,54 +3686,17 @@ fi
-#--------------------------------------------------------------------
-# Check whether --enable-threads or --disable-threads was given.
-#--------------------------------------------------------------------
-
-
- echo "$as_me:$LINENO: checking for building with threads" >&5
-echo $ECHO_N "checking for building with threads... $ECHO_C" >&6
- # Check whether --enable-threads or --disable-threads was given.
-if test "${enable_threads+set}" = set; then
- enableval="$enable_threads"
- tcl_ok=$enableval
-else
- tcl_ok=yes
-fi;
-
- if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes (default)" >&5
-echo "${ECHO_T}yes (default)" >&6
- TCL_THREADS=1
- cat >>confdefs.h <<\_ACEOF
-#define TCL_THREADS 1
-_ACEOF
-
- # USE_THREAD_ALLOC tells us to try the special thread-based
- # allocator that significantly reduces lock contention
- cat >>confdefs.h <<\_ACEOF
-#define USE_THREAD_ALLOC 1
-_ACEOF
-
- else
- TCL_THREADS=0
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
- fi
-
-
-
#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------
-# Check whether --with-encoding or --without-encoding was given.
-if test "${with_encoding+set}" = set; then
- withval="$with_encoding"
- with_tcencoding=${withval}
-fi;
+# Check whether --with-encoding was given.
+if test "${with_encoding+set}" = set; then :
+ withval=$with_encoding; with_tcencoding=${withval}
+fi
+
if test x"${with_tcencoding}" != x ; then
cat >>confdefs.h <<_ACEOF
@@ -3108,9 +3705,7 @@ _ACEOF
else
# Default encoding on windows is not "iso8859-1"
- cat >>confdefs.h <<\_ACEOF
-#define TCL_CFGVAL_ENCODING "cp1252"
-_ACEOF
+ $as_echo "#define TCL_CFGVAL_ENCODING \"cp1252\"" >>confdefs.h
fi
@@ -3121,15 +3716,15 @@ _ACEOF
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking how to build libraries" >&5
-echo $ECHO_N "checking how to build libraries... $ECHO_C" >&6
- # Check whether --enable-shared or --disable-shared was given.
-if test "${enable_shared+set}" = set; then
- enableval="$enable_shared"
- tcl_ok=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking how to build libraries" >&5
+$as_echo_n "checking how to build libraries... " >&6; }
+ # Check whether --enable-shared was given.
+if test "${enable_shared+set}" = set; then :
+ enableval=$enable_shared; tcl_ok=$enableval
else
tcl_ok=yes
-fi;
+fi
+
if test "${enable_shared+set}" = set; then
enableval="$enable_shared"
@@ -3139,21 +3734,20 @@ fi;
fi
if test "$tcl_ok" = "yes" ; then
- echo "$as_me:$LINENO: result: shared" >&5
-echo "${ECHO_T}shared" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: shared" >&5
+$as_echo "shared" >&6; }
SHARED_BUILD=1
else
- echo "$as_me:$LINENO: result: static" >&5
-echo "${ECHO_T}static" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: static" >&5
+$as_echo "static" >&6; }
SHARED_BUILD=0
-cat >>confdefs.h <<\_ACEOF
-#define STATIC_BUILD 1
-_ACEOF
+$as_echo "#define STATIC_BUILD 1" >>confdefs.h
fi
+
#--------------------------------------------------------------------
# The statements below define a collection of compile flags. This
# macro depends on the value of SHARED_BUILD, and should be called
@@ -3161,70 +3755,15 @@ _ACEOF
#--------------------------------------------------------------------
# On IRIX 5.3, sys/types and inttypes.h are conflicting.
-
-
-
-
-
-
-
-
-
for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \
inttypes.h stdint.h unistd.h
-do
-as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
-echo "$as_me:$LINENO: checking for $ac_header" >&5
-echo $ECHO_N "checking for $ac_header... $ECHO_C" >&6
-if eval "test \"\${$as_ac_Header+set}\" = set"; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-
-#include <$ac_header>
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- eval "$as_ac_Header=yes"
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-eval "$as_ac_Header=no"
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: `eval echo '${'$as_ac_Header'}'`" >&5
-echo "${ECHO_T}`eval echo '${'$as_ac_Header'}'`" >&6
-if test `eval echo '${'$as_ac_Header'}'` = yes; then
+do :
+ as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh`
+ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default
+"
+if eval test \"x\$"$as_ac_Header"\" = x"yes"; then :
cat >>confdefs.h <<_ACEOF
-#define `echo "HAVE_$ac_header" | $as_tr_cpp` 1
+#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1
_ACEOF
fi
@@ -3236,59 +3775,30 @@ done
# Step 0: Enable 64 bit support?
- echo "$as_me:$LINENO: checking if 64bit support is requested" >&5
-echo $ECHO_N "checking if 64bit support is requested... $ECHO_C" >&6
- # Check whether --enable-64bit or --disable-64bit was given.
-if test "${enable_64bit+set}" = set; then
- enableval="$enable_64bit"
- do64bit=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking if 64bit support is requested" >&5
+$as_echo_n "checking if 64bit support is requested... " >&6; }
+ # Check whether --enable-64bit was given.
+if test "${enable_64bit+set}" = set; then :
+ enableval=$enable_64bit; do64bit=$enableval
else
do64bit=no
-fi;
- echo "$as_me:$LINENO: result: $do64bit" >&5
-echo "${ECHO_T}$do64bit" >&6
-
- # Cross-compiling options for Windows/CE builds
-
- echo "$as_me:$LINENO: checking if Windows/CE build is requested" >&5
-echo $ECHO_N "checking if Windows/CE build is requested... $ECHO_C" >&6
- # Check whether --enable-wince or --disable-wince was given.
-if test "${enable_wince+set}" = set; then
- enableval="$enable_wince"
- doWince=$enableval
-else
- doWince=no
-fi;
- echo "$as_me:$LINENO: result: $doWince" >&5
-echo "${ECHO_T}$doWince" >&6
-
- echo "$as_me:$LINENO: checking for Windows/CE celib directory" >&5
-echo $ECHO_N "checking for Windows/CE celib directory... $ECHO_C" >&6
+fi
-# Check whether --with-celib or --without-celib was given.
-if test "${with_celib+set}" = set; then
- withval="$with_celib"
- CELIB_DIR=$withval
-else
- CELIB_DIR=NO_CELIB
-fi;
- echo "$as_me:$LINENO: result: $CELIB_DIR" >&5
-echo "${ECHO_T}$CELIB_DIR" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $do64bit" >&5
+$as_echo "$do64bit" >&6; }
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
-cat >>confdefs.h <<\_ACEOF
-#define MODULE_SCOPE extern
-_ACEOF
+$as_echo "#define MODULE_SCOPE extern" >>confdefs.h
# Extract the first word of "cygpath", so it can be a program name with args.
set dummy cygpath; ac_word=$2
-echo "$as_me:$LINENO: checking for $ac_word" >&5
-echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
-if test "${ac_cv_prog_CYGPATH+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_CYGPATH+:} false; then :
+ $as_echo_n "(cached) " >&6
else
if test -n "$CYGPATH"; then
ac_cv_prog_CYGPATH="$CYGPATH" # Let the user override the test.
@@ -3298,26 +3808,65 @@ for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
- for ac_exec_ext in '' $ac_executable_extensions; do
- if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CYGPATH="cygpath -m"
- echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
-done
+ done
+IFS=$as_save_IFS
test -z "$ac_cv_prog_CYGPATH" && ac_cv_prog_CYGPATH="echo"
fi
fi
CYGPATH=$ac_cv_prog_CYGPATH
if test -n "$CYGPATH"; then
- echo "$as_me:$LINENO: result: $CYGPATH" >&5
-echo "${ECHO_T}$CYGPATH" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CYGPATH" >&5
+$as_echo "$CYGPATH" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
+ # Extract the first word of "wine", so it can be a program name with args.
+set dummy wine; ac_word=$2
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if ${ac_cv_prog_WINE+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ if test -n "$WINE"; then
+ ac_cv_prog_WINE="$WINE" # Let the user override the test.
else
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ for ac_exec_ext in '' $ac_executable_extensions; do
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
+ ac_cv_prog_WINE="wine"
+ $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
+ break 2
+ fi
+done
+ done
+IFS=$as_save_IFS
+
+fi
fi
+WINE=$ac_cv_prog_WINE
+if test -n "$WINE"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $WINE" >&5
+$as_echo "$WINE" >&6; }
+else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
SHLIB_SUFFIX=".dll"
@@ -3328,16 +3877,12 @@ fi
if test "$GCC" = "yes"; then
- echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5
-echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6
-if test "${ac_cv_cross+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cross-compile version of gcc" >&5
+$as_echo_n "checking for cross-compile version of gcc... " >&6; }
+if ${ac_cv_cross+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifndef _WIN32
@@ -3352,40 +3897,16 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_cross=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_cross=yes
+ ac_cv_cross=yes
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_cross" >&5
-echo "${ECHO_T}$ac_cv_cross" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cross" >&5
+$as_echo "$ac_cv_cross" >&6; }
if test "$ac_cv_cross" = "yes"; then
case "$do64bit" in
@@ -3420,20 +3941,20 @@ echo "${ECHO_T}$ac_cv_cross" >&6
echo "101 \"name\"" >> $conftest
echo "END" >> $conftest
- echo "$as_me:$LINENO: checking for Windows native path bug in windres" >&5
-echo $ECHO_N "checking for Windows native path bug in windres... $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Windows native path bug in windres" >&5
+$as_echo_n "checking for Windows native path bug in windres... " >&6; }
cyg_conftest=`$CYGPATH $conftest`
if { ac_try='$RC -o conftest.res.o $cyg_conftest'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
+ { { eval echo "\"\$as_me\":${as_lineno-$LINENO}: \"$ac_try\""; } >&5
(eval $ac_try) 2>&5
ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } ; then
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; }; } ; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
else
- echo "$as_me:$LINENO: result: yes" >&5
-echo "${ECHO_T}yes" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
CYGPATH=echo
fi
conftest=
@@ -3451,16 +3972,12 @@ echo "${ECHO_T}yes" >&6
if test "${GCC}" = "yes" ; then
extra_cflags="-pipe"
extra_ldflags="-pipe -static-libgcc"
- echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5
-echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6
-if test "${ac_cv_win32+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mingw32 version of gcc" >&5
+$as_echo_n "checking for mingw32 version of gcc... " >&6; }
+if ${ac_cv_win32+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifdef _WIN32
@@ -3475,57 +3992,73 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
ac_cv_win32=no
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_win32=yes
+ ac_cv_win32=yes
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_win32" >&5
-echo "${ECHO_T}$ac_cv_win32" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_win32" >&5
+$as_echo "$ac_cv_win32" >&6; }
if test "$ac_cv_win32" != "yes"; then
- { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5
-echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error $? "${CC} cannot produce win32 executables." "$LINENO" 5
fi
hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
- echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
-echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
-if test "${ac_cv_municode+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working -municode linker flag" >&5
+$as_echo_n "checking for working -municode linker flag... " >&6; }
+if ${ac_cv_municode+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+
+# ac_fn_c_try_link LINENO
+# -----------------------
+# Try to link conftest.$ac_ext, and return whether this succeeded.
+ac_fn_c_try_link ()
+{
+ as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ rm -f conftest.$ac_objext conftest$ac_exeext
+ if { { ac_try="$ac_link"
+case "(($ac_try" in
+ *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
+ *) ac_try_echo=$ac_try;;
+esac
+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""
+$as_echo "$ac_try_echo"; } >&5
+ (eval "$ac_link") 2>conftest.err
+ ac_status=$?
+ if test -s conftest.err; then
+ grep -v '^ *+' conftest.err >conftest.er1
+ cat conftest.er1 >&5
+ mv -f conftest.er1 conftest.err
+ fi
+ $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5
+ test $ac_status = 0; } && {
+ test -z "$ac_c_werror_flag" ||
+ test ! -s conftest.err
+ } && test -s conftest$ac_exeext && {
+ test "$cross_compiling" = yes ||
+ test -x conftest$ac_exeext
+ }; then :
+ ac_retval=0
+else
+ $as_echo "$as_me: failed program was:" >&5
+sed 's/^/| /' conftest.$ac_ext >&5
+
+ ac_retval=1
+fi
+ # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information
+ # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would
+ # interfere with the next link command; also delete a directory that is
+ # left behind by Apple's compiler. We do this before executing the actions.
+ rm -rf conftest.dSYM conftest_ipa8_conftest.oo
+ eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
+ as_fn_set_status $ac_retval
+
+} # ac_fn_c_try_link
+cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <windows.h>
@@ -3539,41 +4072,17 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
ac_cv_municode=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_municode=no
+ ac_cv_municode=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
-echo "${ECHO_T}$ac_cv_municode" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_municode" >&5
+$as_echo "$ac_cv_municode" >&6; }
CFLAGS=$hold_cflags
if test "$ac_cv_municode" = "yes" ; then
extra_ldflags="$extra_ldflags -municode"
@@ -3582,8 +4091,8 @@ echo "${ECHO_T}$ac_cv_municode" >&6
fi
fi
- echo "$as_me:$LINENO: checking compiler flags" >&5
-echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking compiler flags" >&5
+$as_echo_n "checking compiler flags... " >&6; }
if test "${GCC}" = "yes" ; then
SHLIB_LD=""
SHLIB_LD_LIBS='${LIBS}'
@@ -3604,23 +4113,20 @@ echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
if test "${SHARED_BUILD}" = "0" ; then
# static
- echo "$as_me:$LINENO: result: using static flags" >&5
-echo "${ECHO_T}using static flags" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
+$as_echo "using static flags" >&6; }
runtime=
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
else
# dynamic
- echo "$as_me:$LINENO: result: using shared flags" >&5
-echo "${ECHO_T}using shared flags" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
+$as_echo "using shared flags" >&6; }
# ad-hoc check to see if CC supports -shared.
if "${CC}" -shared 2>&1 | egrep ': -shared not supported' >/dev/null; then
- { { echo "$as_me:$LINENO: error: ${CC} does not support the -shared option.
- You will need to upgrade to a newer version of the toolchain." >&5
-echo "$as_me: error: ${CC} does not support the -shared option.
- You will need to upgrade to a newer version of the toolchain." >&2;}
- { (exit 1); exit 1; }; }
+ as_fn_error $? "${CC} does not support the -shared option.
+ You will need to upgrade to a newer version of the toolchain." "$LINENO" 5
fi
runtime=
@@ -3646,7 +4152,7 @@ echo "$as_me: error: ${CC} does not support the -shared option.
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
+ CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -3674,20 +4180,16 @@ echo "$as_me: error: ${CC} does not support the -shared option.
case "$do64bit" in
amd64|x64|yes)
MACHINE="AMD64" ; # assume AMD64 as default 64-bit build
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
+$as_echo " Using 64-bit $MACHINE mode" >&6; }
;;
ia64)
MACHINE="IA64"
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
+$as_echo " Using 64-bit $MACHINE mode" >&6; }
;;
*)
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#ifndef _WIN64
@@ -3702,57 +4204,33 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_win_64bit=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_win_64bit=no
+ tcl_win_64bit=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
if test "$tcl_win_64bit" = "yes" ; then
do64bit=amd64
MACHINE="AMD64"
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
+$as_echo " Using 64-bit $MACHINE mode" >&6; }
fi
;;
esac
else
if test "${SHARED_BUILD}" = "0" ; then
# static
- echo "$as_me:$LINENO: result: using static flags" >&5
-echo "${ECHO_T}using static flags" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using static flags" >&5
+$as_echo "using static flags" >&6; }
runtime=-MT
LIBRARIES="\${STATIC_LIBRARIES}"
EXESUFFIX="s\${DBGX}.exe"
else
# dynamic
- echo "$as_me:$LINENO: result: using shared flags" >&5
-echo "${ECHO_T}using shared flags" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: using shared flags" >&5
+$as_echo "using shared flags" >&6; }
runtime=-MD
# Add SHLIB_LD_LIBS to the Make rule, not here.
LIBRARIES="\${SHARED_LIBRARIES}"
@@ -3792,11 +4270,11 @@ echo "${ECHO_T}using shared flags" >&6
;;
esac
if test ! -d "${PATH64}" ; then
- { echo "$as_me:$LINENO: WARNING: Could not find 64-bit $MACHINE SDK" >&5
-echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;}
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Could not find 64-bit $MACHINE SDK" >&5
+$as_echo "$as_me: WARNING: Could not find 64-bit $MACHINE SDK" >&2;}
fi
- echo "$as_me:$LINENO: result: Using 64-bit $MACHINE mode" >&5
-echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Using 64-bit $MACHINE mode" >&5
+$as_echo " Using 64-bit $MACHINE mode" >&6; }
fi
LIBS="netapi32.lib kernel32.lib user32.lib advapi32.lib userenv.lib ws2_32.lib"
@@ -3815,64 +4293,9 @@ echo "${ECHO_T} Using 64-bit $MACHINE mode" >&6
# TEA_PATH_NOSPACE to avoid this issue.
# Check if _WIN64 is already recognized, and if so we don't
# need to modify CC.
- echo "$as_me:$LINENO: checking whether _WIN64 is declared" >&5
-echo $ECHO_N "checking whether _WIN64 is declared... $ECHO_C" >&6
-if test "${ac_cv_have_decl__WIN64+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-#ifndef _WIN64
- char *p = (char *) _WIN64;
-#endif
+ ac_fn_c_check_decl "$LINENO" "_WIN64" "ac_cv_have_decl__WIN64" "$ac_includes_default"
+if test "x$ac_cv_have_decl__WIN64" = xyes; then :
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_have_decl__WIN64=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_have_decl__WIN64=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_have_decl__WIN64" >&5
-echo "${ECHO_T}$ac_cv_have_decl__WIN64" >&6
-if test $ac_cv_have_decl__WIN64 = yes; then
- :
else
CC="\"${PATH64}/cl.exe\" -I\"${MSSDK}/Include\" \
-I\"${MSSDK}/Include/crt\" \
@@ -3899,111 +4322,7 @@ fi
LINKBIN="link"
fi
- if test "$doWince" != "no" ; then
- # Set defaults for common evc4/PPC2003 setup
- # Currently Tcl requires 300+, possibly 420+ for sockets
- CEVERSION=420; # could be 211 300 301 400 420 ...
- TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ...
- ARCH=ARM; # could be ARM MIPS X86EM ...
- PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
- if test "$doWince" != "yes"; then
- # If !yes then the user specified something
- # Reset ARCH to allow user to skip specifying it
- ARCH=
- eval `echo $doWince | awk -F "," '{ \
- if (length($1)) { printf "CEVERSION=\"%s\"\n", $1; \
- if ($1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
- if (length($2)) { printf "TARGETCPU=\"%s\"\n", toupper($2) }; \
- if (length($3)) { printf "ARCH=\"%s\"\n", toupper($3) }; \
- if (length($4)) { printf "PLATFORM=\"%s\"\n", $4 }; \
- }'`
- if test "x${ARCH}" = "x" ; then
- ARCH=$TARGETCPU;
- fi
- fi
- OSVERSION=WCE$CEVERSION;
- if test "x${WCEROOT}" = "x" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
- if test ! -d "${WCEROOT}" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
- fi
- fi
- if test "x${SDKROOT}" = "x" ; then
- SDKROOT="C:/Program Files/Windows CE Tools"
- if test ! -d "${SDKROOT}" ; then
- SDKROOT="C:/Windows CE Tools"
- fi
- fi
- # The space-based-path will work for the Makefile, but will
- # not work if AC_TRY_COMPILE is called.
- WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
- SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
- CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
- if test ! -d "${CELIB_DIR}/inc"; then
- { { echo "$as_me:$LINENO: error: Invalid celib directory \"${CELIB_DIR}\"" >&5
-echo "$as_me: error: Invalid celib directory \"${CELIB_DIR}\"" >&2;}
- { (exit 1); exit 1; }; }
- fi
- if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
- -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
- { { echo "$as_me:$LINENO: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&5
-echo "$as_me: error: could not find PocketPC SDK or target compiler to enable WinCE mode $CEVERSION,$TARGETCPU,$ARCH,$PLATFORM" >&2;}
- { (exit 1); exit 1; }; }
- else
- CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
- if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
- CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
- fi
- CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
- fi
- fi
-
- if test "$doWince" != "no" ; then
- CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
- if test "${TARGETCPU}" = "X86"; then
- CC="${CEBINROOT}/cl.exe"
- else
- CC="${CEBINROOT}/cl${ARCH}.exe"
- fi
- CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
- RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
- arch=`echo ${ARCH} | awk '{print tolower($0)}'`
- defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
- for i in $defs ; do
- cat >>confdefs.h <<_ACEOF
-#define $i 1
-_ACEOF
-
- done
-# if test "${ARCH}" = "X86EM"; then
-# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
-# fi
- cat >>confdefs.h <<_ACEOF
-#define _WIN32_WCE $CEVERSION
-_ACEOF
-
- cat >>confdefs.h <<_ACEOF
-#define UNDER_CE $CEVERSION
-_ACEOF
-
- CFLAGS_DEBUG="-nologo -Zi -Od"
- CFLAGS_OPTIMIZE="-nologo -O2"
- lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
- lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
- LINKBIN="\"${CEBINROOT}/link.exe\""
-
- if test "${CEVERSION}" -lt 400 ; then
- LIBS="coredll.lib corelibc.lib winsock.lib"
- else
- LIBS="coredll.lib corelibc.lib ws2.lib"
- fi
- # celib currently stuck at wce300 status
- #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
- LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
- LIBS_GUI="commctrl.lib commdlg.lib"
- else
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
- fi
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
SHLIB_LD_LIBS='${LIBS}'
@@ -4034,7 +4353,7 @@ _ACEOF
# Specify linker flags depending on the type of app being
# built -- Console vs. Window.
- if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
+ if test "${TARGETCPU}" != "X86"; then
LDFLAGS_CONSOLE="-link ${lflags}"
LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
else
@@ -4044,26 +4363,20 @@ _ACEOF
fi
if test "$do64bit" != "no" ; then
- cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_DO64BIT 1
-_ACEOF
+ $as_echo "#define TCL_CFG_DO64BIT 1" >>confdefs.h
fi
if test "${GCC}" = "yes" ; then
- echo "$as_me:$LINENO: checking for SEH support in compiler" >&5
-echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6
-if test "${tcl_cv_seh+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SEH support in compiler" >&5
+$as_echo_n "checking for SEH support in compiler... " >&6; }
+if ${tcl_cv_seh+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- if test "$cross_compiling" = yes; then
+ if test "$cross_compiling" = yes; then :
tcl_cv_seh=no
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define WIN32_LEAN_AND_MEAN
@@ -4082,37 +4395,22 @@ cat >>conftest.$ac_ext <<_ACEOF
}
_ACEOF
-rm -f conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_run "$LINENO"; then :
tcl_cv_seh=yes
else
- echo "$as_me: program exited with status $ac_status" >&5
-echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-( exit $ac_status )
-tcl_cv_seh=no
+ tcl_cv_seh=no
fi
-rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
+rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \
+ conftest.$ac_objext conftest.beam conftest.$ac_ext
fi
+
fi
-echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5
-echo "${ECHO_T}$tcl_cv_seh" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_seh" >&5
+$as_echo "$tcl_cv_seh" >&6; }
if test "$tcl_cv_seh" = "no" ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_SEH 1
-_ACEOF
+$as_echo "#define HAVE_NO_SEH 1" >>confdefs.h
fi
@@ -4122,16 +4420,12 @@ _ACEOF
# with Cygwin's version as of 2002-04-10, define it to be int,
# sufficient for getting the current code to work.
#
- echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5
-echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6
-if test "${tcl_cv_eh_disposition+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EXCEPTION_DISPOSITION support in include files" >&5
+$as_echo_n "checking for EXCEPTION_DISPOSITION support in include files... " >&6; }
+if ${tcl_cv_eh_disposition+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
# define WIN32_LEAN_AND_MEAN
@@ -4148,45 +4442,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_eh_disposition=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_eh_disposition=no
+ tcl_cv_eh_disposition=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5
-echo "${ECHO_T}$tcl_cv_eh_disposition" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_eh_disposition" >&5
+$as_echo "$tcl_cv_eh_disposition" >&6; }
if test "$tcl_cv_eh_disposition" = "no" ; then
-cat >>confdefs.h <<\_ACEOF
-#define EXCEPTION_DISPOSITION int
-_ACEOF
+$as_echo "#define EXCEPTION_DISPOSITION int" >>confdefs.h
fi
@@ -4194,16 +4462,12 @@ _ACEOF
# even if VOID has already been #defined. The win32api
# used by mingw and cygwin is known to do this.
- echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5
-echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6
-if test "${tcl_cv_winnt_ignore_void+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for winnt.h that ignores VOID define" >&5
+$as_echo_n "checking for winnt.h that ignores VOID define... " >&6; }
+if ${tcl_cv_winnt_ignore_void+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define VOID void
@@ -4223,45 +4487,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_winnt_ignore_void=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_winnt_ignore_void=no
+ tcl_cv_winnt_ignore_void=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5
-echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_winnt_ignore_void" >&5
+$as_echo "$tcl_cv_winnt_ignore_void" >&6; }
if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_WINNT_IGNORE_VOID 1
-_ACEOF
+$as_echo "#define HAVE_WINNT_IGNORE_VOID 1" >>confdefs.h
fi
@@ -4269,16 +4507,12 @@ _ACEOF
# This is used to stop gcc from printing a compiler
# warning when initializing a union member.
- echo "$as_me:$LINENO: checking for cast to union support" >&5
-echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
-if test "${tcl_cv_cast_to_union+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cast to union support" >&5
+$as_echo_n "checking for cast to union support... " >&6; }
+if ${tcl_cv_cast_to_union+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
int
@@ -4292,45 +4526,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_cast_to_union=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_cast_to_union=no
+ tcl_cv_cast_to_union=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
-echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_cast_to_union" >&5
+$as_echo "$tcl_cv_cast_to_union" >&6; }
if test "$tcl_cv_cast_to_union" = "yes"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_CAST_TO_UNION 1
-_ACEOF
+$as_echo "#define HAVE_CAST_TO_UNION 1" >>confdefs.h
fi
fi
@@ -4357,7 +4565,7 @@ esac
# as we just assume that the platform hasn't got a usable z.lib
#------------------------------------------------------------------------
-if test "${enable_shared+set}" = "set"; then
+if test "${enable_shared+set}" = "set"; then :
enableval="$enable_shared"
tcl_ok=$enableval
@@ -4367,14 +4575,13 @@ else
tcl_ok=yes
fi
-
-if test "$tcl_ok" = "yes"; then
+if test "$tcl_ok" = "yes"; then :
ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}
- if test "$do64bit" != "no"; then
+ if test "$do64bit" != "no"; then :
- if test "$GCC" == "yes"; then
+ if test "$GCC" == "yes"; then :
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win64/libz.dll.a
@@ -4386,7 +4593,6 @@ else
fi
-
else
ZLIB_LIBS=\${ZLIB_DIR_NATIVE}/win32/zdll.lib
@@ -4394,7 +4600,6 @@ else
fi
-
else
ZLIB_OBJS=\${ZLIB_OBJS}
@@ -4402,137 +4607,50 @@ else
fi
+$as_echo "#define HAVE_ZLIB 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_ZLIB 1
-_ACEOF
+ac_fn_c_check_type "$LINENO" "intptr_t" "ac_cv_type_intptr_t" "$ac_includes_default"
+if test "x$ac_cv_type_intptr_t" = xyes; then :
-echo "$as_me:$LINENO: checking for intptr_t" >&5
-echo $ECHO_N "checking for intptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_intptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((intptr_t *) 0)
- return 0;
-if (sizeof (intptr_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_intptr_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-ac_cv_type_intptr_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_intptr_t" >&5
-echo "${ECHO_T}$ac_cv_type_intptr_t" >&6
-if test $ac_cv_type_intptr_t = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_INTPTR_T 1
-_ACEOF
+$as_echo "#define HAVE_INTPTR_T 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for pointer-size signed integer type" >&5
-echo $ECHO_N "checking for pointer-size signed integer type... $ECHO_C" >&6
-if test "${tcl_cv_intptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size signed integer type" >&5
+$as_echo_n "checking for pointer-size signed integer type... " >&6; }
+if ${tcl_cv_intptr_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
for tcl_cv_intptr_t in "int" "long" "long long" none; do
if test "$tcl_cv_intptr_t" != none; then
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_intptr_t))];
-test_array [0] = 0
+test_array [0] = 0;
+return test_array [0];
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_ok=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_ok=no
+ tcl_ok=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
test "$tcl_ok" = yes && break; fi
done
fi
-echo "$as_me:$LINENO: result: $tcl_cv_intptr_t" >&5
-echo "${ECHO_T}$tcl_cv_intptr_t" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intptr_t" >&5
+$as_echo "$tcl_cv_intptr_t" >&6; }
if test "$tcl_cv_intptr_t" != none; then
cat >>confdefs.h <<_ACEOF
@@ -4543,132 +4661,48 @@ _ACEOF
fi
-echo "$as_me:$LINENO: checking for uintptr_t" >&5
-echo $ECHO_N "checking for uintptr_t... $ECHO_C" >&6
-if test "${ac_cv_type_uintptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
-else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
-/* end confdefs.h. */
-$ac_includes_default
-int
-main ()
-{
-if ((uintptr_t *) 0)
- return 0;
-if (sizeof (uintptr_t))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
- ac_cv_type_uintptr_t=yes
-else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
+ac_fn_c_check_type "$LINENO" "uintptr_t" "ac_cv_type_uintptr_t" "$ac_includes_default"
+if test "x$ac_cv_type_uintptr_t" = xyes; then :
-ac_cv_type_uintptr_t=no
-fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-echo "$as_me:$LINENO: result: $ac_cv_type_uintptr_t" >&5
-echo "${ECHO_T}$ac_cv_type_uintptr_t" >&6
-if test $ac_cv_type_uintptr_t = yes; then
-
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_UINTPTR_T 1
-_ACEOF
+$as_echo "#define HAVE_UINTPTR_T 1" >>confdefs.h
else
- echo "$as_me:$LINENO: checking for pointer-size unsigned integer type" >&5
-echo $ECHO_N "checking for pointer-size unsigned integer type... $ECHO_C" >&6
-if test "${tcl_cv_uintptr_t+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pointer-size unsigned integer type" >&5
+$as_echo_n "checking for pointer-size unsigned integer type... " >&6; }
+if ${tcl_cv_uintptr_t+:} false; then :
+ $as_echo_n "(cached) " >&6
else
for tcl_cv_uintptr_t in "unsigned int" "unsigned long" "unsigned long long" \
none; do
if test "$tcl_cv_uintptr_t" != none; then
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
$ac_includes_default
int
main ()
{
static int test_array [1 - 2 * !(sizeof (void *) <= sizeof ($tcl_cv_uintptr_t))];
-test_array [0] = 0
+test_array [0] = 0;
+return test_array [0];
;
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_ok=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_ok=no
+ tcl_ok=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
test "$tcl_ok" = yes && break; fi
done
fi
-echo "$as_me:$LINENO: result: $tcl_cv_uintptr_t" >&5
-echo "${ECHO_T}$tcl_cv_uintptr_t" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_uintptr_t" >&5
+$as_echo "$tcl_cv_uintptr_t" >&6; }
if test "$tcl_cv_uintptr_t" != none; then
cat >>confdefs.h <<_ACEOF
@@ -4680,6 +4714,208 @@ _ACEOF
fi
+
+#--------------------------------------------------------------------
+# Zipfs support - Tip 430
+#--------------------------------------------------------------------
+# Check whether --enable-zipfs was given.
+if test "${enable_zipfs+set}" = set; then :
+ enableval=$enable_zipfs; tcl_ok=$enableval
+else
+ tcl_ok=yes
+fi
+
+if test "$tcl_ok" = "yes" ; then
+ #
+ # Find a native compiler
+ #
+ # Put a plausible default for CC_FOR_BUILD in Makefile.
+if test -z "$CC_FOR_BUILD"; then
+ if test "x$cross_compiling" = "xno"; then
+ CC_FOR_BUILD='$(CC)'
+ else
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
+$as_echo_n "checking for gcc... " >&6; }
+ if ${ac_cv_path_cc+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/gcc 2> /dev/null` \
+ `ls -r $dir/gcc 2> /dev/null` ; do
+ if test x"$ac_cv_path_cc" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_cc=$j
+ break
+ fi
+ fi
+ done
+ done
+
+fi
+
+ fi
+fi
+
+# Also set EXEEXT_FOR_BUILD.
+if test "x$cross_compiling" = "xno"; then
+ EXEEXT_FOR_BUILD='$(EXEEXT)'
+ OBJEXT_FOR_BUILD='$(OBJEXT)'
+else
+ OBJEXT_FOR_BUILD='.no'
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
+$as_echo_n "checking for build system executable suffix... " >&6; }
+if ${bfd_cv_build_exeext+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+ rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.c
+ bfd_cv_build_exeext=
+ ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ rm -f conftest*
+ test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
+$as_echo "$bfd_cv_build_exeext" >&6; }
+ EXEEXT_FOR_BUILD=""
+ test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+fi
+
+ #
+ # Find a native zip implementation
+ #
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
+$as_echo_n "checking for tclsh... " >&6; }
+
+ if ${ac_cv_path_tclsh+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ search_path=`echo ${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
+
+fi
+
+
+ if test -f "$ac_cv_path_tclsh" ; then
+ TCLSH_PROG="$ac_cv_path_tclsh"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
+$as_echo "$TCLSH_PROG" >&6; }
+ else
+ # It is not an error if an installed version of Tcl can't be located.
+ TCLSH_PROG=""
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
+$as_echo "No tclsh found on PATH" >&6; }
+ fi
+
+
+
+ ZIP_PROG=""
+ ZIP_PROG_OPTIONS=""
+ ZIP_PROG_VFSSEARCH=""
+ ZIP_INSTALL_OBJS=""
+
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
+$as_echo_n "checking for zip... " >&6; }
+ if ${ac_cv_path_zip+:} false; then :
+ $as_echo_n "(cached) " >&6
+else
+
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/zip 2> /dev/null` \
+ `ls -r $dir/zip 2> /dev/null` ; do
+ if test x"$ac_cv_path_zip" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_zip=$j
+ break
+ fi
+ fi
+ done
+ done
+
+fi
+
+ if test -f "$ac_cv_path_zip" ; then
+ ZIP_PROG="$ac_cv_path_zip"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
+$as_echo "$ZIP_PROG" >&6; }
+ ZIP_PROG_OPTIONS="-rq"
+ ZIP_PROG_VFSSEARCH="*"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
+$as_echo "Found INFO Zip in environment" >&6; }
+ # Use standard arguments for zip
+ else
+ # It is not an error if an installed version of Zip can't be located.
+ # We can use the locally distributed minizip instead
+ ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
+ ZIP_PROG_OPTIONS="-o -r"
+ ZIP_PROG_VFSSEARCH="*"
+ ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
+$as_echo "No zip found on PATH building minizip" >&6; }
+ fi
+
+
+
+
+
+ ZIPFS_BUILD=1
+ TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+ ZIPFS_BUILD=0
+ TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
+$as_echo_n "checking for building with zipfs... " >&6; }
+if test "${ZIPFS_BUILD}" = 1; then
+ if test "${SHARED_BUILD}" = 0; then
+ ZIPFS_BUILD=2;
+
+$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h
+
+ INSTALL_LIBRARIES=install-libraries-zipfs-static
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ else
+
+$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
+\
+ INSTALL_LIBRARIES=install-libraries-zipfs-shared
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+ fi
+else
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+
+
+
+
+
+
#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------
@@ -4688,16 +4924,12 @@ fi
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.
-echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
-echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
-if test "${tcl_cv_findex_enums+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
+$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
+if ${tcl_cv_findex_enums+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define WIN32_LEAN_AND_MEAN
@@ -4715,60 +4947,30 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_findex_enums=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_findex_enums=no
+ tcl_cv_findex_enums=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
-echo "${ECHO_T}$tcl_cv_findex_enums" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
+$as_echo "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_FINDEX_ENUMS 1
-_ACEOF
+$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h
fi
# See if the compiler supports intrinsics.
-echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5
-echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6
-if test "${tcl_cv_intrinsics+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for intrinsics support in compiler" >&5
+$as_echo_n "checking for intrinsics support in compiler... " >&6; }
+if ${tcl_cv_intrinsics+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define WIN32_LEAN_AND_MEAN
@@ -4786,61 +4988,31 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext conftest$ac_exeext
-if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
- (eval $ac_link) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest$ac_exeext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_link "$LINENO"; then :
tcl_cv_intrinsics=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_intrinsics=no
+ tcl_cv_intrinsics=no
fi
-rm -f conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext \
+ conftest$ac_exeext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5
-echo "${ECHO_T}$tcl_cv_intrinsics" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_intrinsics" >&5
+$as_echo "$tcl_cv_intrinsics" >&6; }
if test "$tcl_cv_intrinsics" = "yes"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_INTRIN_H 1
-_ACEOF
+$as_echo "#define HAVE_INTRIN_H 1" >>confdefs.h
fi
# See if the <wspiapi.h> header file is present
-echo "$as_me:$LINENO: checking for wspiapi.h" >&5
-echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
-if test "${tcl_cv_wspiapi_h+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for wspiapi.h" >&5
+$as_echo_n "checking for wspiapi.h... " >&6; }
+if ${tcl_cv_wspiapi_h+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <wspiapi.h>
@@ -4853,45 +5025,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_wspiapi_h=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_wspiapi_h=no
+ tcl_cv_wspiapi_h=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5
-echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_wspiapi_h" >&5
+$as_echo "$tcl_cv_wspiapi_h" >&6; }
if test "$tcl_cv_wspiapi_h" = "yes"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_WSPIAPI_H 1
-_ACEOF
+$as_echo "#define HAVE_WSPIAPI_H 1" >>confdefs.h
fi
@@ -4899,16 +5045,12 @@ fi
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.
-echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
-echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
-if test "${tcl_cv_findex_enums+set}" = set; then
- echo $ECHO_N "(cached) $ECHO_C" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
+$as_echo_n "checking for FINDEX_INFO_LEVELS in winbase.h... " >&6; }
+if ${tcl_cv_findex_enums+:} false; then :
+ $as_echo_n "(cached) " >&6
else
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#define WIN32_LEAN_AND_MEAN
@@ -4926,45 +5068,19 @@ main ()
return 0;
}
_ACEOF
-rm -f conftest.$ac_objext
-if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
- (eval $ac_compile) 2>conftest.er1
- ac_status=$?
- grep -v '^ *+' conftest.er1 >conftest.err
- rm -f conftest.er1
- cat conftest.err >&5
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); } &&
- { ac_try='test -z "$ac_c_werror_flag"
- || test ! -s conftest.err'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; } &&
- { ac_try='test -s conftest.$ac_objext'
- { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
- (eval $ac_try) 2>&5
- ac_status=$?
- echo "$as_me:$LINENO: \$? = $ac_status" >&5
- (exit $ac_status); }; }; then
+if ac_fn_c_try_compile "$LINENO"; then :
tcl_cv_findex_enums=yes
else
- echo "$as_me: failed program was:" >&5
-sed 's/^/| /' conftest.$ac_ext >&5
-
-tcl_cv_findex_enums=no
+ tcl_cv_findex_enums=no
fi
-rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
+rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
fi
-echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
-echo "${ECHO_T}$tcl_cv_findex_enums" >&6
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $tcl_cv_findex_enums" >&5
+$as_echo "$tcl_cv_findex_enums" >&6; }
if test "$tcl_cv_findex_enums" = "no"; then
-cat >>confdefs.h <<\_ACEOF
-#define HAVE_NO_FINDEX_ENUMS 1
-_ACEOF
+$as_echo "#define HAVE_NO_FINDEX_ENUMS 1" >>confdefs.h
fi
@@ -4975,39 +5091,35 @@ fi
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking for build with symbols" >&5
-echo $ECHO_N "checking for build with symbols... $ECHO_C" >&6
- # Check whether --enable-symbols or --disable-symbols was given.
-if test "${enable_symbols+set}" = set; then
- enableval="$enable_symbols"
- tcl_ok=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build with symbols" >&5
+$as_echo_n "checking for build with symbols... " >&6; }
+ # Check whether --enable-symbols was given.
+if test "${enable_symbols+set}" = set; then :
+ enableval=$enable_symbols; tcl_ok=$enableval
else
tcl_ok=no
-fi;
+fi
+
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
if test "$tcl_ok" = "no"; then
CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
DBGX=""
-cat >>confdefs.h <<\_ACEOF
-#define NDEBUG 1
-_ACEOF
+$as_echo "#define NDEBUG 1" >>confdefs.h
- echo "$as_me:$LINENO: result: no" >&5
-echo "${ECHO_T}no" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
- cat >>confdefs.h <<\_ACEOF
-#define TCL_CFG_OPTIMIZED 1
-_ACEOF
+ $as_echo "#define TCL_CFG_OPTIMIZED 1" >>confdefs.h
else
CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
DBGX=g
if test "$tcl_ok" = "yes"; then
- echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
-echo "${ECHO_T}yes (standard debugging)" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (standard debugging)" >&5
+$as_echo "yes (standard debugging)" >&6; }
fi
fi
@@ -5015,32 +5127,26 @@ echo "${ECHO_T}yes (standard debugging)" >&6
if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_MEM_DEBUG 1
-_ACEOF
+$as_echo "#define TCL_MEM_DEBUG 1" >>confdefs.h
fi
if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
-cat >>confdefs.h <<\_ACEOF
-#define TCL_COMPILE_DEBUG 1
-_ACEOF
+$as_echo "#define TCL_COMPILE_DEBUG 1" >>confdefs.h
-cat >>confdefs.h <<\_ACEOF
-#define TCL_COMPILE_STATS 1
-_ACEOF
+$as_echo "#define TCL_COMPILE_STATS 1" >>confdefs.h
fi
if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
if test "$tcl_ok" = "all"; then
- echo "$as_me:$LINENO: result: enabled symbols mem compile debugging" >&5
-echo "${ECHO_T}enabled symbols mem compile debugging" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled symbols mem compile debugging" >&5
+$as_echo "enabled symbols mem compile debugging" >&6; }
else
- echo "$as_me:$LINENO: result: enabled $tcl_ok debugging" >&5
-echo "${ECHO_T}enabled $tcl_ok debugging" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: enabled $tcl_ok debugging" >&5
+$as_echo "enabled $tcl_ok debugging" >&6; }
fi
fi
@@ -5052,15 +5158,15 @@ TCL_DBGX=${DBGX}
#--------------------------------------------------------------------
- echo "$as_me:$LINENO: checking whether to embed manifest" >&5
-echo $ECHO_N "checking whether to embed manifest... $ECHO_C" >&6
- # Check whether --enable-embedded-manifest or --disable-embedded-manifest was given.
-if test "${enable_embedded_manifest+set}" = set; then
- enableval="$enable_embedded_manifest"
- embed_ok=$enableval
+ { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether to embed manifest" >&5
+$as_echo_n "checking whether to embed manifest... " >&6; }
+ # Check whether --enable-embedded-manifest was given.
+if test "${enable_embedded_manifest+set}" = set; then :
+ enableval=$enable_embedded_manifest; embed_ok=$enableval
else
embed_ok=yes
-fi;
+fi
+
VC_MANIFEST_EMBED_DLL=
VC_MANIFEST_EMBED_EXE=
@@ -5068,11 +5174,7 @@ fi;
if test "$embed_ok" = "yes" -a "${SHARED_BUILD}" = "1" \
-a "$GCC" != "yes" ; then
# Add the magic to embed the manifest into the dll/exe
- cat >conftest.$ac_ext <<_ACEOF
-/* confdefs.h. */
-_ACEOF
-cat confdefs.h >>conftest.$ac_ext
-cat >>conftest.$ac_ext <<_ACEOF
+ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#if defined(_MSC_VER) && _MSC_VER >= 1400
@@ -5081,7 +5183,7 @@ print("manifest needed")
_ACEOF
if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
- $EGREP "manifest needed" >/dev/null 2>&1; then
+ $EGREP "manifest needed" >/dev/null 2>&1; then :
# Could do a CHECK_PROG for mt, but should always be with MSVC8+
# Could add 'if test -f' check, but manifest should be created
@@ -5100,8 +5202,8 @@ fi
rm -f conftest*
fi
- echo "$as_me:$LINENO: result: $result" >&5
-echo "${ECHO_T}$result" >&6
+ { $as_echo "$as_me:${as_lineno-$LINENO}: result: $result" >&5
+$as_echo "$result" >&6; }
@@ -5288,7 +5390,8 @@ TCL_WIN_VERSION="$TCL_VERSION.$TCL_RELEASE_LEVEL.`echo $TCL_PATCH_LEVEL | tr -d
- ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest"
+ac_config_files="$ac_config_files Makefile tclConfig.sh tcl.hpj tclsh.exe.manifest"
+
cat >confcache <<\_ACEOF
# This file is a shell script that caches the results of configure
# tests run on this system so they can be shared between configure
@@ -5307,39 +5410,70 @@ _ACEOF
# The following way of writing the cache mishandles newlines in values,
# but we know of no workaround that is simple, portable, and efficient.
-# So, don't put newlines in cache variables' values.
+# So, we kill variables containing newlines.
# Ultrix sh set writes to stderr and can't be redirected directly,
# and sets the high bit in the cache file unless we assign to the vars.
-{
+(
+ for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do
+ eval ac_val=\$$ac_var
+ case $ac_val in #(
+ *${as_nl}*)
+ case $ac_var in #(
+ *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5
+$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;
+ esac
+ case $ac_var in #(
+ _ | IFS | as_nl) ;; #(
+ BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(
+ *) { eval $ac_var=; unset $ac_var;} ;;
+ esac ;;
+ esac
+ done
+
(set) 2>&1 |
- case `(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 \).
+ case $as_nl`(ac_space=' '; set) 2>&1` in #(
+ *${as_nl}ac_space=\ *)
+ # `set' does not quote correctly, so add quotes: double-quote
+ # substitution turns \\\\ into \\, and sed turns \\ into \.
sed -n \
"s/'/'\\\\''/g;
s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"
- ;;
+ ;; #(
*)
# `set' quotes correctly as required by POSIX, so do not add quotes.
- sed -n \
- "s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1=\\2/p"
+ sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"
;;
- esac;
-} |
+ esac |
+ sort
+) |
sed '
+ /^ac_cv_env_/b end
t clear
- : clear
+ :clear
s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/
t end
- /^ac_cv_env/!s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
- : end' >>confcache
-if diff $cache_file confcache >/dev/null 2>&1; then :; else
- if test -w $cache_file; then
- test "x$cache_file" != "x/dev/null" && echo "updating cache $cache_file"
- cat confcache >$cache_file
+ s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/
+ :end' >>confcache
+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else
+ if test -w "$cache_file"; then
+ if test "x$cache_file" != "x/dev/null"; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5
+$as_echo "$as_me: updating cache $cache_file" >&6;}
+ if test ! -f "$cache_file" || test -h "$cache_file"; then
+ cat confcache >"$cache_file"
+ else
+ case $cache_file in #(
+ */* | ?:*)
+ mv -f confcache "$cache_file"$$ &&
+ mv -f "$cache_file"$$ "$cache_file" ;; #(
+ *)
+ mv -f confcache "$cache_file" ;;
+ esac
+ fi
+ fi
else
- echo "not updating unwritable cache $cache_file"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5
+$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}
fi
fi
rm -f confcache
@@ -5348,63 +5482,55 @@ test "x$prefix" = xNONE && prefix=$ac_default_prefix
# Let make expand exec_prefix.
test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-# VPATH may cause trouble with some makes, so we remove $(srcdir),
-# ${srcdir} and @srcdir@ from VPATH if srcdir is ".", strip leading and
-# trailing colons and then remove the whole line if VPATH becomes empty
-# (actually we leave an empty line to preserve line numbers).
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=/{
-s/:*\$(srcdir):*/:/;
-s/:*\${srcdir}:*/:/;
-s/:*@srcdir@:*/:/;
-s/^\([^=]*=[ ]*\):*/\1/;
-s/:*$//;
-s/^[^=]*=[ ]*$//;
-}'
-fi
-
# Transform confdefs.h into DEFS.
# Protect against shell expansion while executing Makefile rules.
# Protect against Makefile macro expansion.
#
# If the first sed substitution is executed (which looks for macros that
-# take arguments), then we branch to the quote section. Otherwise,
+# take arguments), then branch to the quote section. Otherwise,
# look for a macro that doesn't take arguments.
-cat >confdef2opt.sed <<\_ACEOF
+ac_script='
+:mline
+/\\$/{
+ N
+ s,\\\n,,
+ b mline
+}
t clear
-: clear
-s,^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\),-D\1=\2,g
+:clear
+s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g
t quote
-s,^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\),-D\1=\2,g
+s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g
t quote
-d
-: quote
-s,[ `~#$^&*(){}\\|;'"<>?],\\&,g
-s,\[,\\&,g
-s,\],\\&,g
-s,\$,$$,g
-p
-_ACEOF
-# We use echo to avoid assuming a particular line-breaking character.
-# The extra dot is to prevent the shell from consuming trailing
-# line-breaks from the sub-command output. A line-break within
-# single-quotes doesn't work because, if this script is created in a
-# platform that uses two characters for line-breaks (e.g., DOS), tr
-# would break.
-ac_LF_and_DOT=`echo; echo .`
-DEFS=`sed -n -f confdef2opt.sed confdefs.h | tr "$ac_LF_and_DOT" ' .'`
-rm -f confdef2opt.sed
+b any
+:quote
+s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g
+s/\[/\\&/g
+s/\]/\\&/g
+s/\$/$$/g
+H
+:any
+${
+ g
+ s/^\n//
+ s/\n/ /g
+ p
+}
+'
+DEFS=`sed -n "$ac_script" confdefs.h`
ac_libobjs=
ac_ltlibobjs=
+U=
for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue
# 1. Remove the extension, and $U if already installed.
- ac_i=`echo "$ac_i" |
- sed 's/\$U\././;s/\.o$//;s/\.obj$//'`
- # 2. Add them.
- ac_libobjs="$ac_libobjs $ac_i\$U.$ac_objext"
- ac_ltlibobjs="$ac_ltlibobjs $ac_i"'$U.lo'
+ ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'
+ ac_i=`$as_echo "$ac_i" | sed "$ac_script"`
+ # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR
+ # will be set to the directory where LIBOBJS objects are built.
+ as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"
+ as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'
done
LIBOBJS=$ac_libobjs
@@ -5412,12 +5538,14 @@ LTLIBOBJS=$ac_ltlibobjs
-: ${CONFIG_STATUS=./config.status}
+: "${CONFIG_STATUS=./config.status}"
+ac_write_fail=0
ac_clean_files_save=$ac_clean_files
ac_clean_files="$ac_clean_files $CONFIG_STATUS"
-{ echo "$as_me:$LINENO: creating $CONFIG_STATUS" >&5
-echo "$as_me: creating $CONFIG_STATUS" >&6;}
-cat >$CONFIG_STATUS <<_ACEOF
+{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5
+$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}
+as_write_fail=0
+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1
#! $SHELL
# Generated by $as_me.
# Run this file to recreate the current configuration.
@@ -5427,81 +5555,253 @@ cat >$CONFIG_STATUS <<_ACEOF
debug=false
ac_cs_recheck=false
ac_cs_silent=false
-SHELL=\${CONFIG_SHELL-$SHELL}
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-## --------------------- ##
-## M4sh Initialization. ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+SHELL=\${CONFIG_SHELL-$SHELL}
+export SHELL
+_ASEOF
+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
NULLCMD=:
- # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
# is contrary to our usage. Disable this feature.
alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
- set -o posix
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o) 2>/dev/null` in #(
+ *posix*) :
+ set -o posix ;; #(
+ *) :
+ ;;
+esac
fi
-DUALCASE=1; export DUALCASE # for MKS sh
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
- as_unset=unset
-else
- as_unset=false
+
+as_nl='
+'
+export as_nl
+# Printing a long string crashes Solaris 7 /usr/bin/printf.
+as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo
+as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo
+# Prefer a ksh shell builtin over an external printf program on Solaris,
+# but without wasting forks for bash or zsh.
+if test -z "$BASH_VERSION$ZSH_VERSION" \
+ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='print -r --'
+ as_echo_n='print -rn --'
+elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then
+ as_echo='printf %s\n'
+ as_echo_n='printf %s'
+else
+ if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then
+ as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'
+ as_echo_n='/usr/ucb/echo -n'
+ else
+ as_echo_body='eval expr "X$1" : "X\\(.*\\)"'
+ as_echo_n_body='eval
+ arg=$1;
+ case $arg in #(
+ *"$as_nl"*)
+ expr "X$arg" : "X\\(.*\\)$as_nl";
+ arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;
+ esac;
+ expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"
+ '
+ export as_echo_n_body
+ as_echo_n='sh -c $as_echo_n_body as_echo'
+ fi
+ export as_echo_body
+ as_echo='sh -c $as_echo_body as_echo'
+fi
+
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+ PATH_SEPARATOR=:
+ (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {
+ (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||
+ PATH_SEPARATOR=';'
+ }
fi
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
+# IFS
+# We need space, tab and new line, in precisely that order. Quoting is
+# there to prevent editors from complaining about space-tab.
+# (If _AS_PATH_WALK were called with IFS unset, it would disable word
+# splitting by setting IFS to empty value.)
+IFS=" "" $as_nl"
+
+# Find who we are. Look in the path if we contain no directory separator.
+as_myself=
+case $0 in #((
+ *[\\/]* ) as_myself=$0 ;;
+ *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+ IFS=$as_save_IFS
+ test -z "$as_dir" && as_dir=.
+ test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
+ done
+IFS=$as_save_IFS
+
+ ;;
+esac
+# We did not find ourselves, most probably we were run as `sh COMMAND'
+# in which case we are not to be found in the path.
+if test "x$as_myself" = x; then
+ as_myself=$0
+fi
+if test ! -f "$as_myself"; then
+ $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2
+ exit 1
+fi
+
+# Unset variables that we do not need and which cause bugs (e.g. in
+# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"
+# suppresses any "Segmentation fault" message there. '((' could
+# trigger a bug in pdksh 5.2.14.
+for as_var in BASH_ENV ENV MAIL MAILPATH
+do eval test x\${$as_var+set} = xset \
+ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :
+done
PS1='$ '
PS2='> '
PS4='+ '
# NLS nuisances.
-for as_var in \
- LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
- LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
- LC_TELEPHONE LC_TIME
-do
- if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
- eval $as_var=C; export $as_var
- else
- $as_unset $as_var
+LC_ALL=C
+export LC_ALL
+LANGUAGE=C
+export LANGUAGE
+
+# CDPATH.
+(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+
+
+# as_fn_error STATUS ERROR [LINENO LOG_FD]
+# ----------------------------------------
+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are
+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the
+# script with STATUS, using 1 if that was 0.
+as_fn_error ()
+{
+ as_status=$1; test $as_status -eq 0 && as_status=1
+ if test "$4"; then
+ as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
+ $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4
fi
-done
+ $as_echo "$as_me: error: $2" >&2
+ as_fn_exit $as_status
+} # as_fn_error
+
+
+# as_fn_set_status STATUS
+# -----------------------
+# Set $? to STATUS, without forking.
+as_fn_set_status ()
+{
+ return $1
+} # as_fn_set_status
+
+# as_fn_exit STATUS
+# -----------------
+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.
+as_fn_exit ()
+{
+ set +e
+ as_fn_set_status $1
+ exit $1
+} # as_fn_exit
+
+# as_fn_unset VAR
+# ---------------
+# Portably unset VAR.
+as_fn_unset ()
+{
+ { eval $1=; unset $1;}
+}
+as_unset=as_fn_unset
+# as_fn_append VAR VALUE
+# ----------------------
+# Append the text in VALUE to the end of the definition contained in VAR. Take
+# advantage of any shell optimizations that allow amortized linear growth over
+# repeated appends, instead of the typical quadratic growth present in naive
+# implementations.
+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :
+ eval 'as_fn_append ()
+ {
+ eval $1+=\$2
+ }'
+else
+ as_fn_append ()
+ {
+ eval $1=\$$1\$2
+ }
+fi # as_fn_append
+
+# as_fn_arith ARG...
+# ------------------
+# Perform arithmetic evaluation on the ARGs, and store the result in the
+# global $as_val. Take advantage of shells that can avoid forks. The arguments
+# must be portable across $(()) and expr.
+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :
+ eval 'as_fn_arith ()
+ {
+ as_val=$(( $* ))
+ }'
+else
+ as_fn_arith ()
+ {
+ as_val=`expr "$@" || test $? -eq 1`
+ }
+fi # as_fn_arith
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
+
+if expr a : '\(a\)' >/dev/null 2>&1 &&
+ test "X`expr 00001 : '.*\(...\)'`" = X001; then
as_expr=expr
else
as_expr=false
fi
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
+if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then
as_basename=basename
else
as_basename=false
fi
+if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then
+ as_dirname=dirname
+else
+ as_dirname=false
+fi
-# Name of the executable.
-as_me=`$as_basename "$0" ||
+as_me=`$as_basename -- "$0" ||
$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
X"$0" : 'X\(//\)$' \| \
- X"$0" : 'X\(/\)$' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
- sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
- /^X\/\(\/\/\)$/{ s//\1/; q; }
- /^X\/\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
+ X"$0" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X/"$0" |
+ sed '/^.*\/\([^/][^/]*\)\/*$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\/\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
-
-# PATH needs CR, and LINENO needs CR and PATH.
# Avoid depending upon Character Ranges.
as_cr_letters='abcdefghijklmnopqrstuvwxyz'
as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
@@ -5509,148 +5809,111 @@ as_cr_Letters=$as_cr_letters$as_cr_LETTERS
as_cr_digits='0123456789'
as_cr_alnum=$as_cr_Letters$as_cr_digits
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
- echo "#! /bin/sh" >conf$$.sh
- echo "exit 0" >>conf$$.sh
- chmod +x conf$$.sh
- if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
- PATH_SEPARATOR=';'
- else
- PATH_SEPARATOR=:
- fi
- rm -f conf$$.sh
-fi
-
-
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" || {
- # Find who we are. Look in the path if we contain no path at all
- # relative or not.
- case $0 in
- *[\\/]* ) as_myself=$0 ;;
- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
- ;;
- esac
- # We did not find ourselves, most probably we were run as `sh COMMAND'
- # in which case we are not to be found in the path.
- if test "x$as_myself" = x; then
- as_myself=$0
- fi
- if test ! -f "$as_myself"; then
- { { echo "$as_me:$LINENO: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
- { (exit 1); exit 1; }; }
- fi
- case $CONFIG_SHELL in
- '')
- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
- IFS=$as_save_IFS
- test -z "$as_dir" && as_dir=.
- for as_base in sh bash ksh sh5; do
- case $as_dir in
- /*)
- if ("$as_dir/$as_base" -c '
- as_lineno_1=$LINENO
- as_lineno_2=$LINENO
- as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
- test "x$as_lineno_1" != "x$as_lineno_2" &&
- test "x$as_lineno_3" = "x$as_lineno_2" ') 2>/dev/null; then
- $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
- $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
- CONFIG_SHELL=$as_dir/$as_base
- export CONFIG_SHELL
- exec "$CONFIG_SHELL" "$0" ${1+"$@"}
- fi;;
- esac
- done
-done
-;;
- esac
-
- # Create $as_me.lineno as a copy of $as_myself, but with $LINENO
- # uniformly replaced by the line number. The first 'sed' inserts a
- # line-number line before each line; the second 'sed' does the real
- # work. The second script uses 'N' to pair each line-number line
- # with the numbered line, and appends trailing '-' during
- # substitution so that $LINENO is not a special case at line end.
- # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
- # second 'sed' script. Blame Lee E. McMahon for sed's syntax. :-)
- sed '=' <$as_myself |
- sed '
- N
- s,$,-,
- : loop
- s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
- t loop
- s,-$,,
- s,^['$as_cr_digits']*\n,,
- ' >$as_me.lineno &&
- chmod +x $as_me.lineno ||
- { { echo "$as_me:$LINENO: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
- { (exit 1); exit 1; }; }
-
- # Don't try to exec as it changes $[0], causing all sort of problems
- # (the dirname of $[0] is not the place where we might find the
- # original and so on. Autoconf is especially sensible to this).
- . ./$as_me.lineno
- # Exit status is that of the last command.
- exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
- *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T=' ' ;;
- *c*,* ) ECHO_N=-n ECHO_C= ECHO_T= ;;
- *) ECHO_N= ECHO_C='\c' ECHO_T= ;;
+ECHO_C= ECHO_N= ECHO_T=
+case `echo -n x` in #(((((
+-n*)
+ case `echo 'xy\c'` in
+ *c*) ECHO_T=' ';; # ECHO_T is single tab character.
+ xy) ECHO_C='\c';;
+ *) echo `echo ksh88 bug on AIX 6.1` > /dev/null
+ ECHO_T=' ';;
+ esac;;
+*)
+ ECHO_N='-n';;
esac
-if expr a : '\(a\)' >/dev/null 2>&1; then
- as_expr=expr
+rm -f conf$$ conf$$.exe conf$$.file
+if test -d conf$$.dir; then
+ rm -f conf$$.dir/conf$$.file
else
- as_expr=false
+ rm -f conf$$.dir
+ mkdir conf$$.dir 2>/dev/null
fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
- # We could just check for DJGPP; but this test a) works b) is more generic
- # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
- if test -f conf$$.exe; then
- # Don't use ln at all; we don't have any links
- as_ln_s='cp -p'
- else
+if (echo >conf$$.file) 2>/dev/null; then
+ if ln -s conf$$.file conf$$ 2>/dev/null; then
as_ln_s='ln -s'
+ # ... but there are two gotchas:
+ # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
+ # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
+ # In both cases, we have to default to `cp -pR'.
+ ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
+ as_ln_s='cp -pR'
+ elif ln conf$$.file conf$$ 2>/dev/null; then
+ as_ln_s=ln
+ else
+ as_ln_s='cp -pR'
fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
- as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
-rm -f conf$$ conf$$.exe conf$$.file
+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
+rmdir conf$$.dir 2>/dev/null
+
+
+# as_fn_mkdir_p
+# -------------
+# Create "$as_dir" as a directory, including parents if necessary.
+as_fn_mkdir_p ()
+{
+ case $as_dir in #(
+ -*) as_dir=./$as_dir;;
+ esac
+ test -d "$as_dir" || eval $as_mkdir_p || {
+ as_dirs=
+ while :; do
+ case $as_dir in #(
+ *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(
+ *) as_qdir=$as_dir;;
+ esac
+ as_dirs="'$as_qdir' $as_dirs"
+ as_dir=`$as_dirname -- "$as_dir" ||
+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
+ X"$as_dir" : 'X\(//\)[^/]' \| \
+ X"$as_dir" : 'X\(//\)$' \| \
+ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$as_dir" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ test -d "$as_dir" && break
+ done
+ test -z "$as_dirs" || eval "mkdir $as_dirs"
+ } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"
+
+
+} # as_fn_mkdir_p
if mkdir -p . 2>/dev/null; then
- as_mkdir_p=:
+ as_mkdir_p='mkdir -p "$as_dir"'
else
test -d ./-p && rmdir ./-p
as_mkdir_p=false
fi
-as_executable_p="test -f"
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -5659,31 +5922,20 @@ as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" $as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
exec 6>&1
-
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
+## ----------------------------------- ##
+## Main body of $CONFIG_STATUS script. ##
+## ----------------------------------- ##
+_ASEOF
+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1
+
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# Save the log message, to keep $0 and so on meaningful, and to
# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling. Logging --version etc. is OK.
-exec 5>>config.log
-{
- echo
- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
+# values after options handling.
+ac_log="
This file was extended by $as_me, which was
-generated by GNU Autoconf 2.59. Invocation command line was
+generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -5691,124 +5943,116 @@ generated by GNU Autoconf 2.59. Invocation command line was
CONFIG_COMMANDS = $CONFIG_COMMANDS
$ $0 $@
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
+on `(hostname || uname -n) 2>/dev/null | sed 1q`
+"
+
_ACEOF
-# Files that config.status was made for.
-if test -n "$ac_config_files"; then
- echo "config_files=\"$ac_config_files\"" >>$CONFIG_STATUS
-fi
+case $ac_config_files in *"
+"*) set x $ac_config_files; shift; ac_config_files=$*;;
+esac
-if test -n "$ac_config_headers"; then
- echo "config_headers=\"$ac_config_headers\"" >>$CONFIG_STATUS
-fi
-if test -n "$ac_config_links"; then
- echo "config_links=\"$ac_config_links\"" >>$CONFIG_STATUS
-fi
-if test -n "$ac_config_commands"; then
- echo "config_commands=\"$ac_config_commands\"" >>$CONFIG_STATUS
-fi
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+# Files that config.status was made for.
+config_files="$ac_config_files"
-cat >>$CONFIG_STATUS <<\_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
+\`$as_me' instantiates files and other configuration actions
+from templates according to the current configuration. Unless the files
+and actions are specified as TAGs, all are instantiated by default.
-Usage: $0 [OPTIONS] [FILE]...
+Usage: $0 [OPTION]... [TAG]...
-h, --help print this help, then exit
- -V, --version print version number, then exit
- -q, --quiet do not print progress messages
+ -V, --version print version number and configuration settings, then exit
+ --config print configuration, then exit
+ -q, --quiet, --silent
+ do not print progress messages
-d, --debug don't remove temporary files
--recheck update $as_me by reconfiguring in the same conditions
- --file=FILE[:TEMPLATE]
- instantiate the configuration file FILE
+ --file=FILE[:TEMPLATE]
+ instantiate the configuration file FILE
Configuration files:
$config_files
-Report bugs to <bug-autoconf@gnu.org>."
-_ACEOF
+Report bugs to the package provider."
-cat >>$CONFIG_STATUS <<_ACEOF
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
-configured by $0, generated by GNU Autoconf 2.59,
- with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"
+configured by $0, generated by GNU Autoconf 2.69,
+ with options \\"\$ac_cs_config\\"
-Copyright (C) 2003 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
-srcdir=$srcdir
+
+ac_pwd='$ac_pwd'
+srcdir='$srcdir'
+test -n "\$AWK" || AWK=awk
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-# If no file are specified by the user, then we need to provide default
-# value. By we need to know if files were specified by the user.
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# The default lists apply if the user does not specify any file.
ac_need_defaults=:
while test $# != 0
do
case $1 in
- --*=*)
- ac_option=`expr "x$1" : 'x\([^=]*\)='`
- ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
+ --*=?*)
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`
ac_shift=:
;;
- -*)
+ --*=)
+ ac_option=`expr "X$1" : 'X\([^=]*\)='`
+ ac_optarg=
+ ac_shift=:
+ ;;
+ *)
ac_option=$1
ac_optarg=$2
ac_shift=shift
;;
- *) # This is not an option, so the user has probably given explicit
- # arguments.
- ac_option=$1
- ac_need_defaults=false;;
esac
case $ac_option in
# Handling of the options.
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
ac_cs_recheck=: ;;
- --version | --vers* | -V )
- echo "$ac_cs_version"; exit 0 ;;
- --he | --h)
- # Conflict between --help and --header
- { { echo "$as_me:$LINENO: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; };;
- --help | --hel | -h )
- echo "$ac_cs_usage"; exit 0 ;;
- --debug | --d* | -d )
+ --version | --versio | --versi | --vers | --ver | --ve | --v | -V )
+ $as_echo "$ac_cs_version"; exit ;;
+ --config | --confi | --conf | --con | --co | --c )
+ $as_echo "$ac_cs_config"; exit ;;
+ --debug | --debu | --deb | --de | --d | -d )
debug=: ;;
--file | --fil | --fi | --f )
$ac_shift
- CONFIG_FILES="$CONFIG_FILES $ac_optarg"
- ac_need_defaults=false;;
- --header | --heade | --head | --hea )
- $ac_shift
- CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
+ case $ac_optarg in
+ *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;
+ '') as_fn_error $? "missing file argument" ;;
+ esac
+ as_fn_append CONFIG_FILES " '$ac_optarg'"
ac_need_defaults=false;;
+ --he | --h | --help | --hel | -h )
+ $as_echo "$ac_cs_usage"; exit ;;
-q | -quiet | --quiet | --quie | --qui | --qu | --q \
| -silent | --silent | --silen | --sile | --sil | --si | --s)
ac_cs_silent=: ;;
# This is an error.
- -*) { { echo "$as_me:$LINENO: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
- { (exit 1); exit 1; }; } ;;
+ -*) as_fn_error $? "unrecognized option: \`$1'
+Try \`$0 --help' for more information." ;;
- *) ac_config_targets="$ac_config_targets $1" ;;
+ *) as_fn_append ac_config_targets " $1"
+ ac_need_defaults=false ;;
esac
shift
@@ -5822,33 +6066,47 @@ if $ac_cs_silent; then
fi
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- echo "running $SHELL $0 " $ac_configure_args \$ac_configure_extra_args " --no-create --no-recursion" >&6
- exec $SHELL $0 $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ shift
+ \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
+ CONFIG_SHELL='$SHELL'
+ export CONFIG_SHELL
+ exec "\$@"
fi
_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+exec 5>>config.log
+{
+ echo
+ sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
+## Running $as_me. ##
+_ASBOX
+ $as_echo "$ac_log"
+} >&5
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
-
-
-cat >>$CONFIG_STATUS <<\_ACEOF
+# Handling of arguments.
for ac_config_target in $ac_config_targets
do
- case "$ac_config_target" in
- # Handling of arguments.
- "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile" ;;
- "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;;
- "tcl.hpj" ) CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
- "tclsh.exe.manifest" ) CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;;
- *) { { echo "$as_me:$LINENO: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
- { (exit 1); exit 1; }; };;
+ case $ac_config_target in
+ "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;;
+ "tclConfig.sh") CONFIG_FILES="$CONFIG_FILES tclConfig.sh" ;;
+ "tcl.hpj") CONFIG_FILES="$CONFIG_FILES tcl.hpj" ;;
+ "tclsh.exe.manifest") CONFIG_FILES="$CONFIG_FILES tclsh.exe.manifest" ;;
+
+ *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;
esac
done
+
# If the user did not use the arguments to specify the items to instantiate,
# then the envvar interface is used. Set only those that are not.
# We use the long form for the default assignment because of an extremely
@@ -5858,421 +6116,414 @@ if $ac_need_defaults; then
fi
# Have a temporary directory for convenience. Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
+# simply because there is no reason against having it here, and in addition,
# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
+# Hook for its removal unless debugging.
+# Note that there is a small window in which the directory will not be cleaned:
+# after its creation but before its name has been assigned to `$tmp'.
$debug ||
{
- trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
- trap '{ (exit 1); exit 1; }' 1 2 13 15
+ tmp= ac_tmp=
+ trap 'exit_status=$?
+ : "${ac_tmp:=$tmp}"
+ { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status
+' 0
+ trap 'as_fn_exit 1' 1 2 13 15
}
-
# Create a (secure) tmp directory for tmp files.
{
- tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
- test -n "$tmp" && test -d "$tmp"
+ tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&
+ test -d "$tmp"
} ||
{
- tmp=./confstat$$-$RANDOM
- (umask 077 && mkdir $tmp)
-} ||
+ tmp=./conf$$-$RANDOM
+ (umask 077 && mkdir "$tmp")
+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5
+ac_tmp=$tmp
+
+# Set up the scripts for CONFIG_FILES section.
+# No need to generate them if there are no CONFIG_FILES.
+# This happens for instance with `./config.status config.h'.
+if test -n "$CONFIG_FILES"; then
+
+
+ac_cr=`echo X | tr X '\015'`
+# On cygwin, bash can eat \r inside `` if the user requested igncr.
+# But we know of no other shell where ac_cr would be empty at this
+# point, so we can use a bashism as a fallback.
+if test "x$ac_cr" = x; then
+ eval ac_cr=\$\'\\r\'
+fi
+ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`
+if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then
+ ac_cs_awk_cr='\\r'
+else
+ ac_cs_awk_cr=$ac_cr
+fi
+
+echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&
+_ACEOF
+
+
{
- echo "$me: cannot create a temporary directory in ." >&2
- { (exit 1); exit 1; }
+ echo "cat >conf$$subs.awk <<_ACEOF" &&
+ echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&
+ echo "_ACEOF"
+} >conf$$subs.sh ||
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`
+ac_delim='%!_!# '
+for ac_last_try in false false false false false :; do
+ . ./conf$$subs.sh ||
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+
+ ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`
+ if test $ac_delim_n = $ac_delim_num; then
+ break
+ elif $ac_last_try; then
+ as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5
+ else
+ ac_delim="$ac_delim!$ac_delim _$ac_delim!! "
+ fi
+done
+rm -f conf$$subs.sh
+
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&
+_ACEOF
+sed -n '
+h
+s/^/S["/; s/!.*/"]=/
+p
+g
+s/^[^!]*!//
+:repl
+t repl
+s/'"$ac_delim"'$//
+t delim
+:nl
+h
+s/\(.\{148\}\)..*/\1/
+t more1
+s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/
+p
+n
+b repl
+:more1
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t nl
+:delim
+h
+s/\(.\{148\}\)..*/\1/
+t more2
+s/["\\]/\\&/g; s/^/"/; s/$/"/
+p
+b
+:more2
+s/["\\]/\\&/g; s/^/"/; s/$/"\\/
+p
+g
+s/.\{148\}//
+t delim
+' <conf$$subs.awk | sed '
+/^[^""]/{
+ N
+ s/\n//
}
+' >>$CONFIG_STATUS || ac_write_fail=1
+rm -f conf$$subs.awk
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+_ACAWK
+cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&
+ for (key in S) S_is_set[key] = 1
+ FS = ""
+}
+{
+ line = $ 0
+ nfields = split(line, field, "@")
+ substed = 0
+ len = length(field[1])
+ for (i = 2; i < nfields; i++) {
+ key = field[i]
+ keylen = length(key)
+ if (S_is_set[key]) {
+ value = S[key]
+ line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)
+ len += length(value) + length(field[++i])
+ substed = 1
+ } else
+ len += 1 + keylen
+ }
+
+ print line
+}
+
+_ACAWK
+_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then
+ sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"
+else
+ cat
+fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \
+ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
+# VPATH may cause trouble with some makes, so we remove sole $(srcdir),
+# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and
+# trailing colons and then remove the whole line if VPATH becomes empty
+# (actually we leave an empty line to preserve line numbers).
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{
+h
+s///
+s/^/:/
+s/[ ]*$/:/
+s/:\$(srcdir):/:/g
+s/:\${srcdir}:/:/g
+s/:@srcdir@:/:/g
+s/^:*//
+s/:*$//
+x
+s/\(=[ ]*\).*/\1/
+G
+s/\n//
+s/^[^=]*=[ ]*$//
+}'
+fi
-#
-# CONFIG_FILES section.
-#
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+fi # test -n "$CONFIG_FILES"
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "\$CONFIG_FILES"; then
- # Protect against being on the right side of a sed subst in config.status.
- sed 's/,@/@@/; s/@,/@@/; s/,;t t\$/@;t t/; /@;t t\$/s/[\\\\&,]/\\\\&/g;
- s/@@/,@/; s/@@/@,/; s/@;t t\$/,;t t/' >\$tmp/subs.sed <<\\CEOF
-s,@SHELL@,$SHELL,;t t
-s,@PATH_SEPARATOR@,$PATH_SEPARATOR,;t t
-s,@PACKAGE_NAME@,$PACKAGE_NAME,;t t
-s,@PACKAGE_TARNAME@,$PACKAGE_TARNAME,;t t
-s,@PACKAGE_VERSION@,$PACKAGE_VERSION,;t t
-s,@PACKAGE_STRING@,$PACKAGE_STRING,;t t
-s,@PACKAGE_BUGREPORT@,$PACKAGE_BUGREPORT,;t t
-s,@exec_prefix@,$exec_prefix,;t t
-s,@prefix@,$prefix,;t t
-s,@program_transform_name@,$program_transform_name,;t t
-s,@bindir@,$bindir,;t t
-s,@sbindir@,$sbindir,;t t
-s,@libexecdir@,$libexecdir,;t t
-s,@datadir@,$datadir,;t t
-s,@sysconfdir@,$sysconfdir,;t t
-s,@sharedstatedir@,$sharedstatedir,;t t
-s,@localstatedir@,$localstatedir,;t t
-s,@libdir@,$libdir,;t t
-s,@includedir@,$includedir,;t t
-s,@oldincludedir@,$oldincludedir,;t t
-s,@infodir@,$infodir,;t t
-s,@mandir@,$mandir,;t t
-s,@build_alias@,$build_alias,;t t
-s,@host_alias@,$host_alias,;t t
-s,@target_alias@,$target_alias,;t t
-s,@DEFS@,$DEFS,;t t
-s,@ECHO_C@,$ECHO_C,;t t
-s,@ECHO_N@,$ECHO_N,;t t
-s,@ECHO_T@,$ECHO_T,;t t
-s,@LIBS@,$LIBS,;t t
-s,@CC@,$CC,;t t
-s,@CFLAGS@,$CFLAGS,;t t
-s,@LDFLAGS@,$LDFLAGS,;t t
-s,@CPPFLAGS@,$CPPFLAGS,;t t
-s,@ac_ct_CC@,$ac_ct_CC,;t t
-s,@EXEEXT@,$EXEEXT,;t t
-s,@OBJEXT@,$OBJEXT,;t t
-s,@CPP@,$CPP,;t t
-s,@EGREP@,$EGREP,;t t
-s,@AR@,$AR,;t t
-s,@ac_ct_AR@,$ac_ct_AR,;t t
-s,@RANLIB@,$RANLIB,;t t
-s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
-s,@RC@,$RC,;t t
-s,@ac_ct_RC@,$ac_ct_RC,;t t
-s,@SET_MAKE@,$SET_MAKE,;t t
-s,@TCL_THREADS@,$TCL_THREADS,;t t
-s,@CYGPATH@,$CYGPATH,;t t
-s,@CELIB_DIR@,$CELIB_DIR,;t t
-s,@DL_LIBS@,$DL_LIBS,;t t
-s,@CFLAGS_DEBUG@,$CFLAGS_DEBUG,;t t
-s,@CFLAGS_OPTIMIZE@,$CFLAGS_OPTIMIZE,;t t
-s,@CFLAGS_WARNING@,$CFLAGS_WARNING,;t t
-s,@ZLIB_DLL_FILE@,$ZLIB_DLL_FILE,;t t
-s,@ZLIB_LIBS@,$ZLIB_LIBS,;t t
-s,@ZLIB_OBJS@,$ZLIB_OBJS,;t t
-s,@CFLAGS_DEFAULT@,$CFLAGS_DEFAULT,;t t
-s,@LDFLAGS_DEFAULT@,$LDFLAGS_DEFAULT,;t t
-s,@VC_MANIFEST_EMBED_DLL@,$VC_MANIFEST_EMBED_DLL,;t t
-s,@VC_MANIFEST_EMBED_EXE@,$VC_MANIFEST_EMBED_EXE,;t t
-s,@TCL_WIN_VERSION@,$TCL_WIN_VERSION,;t t
-s,@MACHINE@,$MACHINE,;t t
-s,@TCL_VERSION@,$TCL_VERSION,;t t
-s,@TCL_MAJOR_VERSION@,$TCL_MAJOR_VERSION,;t t
-s,@TCL_MINOR_VERSION@,$TCL_MINOR_VERSION,;t t
-s,@TCL_PATCH_LEVEL@,$TCL_PATCH_LEVEL,;t t
-s,@PKG_CFG_ARGS@,$PKG_CFG_ARGS,;t t
-s,@TCL_EXE@,$TCL_EXE,;t t
-s,@TCL_LIB_FILE@,$TCL_LIB_FILE,;t t
-s,@TCL_LIB_FLAG@,$TCL_LIB_FLAG,;t t
-s,@TCL_STATIC_LIB_FILE@,$TCL_STATIC_LIB_FILE,;t t
-s,@TCL_STATIC_LIB_FLAG@,$TCL_STATIC_LIB_FLAG,;t t
-s,@TCL_IMPORT_LIB_FILE@,$TCL_IMPORT_LIB_FILE,;t t
-s,@TCL_IMPORT_LIB_FLAG@,$TCL_IMPORT_LIB_FLAG,;t t
-s,@TCL_LIB_SPEC@,$TCL_LIB_SPEC,;t t
-s,@TCL_STUB_LIB_FILE@,$TCL_STUB_LIB_FILE,;t t
-s,@TCL_STUB_LIB_FLAG@,$TCL_STUB_LIB_FLAG,;t t
-s,@TCL_STUB_LIB_SPEC@,$TCL_STUB_LIB_SPEC,;t t
-s,@TCL_STUB_LIB_PATH@,$TCL_STUB_LIB_PATH,;t t
-s,@TCL_INCLUDE_SPEC@,$TCL_INCLUDE_SPEC,;t t
-s,@TCL_BUILD_STUB_LIB_SPEC@,$TCL_BUILD_STUB_LIB_SPEC,;t t
-s,@TCL_BUILD_STUB_LIB_PATH@,$TCL_BUILD_STUB_LIB_PATH,;t t
-s,@TCL_DLL_FILE@,$TCL_DLL_FILE,;t t
-s,@TCL_SRC_DIR@,$TCL_SRC_DIR,;t t
-s,@TCL_BIN_DIR@,$TCL_BIN_DIR,;t t
-s,@TCL_DBGX@,$TCL_DBGX,;t t
-s,@CFG_TCL_SHARED_LIB_SUFFIX@,$CFG_TCL_SHARED_LIB_SUFFIX,;t t
-s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,$CFG_TCL_UNSHARED_LIB_SUFFIX,;t t
-s,@CFG_TCL_EXPORT_FILE_SUFFIX@,$CFG_TCL_EXPORT_FILE_SUFFIX,;t t
-s,@EXTRA_CFLAGS@,$EXTRA_CFLAGS,;t t
-s,@DEPARG@,$DEPARG,;t t
-s,@CC_OBJNAME@,$CC_OBJNAME,;t t
-s,@CC_EXENAME@,$CC_EXENAME,;t t
-s,@LDFLAGS_DEBUG@,$LDFLAGS_DEBUG,;t t
-s,@LDFLAGS_OPTIMIZE@,$LDFLAGS_OPTIMIZE,;t t
-s,@LDFLAGS_CONSOLE@,$LDFLAGS_CONSOLE,;t t
-s,@LDFLAGS_WINDOW@,$LDFLAGS_WINDOW,;t t
-s,@STLIB_LD@,$STLIB_LD,;t t
-s,@SHLIB_LD@,$SHLIB_LD,;t t
-s,@SHLIB_LD_LIBS@,$SHLIB_LD_LIBS,;t t
-s,@SHLIB_CFLAGS@,$SHLIB_CFLAGS,;t t
-s,@SHLIB_SUFFIX@,$SHLIB_SUFFIX,;t t
-s,@TCL_SHARED_BUILD@,$TCL_SHARED_BUILD,;t t
-s,@LIBS_GUI@,$LIBS_GUI,;t t
-s,@DLLSUFFIX@,$DLLSUFFIX,;t t
-s,@LIBPREFIX@,$LIBPREFIX,;t t
-s,@LIBSUFFIX@,$LIBSUFFIX,;t t
-s,@EXESUFFIX@,$EXESUFFIX,;t t
-s,@LIBRARIES@,$LIBRARIES,;t t
-s,@MAKE_LIB@,$MAKE_LIB,;t t
-s,@MAKE_STUB_LIB@,$MAKE_STUB_LIB,;t t
-s,@POST_MAKE_LIB@,$POST_MAKE_LIB,;t t
-s,@MAKE_DLL@,$MAKE_DLL,;t t
-s,@MAKE_EXE@,$MAKE_EXE,;t t
-s,@TCL_BUILD_LIB_SPEC@,$TCL_BUILD_LIB_SPEC,;t t
-s,@TCL_CC_SEARCH_FLAGS@,$TCL_CC_SEARCH_FLAGS,;t t
-s,@TCL_LD_SEARCH_FLAGS@,$TCL_LD_SEARCH_FLAGS,;t t
-s,@TCL_NEEDS_EXP_FILE@,$TCL_NEEDS_EXP_FILE,;t t
-s,@TCL_BUILD_EXP_FILE@,$TCL_BUILD_EXP_FILE,;t t
-s,@TCL_EXP_FILE@,$TCL_EXP_FILE,;t t
-s,@TCL_LIB_VERSIONS_OK@,$TCL_LIB_VERSIONS_OK,;t t
-s,@TCL_PACKAGE_PATH@,$TCL_PACKAGE_PATH,;t t
-s,@TCL_DDE_VERSION@,$TCL_DDE_VERSION,;t t
-s,@TCL_DDE_MAJOR_VERSION@,$TCL_DDE_MAJOR_VERSION,;t t
-s,@TCL_DDE_MINOR_VERSION@,$TCL_DDE_MINOR_VERSION,;t t
-s,@TCL_REG_VERSION@,$TCL_REG_VERSION,;t t
-s,@TCL_REG_MAJOR_VERSION@,$TCL_REG_MAJOR_VERSION,;t t
-s,@TCL_REG_MINOR_VERSION@,$TCL_REG_MINOR_VERSION,;t t
-s,@RC_OUT@,$RC_OUT,;t t
-s,@RC_TYPE@,$RC_TYPE,;t t
-s,@RC_INCLUDE@,$RC_INCLUDE,;t t
-s,@RC_DEFINE@,$RC_DEFINE,;t t
-s,@RC_DEFINES@,$RC_DEFINES,;t t
-s,@RES@,$RES,;t t
-s,@LIBOBJS@,$LIBOBJS,;t t
-s,@LTLIBOBJS@,$LTLIBOBJS,;t t
-CEOF
-_ACEOF
+eval set X " :F $CONFIG_FILES "
+shift
+for ac_tag
+do
+ case $ac_tag in
+ :[FHLC]) ac_mode=$ac_tag; continue;;
+ esac
+ case $ac_mode$ac_tag in
+ :[FHL]*:*);;
+ :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;
+ :[FH]-) ac_tag=-:-;;
+ :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;
+ esac
+ ac_save_IFS=$IFS
+ IFS=:
+ set x $ac_tag
+ IFS=$ac_save_IFS
+ shift
+ ac_file=$1
+ shift
- cat >>$CONFIG_STATUS <<\_ACEOF
- # Split the substitutions into bite-sized pieces for seds with
- # small command number limits, like on Digital OSF/1 and HP-UX.
- ac_max_sed_lines=48
- ac_sed_frag=1 # Number of current file.
- ac_beg=1 # First line for current file.
- ac_end=$ac_max_sed_lines # Line after last line for current file.
- ac_more_lines=:
- ac_sed_cmds=
- while $ac_more_lines; do
- if test $ac_beg -gt 1; then
- sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- else
- sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
- fi
- if test ! -s $tmp/subs.frag; then
- ac_more_lines=false
- else
- # The purpose of the label and of the branching condition is to
- # speed up the sed processing (if there are no `@' at all, there
- # is no need to browse any of the substitutions).
- # These are the two extra sed commands mentioned above.
- (echo ':t
- /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
- else
- ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
- fi
- ac_sed_frag=`expr $ac_sed_frag + 1`
- ac_beg=$ac_end
- ac_end=`expr $ac_end + $ac_max_sed_lines`
+ case $ac_mode in
+ :L) ac_source=$1;;
+ :[FH])
+ ac_file_inputs=
+ for ac_f
+ do
+ case $ac_f in
+ -) ac_f="$ac_tmp/stdin";;
+ *) # Look for the file first in the build tree, then in the source tree
+ # (if the path is not absolute). The absolute path cannot be DOS-style,
+ # because $ac_f cannot contain `:'.
+ test -f "$ac_f" ||
+ case $ac_f in
+ [\\/$]*) false;;
+ *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;
+ esac ||
+ as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;
+ esac
+ case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac
+ as_fn_append ac_file_inputs " '$ac_f'"
+ done
+
+ # Let's still pretend it is `configure' which instantiates (i.e., don't
+ # use $as_me), people would be surprised to read:
+ # /* config.h. Generated by config.status. */
+ configure_input='Generated from '`
+ $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'
+ `' by configure.'
+ if test x"$ac_file" != x-; then
+ configure_input="$ac_file. $configure_input"
+ { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5
+$as_echo "$as_me: creating $ac_file" >&6;}
fi
- done
- if test -z "$ac_sed_cmds"; then
- ac_sed_cmds=cat
- fi
-fi # test -n "$CONFIG_FILES"
+ # Neutralize special characters interpreted by sed in replacement strings.
+ case $configure_input in #(
+ *\&* | *\|* | *\\* )
+ ac_sed_conf_input=`$as_echo "$configure_input" |
+ sed 's/[\\\\&|]/\\\\&/g'`;; #(
+ *) ac_sed_conf_input=$configure_input;;
+ esac
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
- # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
- case $ac_file in
- - | *:- | *:-:* ) # input from stdin
- cat >$tmp/stdin
- ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
- ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
- * ) ac_file_in=$ac_file.in ;;
+ case $ac_tag in
+ *:-:* | *:-) cat >"$ac_tmp/stdin" \
+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;
+ esac
+ ;;
esac
- # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
- ac_dir=`(dirname "$ac_file") 2>/dev/null ||
+ ac_dir=`$as_dirname -- "$ac_file" ||
$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
X"$ac_file" : 'X\(//\)[^/]' \| \
X"$ac_file" : 'X\(//\)$' \| \
- X"$ac_file" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- { if $as_mkdir_p; then
- mkdir -p "$ac_dir"
- else
- as_dir="$ac_dir"
- as_dirs=
- while test ! -d "$as_dir"; do
- as_dirs="$as_dir $as_dirs"
- as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
- X"$as_dir" : 'X\(//\)[^/]' \| \
- X"$as_dir" : 'X\(//\)$' \| \
- X"$as_dir" : 'X\(/\)' \| \
- . : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
- /^X\(\/\/\)[^/].*/{ s//\1/; q; }
- /^X\(\/\/\)$/{ s//\1/; q; }
- /^X\(\/\).*/{ s//\1/; q; }
- s/.*/./; q'`
- done
- test ! -n "$as_dirs" || mkdir $as_dirs
- fi || { { echo "$as_me:$LINENO: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
- { (exit 1); exit 1; }; }; }
-
+ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||
+$as_echo X"$ac_file" |
+ sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)[^/].*/{
+ s//\1/
+ q
+ }
+ /^X\(\/\/\)$/{
+ s//\1/
+ q
+ }
+ /^X\(\/\).*/{
+ s//\1/
+ q
+ }
+ s/.*/./; q'`
+ as_dir="$ac_dir"; as_fn_mkdir_p
ac_builddir=.
-if test "$ac_dir" != .; then
- ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
- # A "../" for each directory in $ac_dir_suffix.
- ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
- ac_dir_suffix= ac_top_builddir=
-fi
+case "$ac_dir" in
+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;
+*)
+ ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`
+ # A ".." for each directory in $ac_dir_suffix.
+ ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`
+ case $ac_top_builddir_sub in
+ "") ac_top_builddir_sub=. ac_top_build_prefix= ;;
+ *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;
+ esac ;;
+esac
+ac_abs_top_builddir=$ac_pwd
+ac_abs_builddir=$ac_pwd$ac_dir_suffix
+# for backward compatibility:
+ac_top_builddir=$ac_top_build_prefix
case $srcdir in
- .) # No --srcdir option. We are building in place.
+ .) # We are building in place.
ac_srcdir=.
- if test -z "$ac_top_builddir"; then
- ac_top_srcdir=.
- else
- ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
- fi ;;
- [\\/]* | ?:[\\/]* ) # Absolute path.
+ ac_top_srcdir=$ac_top_builddir_sub
+ ac_abs_top_srcdir=$ac_pwd ;;
+ [\\/]* | ?:[\\/]* ) # Absolute name.
ac_srcdir=$srcdir$ac_dir_suffix;
- ac_top_srcdir=$srcdir ;;
- *) # Relative path.
- ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
- ac_top_srcdir=$ac_top_builddir$srcdir ;;
+ ac_top_srcdir=$srcdir
+ ac_abs_top_srcdir=$srcdir ;;
+ *) # Relative name.
+ ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix
+ ac_top_srcdir=$ac_top_build_prefix$srcdir
+ ac_abs_top_srcdir=$ac_pwd/$srcdir ;;
esac
+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
- case "$ac_dir" in
- .) ac_abs_builddir=`pwd`;;
- [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
- *) ac_abs_builddir=`pwd`/"$ac_dir";;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
- case ${ac_top_builddir}. in
- .) ac_abs_top_builddir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
- *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
- case $ac_srcdir in
- .) ac_abs_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
- *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
- esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
- case $ac_top_srcdir in
- .) ac_abs_top_srcdir=$ac_abs_builddir;;
- [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
- *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
- esac;;
-esac
+ case $ac_mode in
+ :F)
+ #
+ # CONFIG_FILE
+ #
+_ACEOF
- if test x"$ac_file" != x-; then
- { echo "$as_me:$LINENO: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
- rm -f "$ac_file"
- fi
- # Let's still pretend it is `configure' which instantiates (i.e., don't
- # use $as_me), people would be surprised to read:
- # /* config.h. Generated by config.status. */
- if test x"$ac_file" = x-; then
- configure_input=
- else
- configure_input="$ac_file. "
- fi
- configure_input=$configure_input"Generated from `echo $ac_file_in |
- sed 's,.*/,,'` by configure."
-
- # First look for the input files in the build tree, otherwise in the
- # src tree.
- ac_file_inputs=`IFS=:
- for f in $ac_file_in; do
- case $f in
- -) echo $tmp/stdin ;;
- [\\/$]*)
- # Absolute (can't be DOS-style, as IFS=:)
- test -f "$f" || { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- echo "$f";;
- *) # Relative
- if test -f "$f"; then
- # Build tree
- echo "$f"
- elif test -f "$srcdir/$f"; then
- # Source tree
- echo "$srcdir/$f"
- else
- # /dev/null tree
- { { echo "$as_me:$LINENO: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
- { (exit 1); exit 1; }; }
- fi;;
- esac
- done` || { (exit 1); exit 1; }
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
+# If the template does not know about datarootdir, expand it.
+# FIXME: This hack should be removed a few years after 2.60.
+ac_datarootdir_hack=; ac_datarootdir_seen=
+ac_sed_dataroot='
+/datarootdir/ {
+ p
+ q
+}
+/@datadir@/p
+/@docdir@/p
+/@infodir@/p
+/@localedir@/p
+/@mandir@/p'
+case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in
+*datarootdir*) ac_datarootdir_seen=yes;;
+*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5
+$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}
+_ACEOF
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ ac_datarootdir_hack='
+ s&@datadir@&$datadir&g
+ s&@docdir@&$docdir&g
+ s&@infodir@&$infodir&g
+ s&@localedir@&$localedir&g
+ s&@mandir@&$mandir&g
+ s&\\\${datarootdir}&$datarootdir&g' ;;
+esac
_ACEOF
-cat >>$CONFIG_STATUS <<_ACEOF
- sed "$ac_vpsub
+
+# Neutralize VPATH when `$srcdir' = `.'.
+# Shell code in configure.ac might set extrasub.
+# FIXME: do we really want to maintain this feature?
+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
+ac_sed_extra="$ac_vpsub
$extrasub
_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
:t
/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s,@configure_input@,$configure_input,;t t
-s,@srcdir@,$ac_srcdir,;t t
-s,@abs_srcdir@,$ac_abs_srcdir,;t t
-s,@top_srcdir@,$ac_top_srcdir,;t t
-s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s,@builddir@,$ac_builddir,;t t
-s,@abs_builddir@,$ac_abs_builddir,;t t
-s,@top_builddir@,$ac_top_builddir,;t t
-s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
- rm -f $tmp/stdin
- if test x"$ac_file" != x-; then
- mv $tmp/out $ac_file
- else
- cat $tmp/out
- rm -f $tmp/out
- fi
+s|@configure_input@|$ac_sed_conf_input|;t t
+s&@top_builddir@&$ac_top_builddir_sub&;t t
+s&@top_build_prefix@&$ac_top_build_prefix&;t t
+s&@srcdir@&$ac_srcdir&;t t
+s&@abs_srcdir@&$ac_abs_srcdir&;t t
+s&@top_srcdir@&$ac_top_srcdir&;t t
+s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t
+s&@builddir@&$ac_builddir&;t t
+s&@abs_builddir@&$ac_abs_builddir&;t t
+s&@abs_top_builddir@&$ac_abs_top_builddir&;t t
+$ac_datarootdir_hack
+"
+eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \
+ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+
+test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&
+ { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&
+ { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \
+ "$ac_tmp/out"`; test -z "$ac_out"; } &&
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined" >&5
+$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'
+which seems to be undefined. Please make sure it is defined" >&2;}
+
+ rm -f "$ac_tmp/stdin"
+ case $ac_file in
+ -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;
+ *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;
+ esac \
+ || as_fn_error $? "could not create $ac_file" "$LINENO" 5
+ ;;
+
-done
-_ACEOF
-cat >>$CONFIG_STATUS <<\_ACEOF
+ esac
+
+done # for ac_tag
+
-{ (exit 0); exit 0; }
+as_fn_exit 0
_ACEOF
-chmod +x $CONFIG_STATUS
ac_clean_files=$ac_clean_files_save
+test $ac_write_fail = 0 ||
+ as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5
+
# configure is writing to config.log, and then calls config.status.
# config.status does its own redirection, appending to config.log.
@@ -6292,7 +6543,11 @@ if test "$no_create" != yes; then
exec 5>>config.log
# Use ||, not &&, to avoid exiting from the if with $? = 1, which
# would make configure fail if this is the last instruction.
- $ac_cs_success || { (exit 1); exit 1; }
+ $ac_cs_success || as_fn_exit 1
+fi
+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then
+ { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5
+$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}
fi
diff --git a/win/configure.in b/win/configure.ac
index 511cb39..7b63c61 100644
--- a/win/configure.in
+++ b/win/configure.ac
@@ -4,17 +4,17 @@
# to configure the system for the local environment.
AC_INIT(../generic/tcl.h)
-AC_PREREQ(2.59)
+AC_PREREQ(2.69)
# The following define is needed when building with Cygwin since newer
# versions of autoconf incorrectly set SHELL to /bin/bash instead of
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=8.6
+TCL_VERSION=8.7
TCL_MAJOR_VERSION=8
-TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".9"
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
@@ -78,12 +78,6 @@ AC_PROG_MAKE_SET
AC_OBJEXT
AC_EXEEXT
-#--------------------------------------------------------------------
-# Check whether --enable-threads or --disable-threads was given.
-#--------------------------------------------------------------------
-
-SC_ENABLE_THREADS
-
#------------------------------------------------------------------------
# Embedded configuration information, encoding to use for the values, TIP #59
#------------------------------------------------------------------------
@@ -174,6 +168,54 @@ AC_CHECK_TYPE([uintptr_t], [
fi
])
+
+#--------------------------------------------------------------------
+# Zipfs support - Tip 430
+#--------------------------------------------------------------------
+AC_ARG_ENABLE(zipfs,
+ AC_HELP_STRING([--enable-zipfs],
+ [build with Zipfs support (default: on)]),
+ [tcl_ok=$enableval], [tcl_ok=yes])
+if test "$tcl_ok" = "yes" ; then
+ #
+ # Find a native compiler
+ #
+ AX_CC_FOR_BUILD
+ #
+ # Find a native zip implementation
+ #
+ SC_PROG_TCLSH
+ SC_ZIPFS_SUPPORT
+ ZIPFS_BUILD=1
+ TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+ ZIPFS_BUILD=0
+ TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+AC_MSG_CHECKING([for building with zipfs])
+if test "${ZIPFS_BUILD}" = 1; then
+ if test "${SHARED_BUILD}" = 0; then
+ ZIPFS_BUILD=2;
+ AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
+ INSTALL_LIBRARIES=install-libraries-zipfs-static
+ AC_MSG_RESULT([yes])
+ else
+ AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
+ INSTALL_LIBRARIES=install-libraries-zipfs-shared
+ AC_MSG_RESULT([yes])
+ fi
+else
+AC_MSG_RESULT([no])
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+AC_SUBST(ZIPFS_BUILD)
+AC_SUBST(TCL_ZIP_FILE)
+AC_SUBST(INSTALL_LIBRARIES)
+AC_SUBST(INSTALL_MSGS)
+
+
#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------
diff --git a/win/makefile.vc b/win/makefile.vc
index a6709d1..66a9fdf 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -55,7 +55,7 @@
# c:\tcl_src\win\>nmake -f makefile.vc release
# c:\tcl_src\win\>nmake -f makefile.vc test
# c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl
-# c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
+# c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs
# c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols
#
@@ -123,7 +123,6 @@ TCLDDELIBNAME = $(PROJECT)dde$(DDEVERSION)$(SUFX:t=).$(EXT)
TCLDDELIB = $(OUT_DIR)\$(TCLDDELIBNAME)
TCLTEST = $(OUT_DIR)\$(PROJECT)test.exe
-CAT32 = $(OUT_DIR)\cat32.exe
TCLSHOBJS = \
$(TMP_DIR)\tclAppInit.obj \
@@ -218,6 +217,7 @@ COREOBJS = \
$(TMP_DIR)\tclPosixStr.obj \
$(TMP_DIR)\tclPreserve.obj \
$(TMP_DIR)\tclProc.obj \
+ $(TMP_DIR)\tclProcess.obj \
$(TMP_DIR)\tclRegexp.obj \
$(TMP_DIR)\tclResolve.obj \
$(TMP_DIR)\tclResult.obj \
@@ -235,6 +235,7 @@ COREOBJS = \
$(TMP_DIR)\tclUtf.obj \
$(TMP_DIR)\tclUtil.obj \
$(TMP_DIR)\tclVar.obj \
+ $(TMP_DIR)\tclZipfs.obj \
$(TMP_DIR)\tclZlib.obj
ZLIBOBJS = \
@@ -275,6 +276,9 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_mp_exch.obj \
$(TMP_DIR)\bn_mp_expt_d.obj \
$(TMP_DIR)\bn_mp_expt_d_ex.obj \
+ $(TMP_DIR)\bn_mp_get_int.obj \
+ $(TMP_DIR)\bn_mp_get_long.obj \
+ $(TMP_DIR)\bn_mp_get_long_long.obj \
$(TMP_DIR)\bn_mp_grow.obj \
$(TMP_DIR)\bn_mp_init.obj \
$(TMP_DIR)\bn_mp_init_copy.obj \
@@ -299,11 +303,17 @@ TOMMATHOBJS = \
$(TMP_DIR)\bn_mp_rshd.obj \
$(TMP_DIR)\bn_mp_set.obj \
$(TMP_DIR)\bn_mp_set_int.obj \
+ $(TMP_DIR)\bn_mp_set_long.obj \
+ $(TMP_DIR)\bn_mp_set_long_long.obj \
$(TMP_DIR)\bn_mp_shrink.obj \
$(TMP_DIR)\bn_mp_sqr.obj \
$(TMP_DIR)\bn_mp_sqrt.obj \
$(TMP_DIR)\bn_mp_sub.obj \
$(TMP_DIR)\bn_mp_sub_d.obj \
+ $(TMP_DIR)\bn_mp_tc_and.obj \
+ $(TMP_DIR)\bn_mp_tc_div_2d.obj \
+ $(TMP_DIR)\bn_mp_tc_or.obj \
+ $(TMP_DIR)\bn_mp_tc_xor.obj \
$(TMP_DIR)\bn_mp_to_unsigned_bin.obj \
$(TMP_DIR)\bn_mp_to_unsigned_bin_n.obj \
$(TMP_DIR)\bn_mp_toom_mul.obj \
@@ -344,7 +354,8 @@ TCLOBJS = $(COREOBJS) $(ZLIBOBJS) $(TOMMATHOBJS) $(PLATFORMOBJS)
TCLSTUBOBJS = \
$(TMP_DIR)\tclStubLib.obj \
$(TMP_DIR)\tclTomMathStubLib.obj \
- $(TMP_DIR)\tclOOStubLib.obj
+ $(TMP_DIR)\tclOOStubLib.obj \
+ $(TMP_DIR)\tclWinPanic.obj
### The following paths CANNOT have spaces in them as they appear on
### the left side of implicit rules.
@@ -376,20 +387,20 @@ release: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
core: setup $(TCLLIB) $(TCLSTUBLIB)
shell: setup $(TCLSH)
dlls: setup $(TCLREGLIB) $(TCLDDELIB)
-all: setup $(TCLSH) $(TCLSTUBLIB) dlls $(CAT32) pkgs
-tcltest: setup $(TCLTEST) dlls $(CAT32)
+all: setup $(TCLSH) $(TCLSTUBLIB) dlls pkgs
+tcltest: setup $(TCLTEST) dlls
install: install-binaries install-libraries install-docs install-pkgs
setup: default-setup
test: test-core test-pkgs
-test-core: setup $(TCLTEST) dlls $(CAT32)
+test-core: setup $(TCLTEST) dlls
set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) "$(ROOT:\=/)/tests/all.tcl" $(TESTFLAGS) -loadfile <<
package ifneeded dde 1.4.1 [list load "$(TCLDDELIB:\=/)" dde]
package ifneeded registry 1.3.3 [list load "$(TCLREGLIB:\=/)" registry]
<<
-runtest: setup $(TCLTEST) dlls $(CAT32)
+runtest: setup $(TCLTEST) dlls
set TCL_LIBRARY=$(ROOT:\=/)/library
$(DEBUGGER) $(TCLTEST) $(SCRIPT)
@@ -411,11 +422,11 @@ $(TCLLIB): $(TCLOBJS)
$**
<<
$(_VC_MANIFEST_EMBED_DLL)
+
$(TCLIMPLIB): $(TCLLIB)
!endif # $(STATIC_BUILD)
-
$(TCLSTUBLIB): $(TCLSTUBOBJS)
$(LIBCMD) -nodefaultlib $(TCLSTUBOBJS)
@@ -477,11 +488,6 @@ clean-pkgs:
popd \
)
-$(CAT32): $(WINDIR)\cat.c
- $(cc32) $(cflags) $(crt) -D_CRT_NONSTDC_NO_DEPRECATE -DCONSOLE -Fo$(TMP_DIR)\ $?
- $(CONEXECMD) -stack:16384 $(TMP_DIR)\cat.obj
- $(_VC_MANIFEST_EMBED_EXE)
-
#---------------------------------------------------------------------
# Regenerate the stubs files. [Development use only]
#---------------------------------------------------------------------
@@ -575,7 +581,6 @@ $(OUT_DIR)\tcl.nmake:
@type << >$@
CORE_MACHINE = $(MACHINE)
CORE_DEBUG = $(DEBUG)
-CORE_TCL_THREADS = $(TCL_THREADS)
CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
CORE_USE_WIDECHAR_API = $(USE_WIDECHAR_API)
<<
@@ -631,7 +636,6 @@ $(OUT_DIR)\tclConfig.sh: $(WINDIR)\tclConfig.sh.in
@TCL_STUB_LIB_FILE@ $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_FLAG@ $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_SPEC@ -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
-@TCL_THREADS@ $(TCL_THREADS)
@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
@TCL_STUB_LIB_PATH@ $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
@@ -681,6 +685,9 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
$(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
$(CCAPPCMD) $?
+$(TMP_DIR)\tclZipfs.obj: $(GENERICDIR)\tclZipfs.c
+ $(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -I$(COMPATDIR)\zlib\contrib\minizip -Fo$@ $?
+
$(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
$(cc32) $(pkgcflags) -I$(COMPATDIR)\zlib -Fo$@ $?
@@ -696,6 +703,8 @@ $(TMP_DIR)\tclPkgConfig.obj: $(GENERICDIR)\tclPkgConfig.c
-DCFG_RUNTIME_SCRDIR="\"$(SCRIPT_INSTALL_DIR:\=\\)\"" \
-DCFG_RUNTIME_INCDIR="\"$(INCLUDE_INSTALL_DIR:\=\\)\"" \
-DCFG_RUNTIME_DOCDIR="\"$(DOC_INSTALL_DIR:\=\\)\"" \
+ -DCFG_RUNTIME_DLLFILE="\"$(CFG_RUNTIME_DLLFILE:\=\\)\"" \
+ -DCFG_RUNTIME_ZIPFILE="\"$(CFG_RUNTIME_ZIPFILE:\=\\)\"" \
-Fo$@ $?
$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
@@ -704,7 +713,6 @@ $(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
-Fo$@ $?
### The following objects should be built using the stub interfaces
-### *ALL* extensions need to built with -DTCL_THREADS=1
$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
!if $(STATIC_BUILD)
@@ -735,6 +743,9 @@ $(TMP_DIR)\tclTomMathStubLib.obj: $(GENERICDIR)\tclTomMathStubLib.c
$(TMP_DIR)\tclOOStubLib.obj: $(GENERICDIR)\tclOOStubLib.c
$(cc32) $(stubscflags) -Fo$@ $?
+$(TMP_DIR)\tclWinPanic.obj: $(WINDIR)\tclWinPanic.c
+ $(cc32) $(stubscflags) -Fo$@ $?
+
$(TMP_DIR)\tclsh.exe.manifest: $(WINDIR)\tclsh.exe.manifest.in
@nmakehlp -s << $** >$@
@MACHINE@ $(MACHINE:IX86=X86)
@@ -826,6 +837,8 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
@if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.7" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.7"
@if not exist "$(LIB_INSTALL_DIR)\nmake" \
$(MKDIR) "$(LIB_INSTALL_DIR)\nmake"
@echo Installing header files
@@ -855,9 +868,6 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
@$(CPY) "$(WINDIR)\targets.vc" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(WINDIR)\nmakehlp.c" "$(LIB_INSTALL_DIR)\nmake\"
@$(CPY) "$(OUT_DIR)\tcl.nmake" "$(LIB_INSTALL_DIR)\nmake\"
- @echo Installing library http1.0 directory
- @$(CPY) "$(ROOT)\library\http1.0\*.tcl" \
- "$(SCRIPT_INSTALL_DIR)\http1.0\"
@echo Installing library opt0.4 directory
@$(CPY) "$(ROOT)\library\opt\*.tcl" \
"$(SCRIPT_INSTALL_DIR)\opt0.4\"
@@ -866,7 +876,7 @@ install-libraries: tclConfig tcl-nmake install-msgs install-tzdata
"$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.7\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
"$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index b759020..1655d48 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -686,10 +686,10 @@ SubstituteFile(
BOOL FileExists(LPCTSTR szPath)
{
#ifndef INVALID_FILE_ATTRIBUTES
- #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
+ #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
#endif
DWORD pathAttr = GetFileAttributes(szPath);
- return (pathAttr != INVALID_FILE_ATTRIBUTES &&
+ return (pathAttr != INVALID_FILE_ATTRIBUTES &&
!(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
}
@@ -740,7 +740,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
#if 0 /* This function is not available in Visual C++ 6 */
/*
* Use numerics 0 -> FindExInfoStandard,
- * 1 -> FindExSearchLimitToDirectories,
+ * 1 -> FindExSearchLimitToDirectories,
* as these are not defined in Visual C++ 6
*/
hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
@@ -755,7 +755,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
do {
int sublen;
/*
- * We need to check it is a directory despite the
+ * We need to check it is a directory despite the
* FindExSearchLimitToDirectories in the above call. See SDK docs
*/
if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
@@ -786,7 +786,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
* that is used to confirm it is the correct directory.
* The search path for the package directory is currently only
* the parent and grandparent of the current working directory.
- * If found, the command prints
+ * If found, the command prints
* name_DIRPATH=<full path of located directory>
* and returns 0. If not found, does not print anything and returns 1.
*/
@@ -794,7 +794,7 @@ static int LocateDependency(const char *keypath)
{
int i, ret;
static char *paths[] = {"..", "..\\..", "..\\..\\.."};
-
+
for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
ret = LocateDependencyHelper(paths[i], keypath);
if (ret == 0)
diff --git a/win/rules.vc b/win/rules.vc
index 8db4752..fbcb235 100644
--- a/win/rules.vc
+++ b/win/rules.vc
@@ -24,7 +24,7 @@ _RULES_VC = 1
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
-RULES_VERSION_MINOR = 2
+RULES_VERSION_MINOR = 3
# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
@@ -394,7 +394,7 @@ MSG = ^
# If INSTALLDIR set to Tcl installation root dir then reset to the
-# lib dir for installing extensions
+# lib dir for installing extensions
!if exist("$(_INSTALLDIR)\include\tcl.h")
_INSTALLDIR=$(_INSTALLDIR)\lib
!endif
@@ -546,7 +546,7 @@ NMAKEHLPC = $(_TCLDIR)\win\nmakehlp.c
# The following macros are set:
# OPTIMIZATIONS - the compiler flags to be used for optimized builds
# DEBUGFLAGS - the compiler flags to be used for debug builds
-# LINKERFLAGS - Flags passed to the linker
+# LINKERFLAGS - Flags passed to the linker
#
# Note that these are the compiler settings *available*, not those
# that will be *used*. The latter depends on the OPTS macro settings
@@ -730,15 +730,6 @@ TCL_USE_STATIC_PACKAGES = 1
TCL_USE_STATIC_PACKAGES = 0
!endif
-!if [nmakehlp -f $(OPTS) "nothreads"]
-!message *** Compile explicitly for non-threaded tcl
-TCL_THREADS = 0
-USE_THREAD_ALLOC= 0
-!else
-TCL_THREADS = 1
-USE_THREAD_ALLOC= 1
-!endif
-
!if [nmakehlp -f $(OPTS) "symbols"]
!message *** Doing symbols
DEBUG = 1
@@ -774,12 +765,6 @@ PGO = 0
!message *** Warning: ignoring option "loimpact" - deprecated on modern Windows.
!endif
-# TBD - should get rid of this option
-!if [nmakehlp -f $(OPTS) "thrdalloc"]
-!message *** Doing thrdalloc
-USE_THREAD_ALLOC = 1
-!endif
-
!if [nmakehlp -f $(OPTS) "tclalloc"]
USE_THREAD_ALLOC = 0
!endif
@@ -970,7 +955,7 @@ VERSION = $(DOTVERSION:.=)
# different compilers, build configurations etc.,
#
# Naming convention (suffixes):
-# t = full thread support.
+# t = full thread support. (Not used for Tcl >= 8.7)
# s = static library (as opposed to an import library)
# g = linked to the debug enabled C run-time.
# x = special static build when it links to the dynamic C run-time.
@@ -1028,7 +1013,7 @@ SUFX = $(SUFX:x=)
!endif
!endif
-!if !$(TCL_THREADS)
+!if !$(TCL_THREADS) || $(TCL_VERSION) > 86
TMP_DIRFULL = $(TMP_DIRFULL:Threaded=)
SUFX = $(SUFX:t=)
!endif
@@ -1061,7 +1046,7 @@ STUBPREFIX = $(PROJECT)stub
# Set up paths to various Tcl executables and libraries needed by extensions
!if $(DOING_TCL)
-TCLSHNAME = $(PROJECT)sh$(TCL_VERSION)$(SUFX).exe
+TCLSHNAME = $(PROJECT)sh$(VERSION)$(SUFX).exe
TCLSH = $(OUT_DIR)\$(TCLSHNAME)
TCLIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
TCLLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
@@ -1078,20 +1063,17 @@ TCL_INCLUDES = -I"$(WINDIR)" -I"$(GENERICDIR)"
# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
# Try various possibilities in turn.
-TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe
-!if !exist("$(TCLSH)") && $(TCL_THREADS)
-TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX).exe
-!endif
+TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist("$(TCLSH)")
-TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
+TCLSH = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
TCLSTUBLIB = $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
-TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib
+TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
-TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
+TCLIMPLIB = $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY = $(_TCLDIR)\lib
TCLREGLIB = $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
@@ -1101,19 +1083,16 @@ TCL_INCLUDES = -I"$(_TCLDIR)\include"
!else # Building against Tcl sources
-TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe
-!if !exist($(TCLSH)) && $(TCL_THREADS)
-TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX).exe
-!endif
-!if !exist($(TCLSH))
TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
+!if !exist($(TCLSH))
+TCLSH = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
TCLSTUBLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
-TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib
+TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
-TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
+TCLIMPLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY = $(_TCLDIR)\library
TCLREGLIB = $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
@@ -1183,8 +1162,8 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
!endif # $(DOING_TK) || $(NEED_TK)
# Various output paths
-PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
-PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX).$(EXT)
+PRJIMPLIB = $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX:t=).lib
+PRJLIBNAME = $(PROJECT)$(VERSION)$(SUFX:t=).$(EXT)
PRJLIB = $(OUT_DIR)\$(PRJLIBNAME)
PRJSTUBLIBNAME = $(STUBPREFIX)$(VERSION).lib
@@ -1264,7 +1243,7 @@ OPTDEFINES = $(OPTDEFINES) -DTCL_MEM_DEBUG
!if $(TCL_COMPILE_DEBUG)
OPTDEFINES = $(OPTDEFINES) -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS
!endif
-!if $(TCL_THREADS)
+!if $(TCL_THREADS) && $(TCL_VERSION) < 86
OPTDEFINES = $(OPTDEFINES) -DTCL_THREADS=1
!if $(USE_THREAD_ALLOC)
OPTDEFINES = $(OPTDEFINES) -DUSE_THREAD_ALLOC=1
@@ -1321,7 +1300,7 @@ USE_WIDECHAR_API = 0
!endif
!if $(USE_WIDECHAR_API)
-COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
+COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
!endif
# Like the TEA system only set this non empty for non-Tk extensions
@@ -1331,7 +1310,7 @@ COMPILERFLAGS = $(COMPILERFLAGS) /DUNICODE /D_UNICODE
PKGNAMEFLAGS = -DPACKAGE_NAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
-DPACKAGE_TCLNAME="\"$(PRJ_PACKAGE_TCLNAME)\"" \
-DPACKAGE_VERSION="\"$(DOTVERSION)\"" \
- -DMODULE_SCOPE=extern
+ -DMODULE_SCOPE=extern
!endif
# crt picks the C run time based on selected OPTS
@@ -1424,7 +1403,7 @@ pkgcflags_nostubs = $(appcflags_nostubs) $(PKGNAMEFLAGS) -DBUILD_$(PROJECT)
# compiled with another VC version. Check for this and fix accordingly.
stubscflags = $(cflags) $(PKGNAMEFLAGS) $(PRJ_DEFINES) $(OPTDEFINES) -Zl -DSTATIC_BUILD $(INCLUDES)
-# Link flags
+# Link flags
!if $(DEBUG)
ldebug = -debug -debugtype:cv
@@ -1440,25 +1419,13 @@ ldebug = $(ldebug) -debug -debugtype:cv
ldebug= $(ldebug) -profile
!endif
-### Declarations common to all linker versions
+### Declarations common to all linker versions
lflags = -nologo -machine:$(MACHINE) $(LINKERFLAGS) $(ldebug)
!if $(MSVCRT) && !($(DEBUG) && !$(UNCHECKED)) && $(VCVERSION) >= 1900
lflags = $(lflags) -nodefaultlib:libucrt.lib
!endif
-# Old linkers (Visual C++ 6 in particular) will link for fast loading
-# on Win98. Since we do not support Win98 any more, we specify nowin98
-# as recommended for NT and later. However, this is only required by
-# IX86 on older compilers and only needed if we are not doing a static build.
-
-!if "$(MACHINE)" == "IX86" && !$(STATIC_BUILD)
-!if [nmakehlp -l -opt:nowin98 $(LINKER_TESTFLAGS)]
-# Align sections for PE size savings.
-lflags = $(lflags) -opt:nowin98
-!endif
-!endif
-
dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
@@ -1503,9 +1470,9 @@ RESCMD = $(rc32) -fo $@ -r -i "$(GENERICDIR)" -i "$(TMP_DIR)" \
-DCOMMAVERSION=$(DOTVERSION:.=,),0 \
-DDOTVERSION=\"$(DOTVERSION)\" \
-DVERSION=\"$(VERSION)\" \
- -DSUFX=\"$(SUFX)\" \
- -DPROJECT=\"$(PROJECT)\" \
- -DPRJLIBNAME=\"$(PRJLIBNAME)\"
+ -DSUFX=\"$(SUFX:t=)\" \
+ -DPROJECT=\"$(PROJECT)\" \
+ -DPRJLIBNAME=\"$(PRJLIBNAME)\"
!ifndef DEFAULT_BUILD_TARGET
DEFAULT_BUILD_TARGET = $(PROJECT)
@@ -1602,7 +1569,7 @@ default-shell: default-setup $(PROJECT)
@if exist $(LIBDIR) for %f in ("$(LIBDIR)\*.tcl") do @$(COPY) %f "$(OUT_DIR)"
$(DEBUGGER) $(TCLSH)
-# Generation of Windows version resource
+# Generation of Windows version resource
!ifdef RCFILE
# Note: don't use $** in below rule because there may be other dependencies
@@ -1641,7 +1608,7 @@ BEGIN
VALUE "OriginalFilename", PRJLIBNAME
VALUE "FileVersion", DOTVERSION
VALUE "ProductName", "Package " PROJECT " for Tcl"
- VALUE "ProductVersion", DOTVERSION
+ VALUE "ProductVersion", DOTVERSION
END
END
BLOCK "VarFileInfo"
@@ -1720,9 +1687,6 @@ TCLNMAKECONFIG = "$(OUT_DIR)\tcl.nmake"
!if defined(CORE_MACHINE) && "$(CORE_MACHINE)" != "$(MACHINE)"
!error ERROR: Build target ($(MACHINE)) does not match the Tcl library architecture ($(CORE_MACHINE)).
!endif
-!if defined(CORE_USE_THREAD_ALLOC) && $(CORE_USE_THREAD_ALLOC) != $(USE_THREAD_ALLOC)
-!message WARNING: Value of USE_THREAD_ALLOC ($(USE_THREAD_ALLOC)) does not match its Tcl core value ($(CORE_USE_THREAD_ALLOC)).
-!endif
!if defined(CORE_DEBUG) && $(CORE_DEBUG) != $(DEBUG)
!message WARNING: Value of DEBUG ($(DEBUG)) does not match its Tcl library configuration ($(DEBUG)).
!endif
diff --git a/win/tcl.dsp b/win/tcl.dsp
index e8b1a33..eae1681 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -36,7 +36,7 @@ CFG=tcl - Win32 Debug Static
# 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\tclsh86.exe"
+# PROP BASE Target_File "Release\tclsh87.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -45,7 +45,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Release\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Release\tclsh86t.exe"
+# PROP Target_File "Release\tclsh87t.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -57,7 +57,7 @@ CFG=tcl - Win32 Debug Static
# 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\tclsh86g.exe"
+# PROP BASE Target_File "Debug\tclsh87g.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -66,7 +66,7 @@ CFG=tcl - Win32 Debug Static
# PROP Intermediate_Dir "Debug\tcl_Dynamic"
# PROP Cmd_Line "nmake -nologo -f makefile.vc OPTS=threads,symbols MSVCDIR=IDE"
# PROP Rebuild_Opt "clean release"
-# PROP Target_File "Debug\tclsh86tg.exe"
+# PROP Target_File "Debug\tclsh87tg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -78,7 +78,7 @@ CFG=tcl - Win32 Debug Static
# 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\tclsh86sg.exe"
+# PROP BASE Target_File "Debug\tclsh87sg.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -87,7 +87,7 @@ CFG=tcl - Win32 Debug Static
# 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\tclsh86sg.exe"
+# PROP Target_File "Debug\tclsh87sg.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -99,7 +99,7 @@ CFG=tcl - Win32 Debug Static
# 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\tclsh86s.exe"
+# PROP BASE Target_File "Release\tclsh87s.exe"
# PROP BASE Bsc_Name ""
# PROP BASE Target_Dir ""
# PROP Use_MFC 0
@@ -108,7 +108,7 @@ CFG=tcl - Win32 Debug Static
# 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\tclsh86s.exe"
+# PROP Target_File "Release\tclsh87s.exe"
# PROP Bsc_Name ""
# PROP Target_Dir ""
@@ -152,10 +152,6 @@ 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
@@ -208,10 +204,6 @@ SOURCE=..\compat\tclErrno.h
# 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
@@ -1268,6 +1260,10 @@ SOURCE=..\generic\tclProc.c
# End Source File
# Begin Source File
+SOURCE=..\generic\tclProcess.c
+# End Source File
+# Begin Source File
+
SOURCE=..\generic\tclRegexp.c
# End Source File
# Begin Source File
@@ -1424,7 +1420,7 @@ SOURCE=.\configure
# End Source File
# Begin Source File
-SOURCE=.\configure.in
+SOURCE=.\configure.ac
# End Source File
# Begin Source File
@@ -1528,6 +1524,10 @@ SOURCE=.\tclWinNotify.c
# End Source File
# Begin Source File
+SOURCE=.\tclWinPanic.c
+# End Source File
+# Begin Source File
+
SOURCE=.\tclWinPipe.c
# End Source File
# Begin Source File
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in
index a94cea6..08d411d 100644
--- a/win/tcl.hpj.in
+++ b/win/tcl.hpj.in
@@ -5,9 +5,9 @@ HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl86.cnt
+CNT=tcl87.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl86.hlp
+HLP=tcl87.hlp
[FILES]
tcl.rtf
diff --git a/win/tcl.m4 b/win/tcl.m4
index 84f0dff..c0dd539 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -251,6 +251,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
# TCL_BIN_DIR
# TCL_SRC_DIR
# TCL_LIB_FILE
+# TCL_ZIP_FILE
#
#------------------------------------------------------------------------
@@ -283,6 +284,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
# eval is required to do the TCL_DBGX substitution
#
+ eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\""
eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
@@ -295,6 +297,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
AC_SUBST(TCL_BIN_DIR)
AC_SUBST(TCL_SRC_DIR)
+ AC_SUBST(TCL_ZIP_FILE)
AC_SUBST(TCL_LIB_FILE)
AC_SUBST(TCL_LIB_FLAG)
AC_SUBST(TCL_LIB_SPEC)
@@ -380,42 +383,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [
SHARED_BUILD=0
AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
fi
-])
-
-#------------------------------------------------------------------------
-# SC_ENABLE_THREADS --
-#
-# Specify if thread support should be enabled
-#
-# Arguments:
-# none
-#
-# Results:
-#
-# Adds the following arguments to configure:
-# --enable-threads=yes|no
-#
-# Defines the following vars:
-# TCL_THREADS
-#------------------------------------------------------------------------
-
-AC_DEFUN([SC_ENABLE_THREADS], [
- AC_MSG_CHECKING(for building with threads)
- AC_ARG_ENABLE(threads, [ --enable-threads build with threads (default: on)],
- [tcl_ok=$enableval], [tcl_ok=yes])
-
- if test "$tcl_ok" = "yes"; then
- AC_MSG_RESULT([yes (default)])
- 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)
- else
- TCL_THREADS=0
- AC_MSG_RESULT(no)
- fi
- AC_SUBST(TCL_THREADS)
+ AC_SUBST(SHARED_BUILD)
])
#------------------------------------------------------------------------
@@ -544,22 +512,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
AC_ARG_ENABLE(64bit,[ --enable-64bit enable 64bit support (where applicable)], [do64bit=$enableval], [do64bit=no])
AC_MSG_RESULT($do64bit)
- # Cross-compiling options for Windows/CE builds
-
- AC_MSG_CHECKING([if Windows/CE build is requested])
- AC_ARG_ENABLE(wince,[ --enable-wince enable Win/CE support (where applicable)], [doWince=$enableval], [doWince=no])
- AC_MSG_RESULT($doWince)
-
- AC_MSG_CHECKING([for Windows/CE celib directory])
- AC_ARG_WITH(celib,[ --with-celib=DIR use Windows/CE support library from DIR],
- CELIB_DIR=$withval, CELIB_DIR=NO_CELIB)
- AC_MSG_RESULT([$CELIB_DIR])
-
# Set some defaults (may get changed below)
EXTRA_CFLAGS=""
AC_DEFINE(MODULE_SCOPE, [extern], [No need to mark inidividual symbols as hidden])
AC_CHECK_PROG(CYGPATH, cygpath, cygpath -m, echo)
+ AC_CHECK_PROG(WINE, wine, wine,)
SHLIB_SUFFIX=".dll"
@@ -727,7 +685,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
CFLAGS_DEBUG=-g
CFLAGS_OPTIMIZE="-O2 -fomit-frame-pointer"
- CFLAGS_WARNING="-Wall -Wdeclaration-after-statement"
+ CFLAGS_WARNING="-Wall -Wwrite-strings -Wsign-compare -Wdeclaration-after-statement -Wpointer-arith"
LDFLAGS_DEBUG=
LDFLAGS_OPTIMIZE=
@@ -871,98 +829,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
LINKBIN="link"
fi
- if test "$doWince" != "no" ; then
- # Set defaults for common evc4/PPC2003 setup
- # Currently Tcl requires 300+, possibly 420+ for sockets
- CEVERSION=420; # could be 211 300 301 400 420 ...
- TARGETCPU=ARMV4; # could be ARMV4 ARM MIPS SH3 X86 ...
- ARCH=ARM; # could be ARM MIPS X86EM ...
- PLATFORM="Pocket PC 2003"; # or "Pocket PC 2002"
- if test "$doWince" != "yes"; then
- # If !yes then the user specified something
- # Reset ARCH to allow user to skip specifying it
- ARCH=
- eval `echo $doWince | awk -F "," '{ \
- if (length([$]1)) { printf "CEVERSION=\"%s\"\n", [$]1; \
- if ([$]1 < 400) { printf "PLATFORM=\"Pocket PC 2002\"\n" } }; \
- if (length([$]2)) { printf "TARGETCPU=\"%s\"\n", toupper([$]2) }; \
- if (length([$]3)) { printf "ARCH=\"%s\"\n", toupper([$]3) }; \
- if (length([$]4)) { printf "PLATFORM=\"%s\"\n", [$]4 }; \
- }'`
- if test "x${ARCH}" = "x" ; then
- ARCH=$TARGETCPU;
- fi
- fi
- OSVERSION=WCE$CEVERSION;
- if test "x${WCEROOT}" = "x" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded C++ 4.0"
- if test ! -d "${WCEROOT}" ; then
- WCEROOT="C:/Program Files/Microsoft eMbedded Tools"
- fi
- fi
- if test "x${SDKROOT}" = "x" ; then
- SDKROOT="C:/Program Files/Windows CE Tools"
- if test ! -d "${SDKROOT}" ; then
- SDKROOT="C:/Windows CE Tools"
- fi
- fi
- # The space-based-path will work for the Makefile, but will
- # not work if AC_TRY_COMPILE is called.
- WCEROOT=`echo "$WCEROOT" | sed -e 's!\\\!/!g'`
- SDKROOT=`echo "$SDKROOT" | sed -e 's!\\\!/!g'`
- CELIB_DIR=`echo "$CELIB_DIR" | sed -e 's!\\\!/!g'`
- if test ! -d "${CELIB_DIR}/inc"; then
- AC_MSG_ERROR([Invalid celib directory "${CELIB_DIR}"])
- fi
- if test ! -d "${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"\
- -o ! -d "${WCEROOT}/EVC/${OSVERSION}/bin"; then
- AC_MSG_ERROR([could not find PocketPC SDK or target compiler to enable WinCE mode [$CEVERSION,$TARGETCPU,$ARCH,$PLATFORM]])
- else
- CEINCLUDE="${SDKROOT}/${OSVERSION}/${PLATFORM}/include"
- if test -d "${CEINCLUDE}/${TARGETCPU}" ; then
- CEINCLUDE="${CEINCLUDE}/${TARGETCPU}"
- fi
- CELIBPATH="${SDKROOT}/${OSVERSION}/${PLATFORM}/Lib/${TARGETCPU}"
- fi
- fi
-
- if test "$doWince" != "no" ; then
- CEBINROOT="${WCEROOT}/EVC/${OSVERSION}/bin"
- if test "${TARGETCPU}" = "X86"; then
- CC="${CEBINROOT}/cl.exe"
- else
- CC="${CEBINROOT}/cl${ARCH}.exe"
- fi
- CC="\"${CC}\" -I\"${CELIB_DIR}/inc\" -I\"${CEINCLUDE}\""
- RC="\"${WCEROOT}/Common/EVC/bin/rc.exe\""
- arch=`echo ${ARCH} | awk '{print tolower([$]0)}'`
- defs="${ARCH} _${ARCH}_ ${arch} PALM_SIZE _MT _DLL _WINDOWS"
- for i in $defs ; do
- AC_DEFINE_UNQUOTED($i)
- done
-# if test "${ARCH}" = "X86EM"; then
-# AC_DEFINE_UNQUOTED(_WIN32_WCE_EMULATION)
-# fi
- AC_DEFINE_UNQUOTED(_WIN32_WCE, $CEVERSION)
- AC_DEFINE_UNQUOTED(UNDER_CE, $CEVERSION)
- CFLAGS_DEBUG="-nologo -Zi -Od"
- CFLAGS_OPTIMIZE="-nologo -O2"
- lversion=`echo ${CEVERSION} | sed -e 's/\(.\)\(..\)/\1\.\2/'`
- lflags="-nodefaultlib -MACHINE:${ARCH} -LIBPATH:\"${CELIBPATH}\" -subsystem:windowsce,${lversion} -nologo"
- LINKBIN="\"${CEBINROOT}/link.exe\""
- AC_SUBST(CELIB_DIR)
- if test "${CEVERSION}" -lt 400 ; then
- LIBS="coredll.lib corelibc.lib winsock.lib"
- else
- LIBS="coredll.lib corelibc.lib ws2.lib"
- fi
- # celib currently stuck at wce300 status
- #LIBS="$LIBS \${CELIB_DIR}/wince-${ARCH}-pocket-${OSVERSION}-release/celib.lib"
- LIBS="$LIBS \"\${CELIB_DIR}/wince-${ARCH}-pocket-wce300-release/celib.lib\""
- LIBS_GUI="commctrl.lib commdlg.lib"
- else
- LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
- fi
+ LIBS_GUI="gdi32.lib comdlg32.lib imm32.lib comctl32.lib shell32.lib uuid.lib"
SHLIB_LD="${LINKBIN} -dll -incremental:no ${lflags}"
SHLIB_LD_LIBS='${LIBS}'
@@ -993,7 +860,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# Specify linker flags depending on the type of app being
# built -- Console vs. Window.
- if test "$doWince" != "no" -a "${TARGETCPU}" != "X86"; then
+ if test "${TARGETCPU}" != "X86"; then
LDFLAGS_CONSOLE="-link ${lflags}"
LDFLAGS_WINDOW=${LDFLAGS_CONSOLE}
else
@@ -1126,13 +993,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl8.6$1/win; then
- TCL_BIN_DEFAULT=../../tcl8.6$1/win
+ if test -d ../../tcl8.7$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.7$1/win
else
- TCL_BIN_DEFAULT=../../tcl8.6/win
+ TCL_BIN_DEFAULT=../../tcl8.7/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.6 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 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)
@@ -1297,3 +1164,126 @@ print("manifest needed")
AC_SUBST(VC_MANIFEST_EMBED_DLL)
AC_SUBST(VC_MANIFEST_EMBED_EXE)
])
+
+#------------------------------------------------------------------------
+# SC_CC_FOR_BUILD
+# For cross compiles, locate a C compiler that can generate native binaries.
+#
+# Arguments:
+# none
+#
+# Results:
+# Substitutes the following vars:
+# CC_FOR_BUILD
+# EXEEXT_FOR_BUILD
+#------------------------------------------------------------------------
+
+dnl Get a default for CC_FOR_BUILD to put into Makefile.
+AC_DEFUN([AX_CC_FOR_BUILD],
+[# Put a plausible default for CC_FOR_BUILD in Makefile.
+if test -z "$CC_FOR_BUILD"; then
+ if test "x$cross_compiling" = "xno"; then
+ CC_FOR_BUILD='$(CC)'
+ else
+ AC_MSG_CHECKING([for gcc])
+ AC_CACHE_VAL(ac_cv_path_cc, [
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/gcc 2> /dev/null` \
+ `ls -r $dir/gcc 2> /dev/null` ; do
+ if test x"$ac_cv_path_cc" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_cc=$j
+ break
+ fi
+ fi
+ done
+ done
+ ])
+ fi
+fi
+AC_SUBST(CC_FOR_BUILD)
+# Also set EXEEXT_FOR_BUILD.
+if test "x$cross_compiling" = "xno"; then
+ EXEEXT_FOR_BUILD='$(EXEEXT)'
+ OBJEXT_FOR_BUILD='$(OBJEXT)'
+else
+ OBJEXT_FOR_BUILD='.no'
+ AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
+ [rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.c
+ bfd_cv_build_exeext=
+ ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ rm -f conftest*
+ test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
+ EXEEXT_FOR_BUILD=""
+ test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+fi
+AC_SUBST(EXEEXT_FOR_BUILD)])dnl
+AC_SUBST(OBJEXT_FOR_BUILD)])dnl
+
+
+
+#------------------------------------------------------------------------
+# SC_ZIPFS_SUPPORT
+# Locate a zip encoder installed on the system path, or none.
+#
+# Arguments:
+# none
+#
+# Results:
+# Substitutes the following vars:
+# ZIP_PROG
+# ZIP_PROG_OPTIONS
+# ZIP_PROG_VFSSEARCH
+# ZIP_INSTALL_OBJS
+#------------------------------------------------------------------------
+
+AC_DEFUN([SC_ZIPFS_SUPPORT], [
+ ZIP_PROG=""
+ ZIP_PROG_OPTIONS=""
+ ZIP_PROG_VFSSEARCH=""
+ ZIP_INSTALL_OBJS=""
+
+ AC_MSG_CHECKING([for zip])
+ AC_CACHE_VAL(ac_cv_path_zip, [
+ search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+ for dir in $search_path ; do
+ for j in `ls -r $dir/zip 2> /dev/null` \
+ `ls -r $dir/zip 2> /dev/null` ; do
+ if test x"$ac_cv_path_zip" = x ; then
+ if test -f "$j" ; then
+ ac_cv_path_zip=$j
+ break
+ fi
+ fi
+ done
+ done
+ ])
+ if test -f "$ac_cv_path_zip" ; then
+ ZIP_PROG="$ac_cv_path_zip"
+ AC_MSG_RESULT([$ZIP_PROG])
+ ZIP_PROG_OPTIONS="-rq"
+ ZIP_PROG_VFSSEARCH="*"
+ AC_MSG_RESULT([Found INFO Zip in environment])
+ # Use standard arguments for zip
+ else
+ # It is not an error if an installed version of Zip can't be located.
+ # We can use the locally distributed minizip instead
+ ZIP_PROG="./minizip${EXEEXT_FOR_BUILD}"
+ ZIP_PROG_OPTIONS="-o -r"
+ ZIP_PROG_VFSSEARCH="*"
+ ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+ AC_MSG_RESULT([No zip found on PATH building minizip])
+ fi
+ AC_SUBST(ZIP_PROG)
+ AC_SUBST(ZIP_PROG_OPTIONS)
+ AC_SUBST(ZIP_PROG_VFSSEARCH)
+ AC_SUBST(ZIP_INSTALL_OBJS)
+])
diff --git a/win/tcl.rc b/win/tcl.rc
index be5e0a7..477512d 100644
--- a/win/tcl.rc
+++ b/win/tcl.rc
@@ -7,19 +7,13 @@
//
// build-up the name suffix that defines the type of build this is.
//
-#if TCL_THREADS
-#define SUFFIX_THREADS "t"
-#else
-#define SUFFIX_THREADS ""
-#endif
-
#if DEBUG && !UNCHECKED
#define SUFFIX_DEBUG "g"
#else
#define SUFFIX_DEBUG ""
#endif
-#define SUFFIX SUFFIX_THREADS SUFFIX_DEBUG
+#define SUFFIX SUFFIX_DEBUG
LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index 2236da3..fa27756 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -126,6 +126,9 @@ _tmain(
#ifdef TCL_LOCAL_MAIN_HOOK
TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#elif !defined(_WIN32) || defined(UNICODE)
+ /* This doesn't work on Windows without UNICODE */
+ TclZipfs_AppHook(&argc, &argv);
#endif
Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
@@ -265,8 +268,8 @@ setargv(
}
/* Make sure we don't call ckalloc through the (not yet initialized) stub table */
- #undef Tcl_Alloc
- #undef Tcl_DbCkalloc
+# undef Tcl_Alloc
+# undef Tcl_DbCkalloc
argSpace = ckalloc(size * sizeof(char *)
+ (_tcslen(cmdLine) * sizeof(TCHAR)) + sizeof(TCHAR));
diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index 6ed06e2..5dc6833 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -41,6 +41,9 @@ 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 name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
+TCL_ZIP_FILE='@TCL_ZIP_FILE@'
+
# Flag to indicate whether shared libraries need export files.
TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
@@ -77,7 +80,7 @@ TCL_SHLIB_LD='@SHLIB_LD@'
TCL_STLIB_LD='@STLIB_LD@'
# Either '$LIBS' (if dependent libraries should be included when linking
-# shared libraries) or an empty string. See Tcl's configure.in for more
+# shared libraries) or an empty string. See Tcl's configure.ac for more
# explanation.
TCL_SHLIB_LD_LIBS='@SHLIB_LD_LIBS@'
@@ -175,7 +178,3 @@ 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@'
-
-# Flag, 1: we built Tcl with threads enabled, 0 we didn't
-TCL_THREADS=@TCL_THREADS@
-
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 0fa86c9..5cb309f 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -23,7 +23,6 @@
*/
static HINSTANCE hInstance; /* HINSTANCE of this DLL. */
-static int platformId; /* Running under NT, or 95/98? */
/*
* VC++ 5.x has no 'cpuid' assembler instruction, so we must emulate it
@@ -184,49 +183,18 @@ TclWinInit(
hInstance = hInst;
os.dwOSVersionInfoSize = sizeof(OSVERSIONINFOW);
GetVersionExW(&os);
- platformId = os.dwPlatformId;
/*
- * We no longer support Win32s or Win9x, so just in case someone manages
- * to get a runtime there, make sure they know that.
+ * We no longer support Win32s or Win9x or Windows CE, so just in case
+ * someone manages to get a runtime there, make sure they know that.
*/
- if (platformId == VER_PLATFORM_WIN32s) {
- Tcl_Panic("Win32s is not a supported platform");
- }
- if (platformId == VER_PLATFORM_WIN32_WINDOWS) {
- Tcl_Panic("Windows 9x is not a supported platform");
+ if (os.dwPlatformId != VER_PLATFORM_WIN32_NT) {
+ Tcl_Panic("Windows NT is the only supported platform");
}
}
/*
- *----------------------------------------------------------------------
- *
- * TclWinGetPlatformId --
- *
- * Determines whether running under NT, 95, or Win32s, to allow runtime
- * conditional code.
- *
- * Results:
- * The return value is one of:
- * VER_PLATFORM_WIN32s Win32s on Windows 3.1 (not supported)
- * VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95, 98, ME (not supported)
- * VER_PLATFORM_WIN32_NT Win32 on Windows NT, 2000, XP
- * VER_PLATFORM_WIN32_CE Win32 on Windows CE
- *
- * Side effects:
- * None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclWinGetPlatformId(void)
-{
- return platformId;
-}
-
-/*
*-------------------------------------------------------------------------
*
* TclWinNoBackslash --
@@ -260,34 +228,10 @@ TclWinNoBackslash(
/*
*---------------------------------------------------------------------------
*
- * TclpSetInterfaces --
- *
- * A helper proc.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-void
-TclpSetInterfaces(void)
-{
-}
-
-/*
- *---------------------------------------------------------------------------
- *
* TclWinEncodingsCleanup --
*
- * Called during finalization to free up any encodings we use.
- *
- * We also clean up any memory allocated in our mount point map which is
- * used to follow certain kinds of symlinks. That code should never be
- * used once encodings are taken down.
+ * Called during finalization to clean up any memory allocated in our
+ * mount point map which is used to follow certain kinds of symlinks.
*
* Results:
* None.
@@ -319,26 +263,6 @@ TclWinEncodingsCleanup(void)
}
/*
- *---------------------------------------------------------------------------
- *
- * TclWinResetInterfaces --
- *
- * Called during finalization to reset us to a safe state for reuse.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-void
-TclWinResetInterfaces(void)
-{
-}
-
-/*
*--------------------------------------------------------------------
*
* TclWinDriveLetterForVolMountPoint
@@ -682,8 +606,8 @@ Tcl_WinTCharToUtf(
int
TclWinCPUID(
- unsigned int index, /* Which CPUID value to retrieve. */
- unsigned int *regsPtr) /* Registers after the CPUID. */
+ int index, /* Which CPUID value to retrieve. */
+ int *regsPtr) /* Registers after the CPUID. */
{
int status = TCL_ERROR;
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 78b510b..8c47be6 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -25,7 +25,8 @@
#define FILE_TYPE_CONSOLE (FILE_TYPE_PIPE+2)
/*
- * The following structure contains per-instance data for a file based channel.
+ * The following structure contains per-instance data for a file based
+ * channel.
*/
typedef struct FileInfo {
@@ -43,7 +44,7 @@ typedef struct FileInfo {
* pending on the channel. */
} FileInfo;
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* List of all file channels currently open.
*/
@@ -58,7 +59,7 @@ static Tcl_ThreadDataKey dataKey;
* events are generated.
*/
-typedef struct FileEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
FileInfo *infoPtr; /* Pointer to file info structure. Note that
@@ -96,6 +97,7 @@ static int FileTruncateProc(ClientData instanceData,
Tcl_WideInt length);
static DWORD FileGetType(HANDLE handle);
static int NativeIsComPort(const TCHAR *nativeName);
+
/*
* This structure describes the channel type structure for file based IO.
*/
@@ -119,6 +121,14 @@ static const Tcl_ChannelType fileChannelType = {
FileThreadActionProc, /* Thread action proc. */
FileTruncateProc /* Truncate proc. */
};
+
+/*
+ * General useful clarification macros.
+ */
+
+#define SET_FLAG(var, flag) ((var) |= (flag))
+#define CLEAR_FLAG(var, flag) ((var) &= ~(flag))
+#define TEST_FLAG(value, flag) (((value) & (flag)) != 0)
/*
*----------------------------------------------------------------------
@@ -140,7 +150,7 @@ static ThreadSpecificData *
FileInit(void)
{
ThreadSpecificData *tsdPtr =
- (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey);
+ (ThreadSpecificData *) TclThreadDataKeyGet(&dataKey);
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
@@ -201,7 +211,7 @@ FileSetupProc(
Tcl_Time blockTime = { 0, 0 };
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!(flags & TCL_FILE_EVENTS)) {
+ if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
return;
}
@@ -244,7 +254,7 @@ FileCheckProc(
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!(flags & TCL_FILE_EVENTS)) {
+ if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
return;
}
@@ -255,8 +265,8 @@ FileCheckProc(
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
- if (infoPtr->watchMask && !(infoPtr->flags & FILE_PENDING)) {
- infoPtr->flags |= FILE_PENDING;
+ if (infoPtr->watchMask && !TEST_FLAG(infoPtr->flags, FILE_PENDING)) {
+ SET_FLAG(infoPtr->flags, FILE_PENDING);
evPtr = ckalloc(sizeof(FileEvent));
evPtr->header.proc = FileEventProc;
evPtr->infoPtr = infoPtr;
@@ -296,7 +306,7 @@ FileEventProc(
FileInfo *infoPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!(flags & TCL_FILE_EVENTS)) {
+ if (!TEST_FLAG(flags, TCL_FILE_EVENTS)) {
return 0;
}
@@ -310,7 +320,7 @@ FileEventProc(
for (infoPtr = tsdPtr->firstFilePtr; infoPtr != NULL;
infoPtr = infoPtr->nextPtr) {
if (fileEvPtr->infoPtr == infoPtr) {
- infoPtr->flags &= ~(FILE_PENDING);
+ CLEAR_FLAG(infoPtr->flags, FILE_PENDING);
Tcl_NotifyChannel(infoPtr->channel, infoPtr->watchMask);
break;
}
@@ -350,9 +360,9 @@ FileBlockProc(
*/
if (mode == TCL_MODE_NONBLOCKING) {
- infoPtr->flags |= FILE_ASYNC;
+ SET_FLAG(infoPtr->flags, FILE_ASYNC);
} else {
- infoPtr->flags &= ~(FILE_ASYNC);
+ CLEAR_FLAG(infoPtr->flags, FILE_ASYNC);
}
return 0;
}
@@ -472,7 +482,7 @@ FileSeekProc(
oldPosHigh = 0;
oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
- if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
+ if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
@@ -484,7 +494,7 @@ FileSeekProc(
newPosHigh = (offset < 0 ? -1 : 0);
newPos = SetFilePointer(infoPtr->handle, offset, &newPosHigh, moveMethod);
- if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+ if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
@@ -544,10 +554,10 @@ FileWideSeekProc(
moveMethod = FILE_END;
}
- newPosHigh = Tcl_WideAsLong(offset >> 32);
- newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
+ newPosHigh = (LONG)(offset >> 32);
+ newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
&newPosHigh, moveMethod);
- if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+ if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
if (winError != NO_ERROR) {
@@ -556,7 +566,8 @@ FileWideSeekProc(
return -1;
}
}
- return (((Tcl_WideInt)((unsigned)newPos)) | (Tcl_LongAsWide(newPosHigh) << 32));
+ return (((Tcl_WideInt)((unsigned)newPos))
+ | ((Tcl_WideInt)newPosHigh << 32));
}
/*
@@ -589,8 +600,9 @@ FileTruncateProc(
oldPosHigh = 0;
oldPos = SetFilePointer(infoPtr->handle, 0, &oldPosHigh, FILE_CURRENT);
- if (oldPos == (LONG)INVALID_SET_FILE_POINTER) {
+ if (oldPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
+
if (winError != NO_ERROR) {
TclWinConvertError(winError);
return errno;
@@ -601,11 +613,12 @@ FileTruncateProc(
* Move to where we want to truncate
*/
- newPosHigh = Tcl_WideAsLong(length >> 32);
- newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
+ newPosHigh = (LONG)(length >> 32);
+ newPos = SetFilePointer(infoPtr->handle, (LONG)length,
&newPosHigh, FILE_BEGIN);
- if (newPos == (LONG)INVALID_SET_FILE_POINTER) {
+ if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
DWORD winError = GetLastError();
+
if (winError != NO_ERROR) {
TclWinConvertError(winError);
return errno;
@@ -662,9 +675,9 @@ FileInputProc(
*errorCode = 0;
/*
- * TODO: This comment appears to be out of date. We *do* have a
- * console driver, over in tclWinConsole.c. After some Windows
- * developer confirms, this comment should be revised.
+ * TODO: This comment appears to be out of date. We *do* have a console
+ * driver, over in tclWinConsole.c. After some Windows developer confirms,
+ * this comment should be revised.
*
* Note that we will block on reads from a console buffer until a full
* line has been entered. The only way I know of to get around this is to
@@ -721,7 +734,7 @@ FileOutputProc(
* seek to the end of the file before writing the current buffer.
*/
- if (infoPtr->flags & FILE_APPEND) {
+ if (TEST_FLAG(infoPtr->flags, FILE_APPEND)) {
SetFilePointer(infoPtr->handle, 0, NULL, FILE_END);
}
@@ -798,12 +811,12 @@ FileGetHandleProc(
{
FileInfo *infoPtr = instanceData;
- if (direction & infoPtr->validMask) {
- *handlePtr = (ClientData) infoPtr->handle;
- return TCL_OK;
- } else {
+ if (!TEST_FLAG(direction, infoPtr->validMask)) {
return TCL_ERROR;
}
+
+ *handlePtr = (ClientData) infoPtr->handle;
+ return TCL_OK;
}
/*
@@ -843,10 +856,10 @@ TclpOpenFileChannel(
nativeName = Tcl_FSGetNativePath(pathPtr);
if (nativeName == NULL) {
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open \"",
- TclGetString(pathPtr), "\": filename is invalid on this platform",
- NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open \"%s\": filename is invalid on this platform",
+ TclGetString(pathPtr)));
}
return NULL;
}
@@ -894,39 +907,40 @@ TclpOpenFileChannel(
}
/*
- * [2413550] Avoid double-open of serial ports on Windows
- * Special handling for Windows serial ports by a "name-hint"
- * to directly open it with the OVERLAPPED flag set.
+ * [2413550] Avoid double-open of serial ports on Windows. Special
+ * handling for Windows serial ports by a "name-hint" to directly open it
+ * with the OVERLAPPED flag set.
*/
- if( NativeIsComPort(nativeName) ) {
-
+ if (NativeIsComPort(nativeName)) {
handle = TclWinSerialOpen(INVALID_HANDLE_VALUE, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- if (interp != (Tcl_Interp *) NULL) {
- Tcl_AppendResult(interp, "couldn't open serial \"",
- TclGetString(pathPtr), "\": ",
- Tcl_PosixError(interp), NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "couldn't open serial \"%s\": %s",
+ TclGetString(pathPtr), Tcl_PosixError(interp)));
}
return NULL;
}
/*
- * For natively named Windows serial ports we are done.
- */
+ * For natively named Windows serial ports we are done.
+ */
+
channel = TclWinOpenSerialChannel(handle, channelName,
channelPermissions);
return channel;
}
+
/*
* If the file is being created, get the file attributes from the
* permissions argument, else use the existing file attributes.
*/
- if (mode & O_CREAT) {
- if (permissions & S_IWRITE) {
+ if (TEST_FLAG(mode, O_CREAT)) {
+ if (TEST_FLAG(permissions, S_IWRITE)) {
flags = FILE_ATTRIBUTE_NORMAL;
} else {
flags = FILE_ATTRIBUTE_READONLY;
@@ -955,10 +969,11 @@ TclpOpenFileChannel(
DWORD err = GetLastError();
if ((err & 0xffffL) == ERROR_OPEN_FAILED) {
- err = (mode & O_CREAT) ? ERROR_FILE_EXISTS : ERROR_FILE_NOT_FOUND;
+ err = TEST_FLAG(mode, O_CREAT) ? ERROR_FILE_EXISTS
+ : ERROR_FILE_NOT_FOUND;
}
TclWinConvertError(err);
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't open \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -971,9 +986,9 @@ TclpOpenFileChannel(
switch (FileGetType(handle)) {
case FILE_TYPE_SERIAL:
/*
- * Natively named serial ports "com1-9", "\\\\.\\comXX" are
- * already done with the code above.
- * Here we handle all other serial port names.
+ * Natively named serial ports "com1-9", "\\\\.\\comXX" are already
+ * done with the code above. Here we handle all other serial port
+ * names.
*
* Reopen channel for OVERLAPPED operation. Normally this shouldn't
* fail, because the channel exists.
@@ -982,7 +997,7 @@ TclpOpenFileChannel(
handle = TclWinSerialOpen(handle, nativeName, accessMode);
if (handle == INVALID_HANDLE_VALUE) {
TclWinConvertError(GetLastError());
- if (interp != (Tcl_Interp *) NULL) {
+ if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't reopen serial \"%s\": %s",
TclGetString(pathPtr), Tcl_PosixError(interp)));
@@ -997,10 +1012,10 @@ TclpOpenFileChannel(
channelPermissions);
break;
case FILE_TYPE_PIPE:
- if (channelPermissions & TCL_READABLE) {
+ if (TEST_FLAG(channelPermissions, TCL_READABLE)) {
readFile = TclWinMakeFile(handle);
}
- if (channelPermissions & TCL_WRITABLE) {
+ if (TEST_FLAG(channelPermissions, TCL_WRITABLE)) {
writeFile = TclWinMakeFile(handle);
}
channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
@@ -1009,7 +1024,8 @@ TclpOpenFileChannel(
case FILE_TYPE_DISK:
case FILE_TYPE_UNKNOWN:
channel = TclWinOpenFileChannel(handle, channelName,
- channelPermissions, (mode & O_APPEND) ? FILE_APPEND : 0);
+ channelPermissions,
+ TEST_FLAG(mode, O_APPEND) ? FILE_APPEND : 0);
break;
default:
@@ -1074,10 +1090,10 @@ Tcl_MakeFileChannel(
channel = TclWinOpenConsoleChannel(handle, channelName, mode);
break;
case FILE_TYPE_PIPE:
- if (mode & TCL_READABLE) {
+ if (TEST_FLAG(mode, TCL_READABLE)) {
readFile = TclWinMakeFile(handle);
}
- if (mode & TCL_WRITABLE) {
+ if (TEST_FLAG(mode, TCL_WRITABLE)) {
writeFile = TclWinMakeFile(handle);
}
channel = TclpCreateCommandChannel(readFile, writeFile, NULL, 0, NULL);
@@ -1363,7 +1379,7 @@ TclWinOpenFileChannel(
infoPtr->flags = appendMode;
infoPtr->handle = handle;
infoPtr->dirty = 0;
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&fileChannelType, channelName,
infoPtr, permissions);
@@ -1524,10 +1540,11 @@ FileGetType(
*
* NativeIsComPort --
*
- * Determines if a path refers to a Windows serial port.
- * A simple and efficient solution is to use a "name hint" to detect
- * COM ports by their filename instead of resorting to a syscall
- * to detect serialness after the fact.
+ * Determines if a path refers to a Windows serial port. A simple and
+ * efficient solution is to use a "name hint" to detect COM ports by
+ * their filename instead of resorting to a syscall to detect serialness
+ * after the fact.
+ *
* The following patterns cover common serial port names:
* COM[1-9]
* \\.\COM[0-9]+
@@ -1549,12 +1566,12 @@ NativeIsComPort(
* 1. Look for com[1-9]:?
*/
- if ( (len == 4) && (_wcsnicmp(p, L"com", 3) == 0) ) {
+ if ((len == 4) && (_wcsnicmp(p, L"com", 3) == 0)) {
/*
- * The 4th character must be a digit 1..9
- */
+ * The 4th character must be a digit 1..9
+ */
- if ( (p[3] < L'1') || (p[3] > L'9') ) {
+ if ((p[3] < L'1') || (p[3] > L'9')) {
return 0;
}
return 1;
@@ -1566,11 +1583,11 @@ NativeIsComPort(
if ((len >= 8) && (_wcsnicmp(p, L"\\\\.\\com", 7) == 0)) {
/*
- * Charaters 8..end must be a digits 0..9
- */
+ * Charaters 8..end must be a digits 0..9
+ */
- for ( i=7; i<len; i++ ) {
- if ( (p[i] < '0') || (p[i] > '9') ) {
+ for (i=7; i<len; i++) {
+ if ((p[i] < '0') || (p[i] > '9')) {
return 0;
}
}
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index d61a030..f8b67a3 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -49,7 +49,7 @@ TCL_DECLARE_MUTEX(consoleMutex)
* threads.
*/
-typedef struct ConsoleThreadInfo {
+typedef struct {
HANDLE thread; /* Handle to reader or writer thread. */
HANDLE readyEvent; /* Manual-reset event to signal _to_ the main
* thread when the worker thread has finished
@@ -106,7 +106,7 @@ typedef struct ConsoleInfo {
/* Data consumed by reader thread. */
} ConsoleInfo;
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* The following pointer refers to the head of the list of consoles that
* are being watched for file events.
@@ -122,7 +122,7 @@ static Tcl_ThreadDataKey dataKey;
* console events are generated.
*/
-typedef struct ConsoleEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
ConsoleInfo *infoPtr; /* Pointer to console info structure. Note
@@ -1320,7 +1320,7 @@ TclWinOpenConsoleChannel(
* for instance).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&consoleChannelType, channelName,
infoPtr, permissions);
@@ -1360,11 +1360,7 @@ TclWinOpenConsoleChannel(
Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
-#ifdef UNICODE
Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
-#else
- Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
-#endif
return infoPtr->channel;
}
diff --git a/win/tclWinError.c b/win/tclWinError.c
index fea4b0f..bce81fa 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -391,7 +391,7 @@ tclWinDebugPanic(
if (IsDebuggerPresent()) {
WCHAR msgString[TCL_MAX_WARN_LEN];
- char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+ char buf[TCL_MAX_WARN_LEN * 3];
vsnprintf(buf, sizeof(buf), format, argList);
msgString[TCL_MAX_WARN_LEN-1] = L'\0';
@@ -406,6 +406,9 @@ tclWinDebugPanic(
}
OutputDebugStringW(msgString);
} else {
+ if (!isatty(fileno(stderr))) {
+ fprintf(stderr, "\xef\xbb\xbf");
+ }
vfprintf(stderr, format, argList);
fprintf(stderr, "\n");
fflush(stderr);
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 2f28154..c3ced34 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -337,7 +337,7 @@ DoRenameFile(
* character is either end-of-string or a directory separator
*/
- if ((strncmp(src, dst, (size_t) Tcl_DStringLength(&srcString))==0)
+ if ((strncmp(src, dst, Tcl_DStringLength(&srcString))==0)
&& (dst[Tcl_DStringLength(&srcString)] == '\\'
|| dst[Tcl_DStringLength(&srcString)] == '/'
|| dst[Tcl_DStringLength(&srcString)] == '\0')) {
@@ -1524,8 +1524,8 @@ GetWinFileAttributes(
* We test for, and fix that case, here.
*/
- int len;
- const char *str = Tcl_GetStringFromObj(fileName,&len);
+ const char *str = TclGetString(fileName);
+ size_t len = fileName->length;
if (len < 4) {
if (len == 0) {
@@ -1610,12 +1610,11 @@ ConvertFileNameFormat(
for (i = 0; i < pathc; i++) {
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] == ':'))
+ pathv = TclGetString(elt);
+ if ((pathv[0] == '/') || ((elt->length == 3) && (pathv[1] == ':'))
|| (strcmp(pathv, ".") == 0) || (strcmp(pathv, "..") == 0)) {
/*
* Handle "/", "//machine/export", "c:/", "." or ".." by just
@@ -1638,7 +1637,6 @@ ConvertFileNameFormat(
Tcl_DString dsTemp;
const TCHAR *nativeName;
const char *tempString;
- int tempLen;
WIN32_FIND_DATA data;
HANDLE handle;
DWORD attr;
@@ -1651,9 +1649,8 @@ ConvertFileNameFormat(
* likely to lead to infinite loops.
*/
- Tcl_DStringInit(&ds);
- tempString = Tcl_GetStringFromObj(tempPath,&tempLen);
- nativeName = Tcl_WinUtfToTChar(tempString, tempLen, &ds);
+ tempString = TclGetString(tempPath);
+ nativeName = Tcl_WinUtfToTChar(tempString, tempPath->length, &ds);
Tcl_DecrRefCount(tempPath);
handle = FindFirstFile(nativeName, &data);
if (handle == INVALID_HANDLE_VALUE) {
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index b9787c7..6582ee1 100755..100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -169,7 +169,7 @@ static int NativeWriteReparse(const TCHAR *LinkDirectory,
REPARSE_DATA_BUFFER *buffer);
static int NativeMatchType(int isDrive, DWORD attr,
const TCHAR *nativeName, Tcl_GlobTypeData *types);
-static int WinIsDrive(const char *name, int nameLen);
+static int WinIsDrive(const char *name, size_t nameLen);
static int WinIsReserved(const char *path);
static Tcl_Obj * WinReadLink(const TCHAR *LinkSource);
static Tcl_Obj * WinReadLinkDirectory(const TCHAR *LinkDirectory);
@@ -572,7 +572,6 @@ WinReadLinkDirectory(
*/
offset = 0;
-#ifdef UNICODE
if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
/*
* Check whether this is a mounted volume.
@@ -634,7 +633,6 @@ WinReadLinkDirectory(
offset = 4;
}
}
-#endif /* UNICODE */
Tcl_WinTCharToUtf((const TCHAR *)
reparseBuffer->MountPointReparseBuffer.PathBuffer,
@@ -809,7 +807,7 @@ tclWinDebugPanic(
{
#define TCL_MAX_WARN_LEN 1024
va_list argList;
- char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+ char buf[TCL_MAX_WARN_LEN * 3];
WCHAR msgString[TCL_MAX_WARN_LEN];
va_start(argList, format);
@@ -868,7 +866,7 @@ TclpFindExecutable(
* ignore. */
{
WCHAR wName[MAX_PATH];
- char name[MAX_PATH * TCL_UTF_MAX];
+ char name[MAX_PATH * 3];
/*
* Under Windows we ignore argv0, and return the path for the file used to
@@ -876,20 +874,11 @@ TclpFindExecutable(
*/
if (argv0 == NULL) {
+# undef Tcl_SetPanicProc
Tcl_SetPanicProc(tclWinDebugPanic);
}
-#ifdef UNICODE
GetModuleFileNameW(NULL, wName, MAX_PATH);
-#else
- GetModuleFileNameA(NULL, name, sizeof(name));
-
- /*
- * Convert to WCHAR to get out of ANSI codepage
- */
-
- MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
-#endif
WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
TclWinNoBackslash(name);
TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
@@ -942,10 +931,9 @@ TclpMatchInDirectory(
* Match a single file directly.
*/
- int len;
DWORD attr;
WIN32_FILE_ATTRIBUTE_DATA data;
- const char *str = Tcl_GetStringFromObj(norm,&len);
+ const char *str = TclGetString(norm);
native = Tcl_FSGetNativePath(pathPtr);
@@ -955,7 +943,7 @@ TclpMatchInDirectory(
}
attr = data.dwFileAttributes;
- if (NativeMatchType(WinIsDrive(str,len), attr, native, types)) {
+ if (NativeMatchType(WinIsDrive(str,norm->length), attr, native, types)) {
Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
}
}
@@ -966,7 +954,7 @@ TclpMatchInDirectory(
WIN32_FIND_DATA data;
const char *dirName; /* UTF-8 dir name, later with pattern
* appended. */
- int dirLength;
+ size_t dirLength;
int matchSpecialDots;
Tcl_DString ds; /* Native encoding of dir, also used
* temporarily for other things. */
@@ -1005,7 +993,8 @@ TclpMatchInDirectory(
*/
Tcl_DStringInit(&dsOrig);
- dirName = Tcl_GetStringFromObj(fileNamePtr, &dirLength);
+ dirName = TclGetString(fileNamePtr);
+ dirLength = fileNamePtr->length;
Tcl_DStringAppend(&dsOrig, dirName, dirLength);
lastChar = dirName[dirLength -1];
@@ -1183,7 +1172,7 @@ TclpMatchInDirectory(
static int
WinIsDrive(
const char *name, /* Name (UTF-8) */
- int len) /* Length of name */
+ size_t len) /* Length of name */
{
int remove = 0;
@@ -1460,9 +1449,9 @@ TclpGetUserHome(
domain = Tcl_UtfFindFirst(name, '@');
if (domain == NULL) {
const char *ptr;
-
+
/* no domain - firstly check it's the current user */
- if ( (ptr = TclpGetUserName(&ds)) != NULL
+ if ( (ptr = TclpGetUserName(&ds)) != NULL
&& strcasecmp(name, ptr) == 0
) {
/* try safest and fastest way to get current user home */
@@ -1485,7 +1474,7 @@ TclpGetUserHome(
Tcl_DStringInit(&ds);
wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
- /*
+ /*
* user does not exists - if domain was not specified,
* try again using current domain.
*/
@@ -1600,7 +1589,7 @@ NativeAccess(
return 0;
}
- /*
+ /*
* If it's not a directory (assume file), do several fast checks:
*/
if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
@@ -1654,7 +1643,6 @@ NativeAccess(
* what permissions the OS has set for a file.
*/
-#ifdef UNICODE
{
SECURITY_DESCRIPTOR *sdPtr = NULL;
unsigned long size;
@@ -1817,7 +1805,6 @@ NativeAccess(
}
}
-#endif /* !UNICODE */
return 0;
}
@@ -2031,7 +2018,7 @@ NativeStat(
*/
fileHandle = CreateFile(nativePath, GENERIC_READ,
- FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+ FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL, OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
@@ -2765,15 +2752,14 @@ TclpObjNormalizePath(
* Not the end of the string.
*/
- int len;
char *path;
Tcl_Obj *tmpPathPtr;
tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
nextCheckpoint);
Tcl_AppendToObj(tmpPathPtr, lastValidPathEnd, -1);
- path = Tcl_GetStringFromObj(tmpPathPtr, &len);
- Tcl_SetStringObj(pathPtr, path, len);
+ path = TclGetString(tmpPathPtr);
+ Tcl_SetStringObj(pathPtr, path, tmpPathPtr->length);
Tcl_DecrRefCount(tmpPathPtr);
} else {
/*
@@ -2856,9 +2842,8 @@ TclWinVolumeRelativeNormalize(
* also on drive C.
*/
- int cwdLen;
- const char *drive =
- Tcl_GetStringFromObj(useThisCwd, &cwdLen);
+ const char *drive = TclGetString(useThisCwd);
+ size_t cwdLen = useThisCwd->length;
char drive_cur = path[0];
if (drive_cur >= 'a') {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index ff5327d..2ce19ce 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -84,15 +84,10 @@ TclWinProcs tclWinProcs;
/*
* The following arrays contain the human readable strings for the Windows
- * platform and processor values.
+ * processor values.
*/
-#define NUMPLATFORMS 4
-static const char *const platforms[NUMPLATFORMS] = {
- "Win32s", "Windows 95", "Windows NT", "Windows CE"
-};
-
#define NUMPROCESSORS 11
static const char *const processors[NUMPROCESSORS] = {
"intel", "mips", "alpha", "ppc", "shx", "arm", "ia64", "alpha64", "msil",
@@ -112,12 +107,6 @@ static ProcessGlobalValue sourceLibraryDir =
{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
static void AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
-
-#if TCL_UTF_MAX < 4
-static void ToUtf(const WCHAR *wSrc, char *dst);
-#else
-#define ToUtf(wSrc, dst) WideCharToMultiByte(CP_UTF8, 0, wSrc, -1, dst, MAX_PATH * TCL_UTF_MAX, NULL, NULL)
-#endif
/*
*---------------------------------------------------------------------------
@@ -192,7 +181,7 @@ TclpInitPlatform(void)
void
TclpInitLibraryPath(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
#define LIBRARY_SIZE 64
@@ -234,9 +223,10 @@ TclpInitLibraryPath(
TclGetProcessGlobalValue(&sourceLibraryDir));
*encodingPtr = NULL;
- bytes = Tcl_GetStringFromObj(pathPtr, lengthPtr);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, bytes, (size_t)(*lengthPtr)+1);
+ bytes = TclGetString(pathPtr);
+ *lengthPtr = pathPtr->length;
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, bytes, *lengthPtr + 1);
Tcl_DecrRefCount(pathPtr);
}
@@ -266,7 +256,7 @@ AppendEnvironment(
{
int pathc;
WCHAR wBuf[MAX_PATH];
- char buf[MAX_PATH * TCL_UTF_MAX];
+ char buf[MAX_PATH * 3];
Tcl_Obj *objPtr;
Tcl_DString ds;
const char **pathv;
@@ -295,12 +285,8 @@ AppendEnvironment(
* this is a unicode string.
*/
- if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
- buf[0] = '\0';
- GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
- } else {
- ToUtf(wBuf, buf);
- }
+ GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH);
+ WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL);
if (buf[0] != '\0') {
objPtr = Tcl_NewStringObj(buf, -1);
@@ -354,19 +340,16 @@ AppendEnvironment(
static void
InitializeDefaultLibraryDir(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
HMODULE hModule = TclWinGetTclInstance();
WCHAR wName[MAX_PATH + LIBRARY_SIZE];
- char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+ char name[(MAX_PATH + LIBRARY_SIZE) * 3];
char *end, *p;
- if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
- GetModuleFileNameA(hModule, name, MAX_PATH);
- } else {
- ToUtf(wName, name);
- }
+ GetModuleFileNameW(hModule, wName, MAX_PATH);
+ WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
end = strrchr(name, '\\');
*end = '\0';
@@ -381,7 +364,7 @@ InitializeDefaultLibraryDir(
*lengthPtr = strlen(name);
*valuePtr = ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
- memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
+ memcpy(*valuePtr, name, *lengthPtr + 1);
}
/*
@@ -405,19 +388,16 @@ InitializeDefaultLibraryDir(
static void
InitializeSourceLibraryDir(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
HMODULE hModule = TclWinGetTclInstance();
WCHAR wName[MAX_PATH + LIBRARY_SIZE];
- char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+ char name[(MAX_PATH + LIBRARY_SIZE) * 3];
char *end, *p;
- if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
- GetModuleFileNameA(hModule, name, MAX_PATH);
- } else {
- ToUtf(wName, name);
- }
+ GetModuleFileNameW(hModule, wName, MAX_PATH);
+ WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
end = strrchr(name, '\\');
*end = '\0';
@@ -432,38 +412,8 @@ InitializeSourceLibraryDir(
*lengthPtr = strlen(name);
*valuePtr = ckalloc(*lengthPtr + 1);
*encodingPtr = NULL;
- memcpy(*valuePtr, name, (size_t) *lengthPtr + 1);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
- * ToUtf --
- *
- * Convert a wchar string to a UTF string.
- *
- * Results:
- * None.
- *
- * Side effects:
- * None.
- *
- *---------------------------------------------------------------------------
- */
-
-#if TCL_UTF_MAX < 4
-static void
-ToUtf(
- const WCHAR *wSrc,
- char *dst)
-{
- while (*wSrc != '\0') {
- dst += Tcl_UniCharToUtf(*wSrc, dst);
- wSrc++;
- }
- *dst = '\0';
+ memcpy(*valuePtr, name, *lengthPtr + 1);
}
-#endif
/*
*---------------------------------------------------------------------------
@@ -494,18 +444,11 @@ TclpSetInitialEncodings(void)
{
Tcl_DString encodingName;
- TclpSetInterfaces();
Tcl_SetSystemEncoding(NULL,
Tcl_GetEncodingNameFromEnvironment(&encodingName));
Tcl_DStringFree(&encodingName);
}
-void TclWinSetInterfaces(
- int dummy) /* Not used. */
-{
- TclpSetInterfaces();
-}
-
const char *
Tcl_GetEncodingNameFromEnvironment(
Tcl_DString *bufPtr)
@@ -590,10 +533,7 @@ TclpSetVariables(
Tcl_SetVar2(interp, "tcl_platform", "platform", "windows",
TCL_GLOBAL_ONLY);
- if (osInfo.dwPlatformId < NUMPLATFORMS) {
- Tcl_SetVar2(interp, "tcl_platform", "os",
- platforms[osInfo.dwPlatformId], TCL_GLOBAL_ONLY);
- }
+ Tcl_SetVar2(interp, "tcl_platform", "os", "Windows NT", TCL_GLOBAL_ONLY);
wsprintfA(buffer, "%d.%d", osInfo.dwMajorVersion, osInfo.dwMinorVersion);
Tcl_SetVar2(interp, "tcl_platform", "osVersion", buffer, TCL_GLOBAL_ONLY);
if (sys.oemId.wProcessorArchitecture < NUMPROCESSORS) {
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index d0844da..63835bf 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -41,25 +41,6 @@ typedef struct TclWinProcs {
MODULE_SCOPE TclWinProcs tclWinProcs;
/*
- * Some versions of Borland C have a define for the OSVERSIONINFO for
- * Win32s and for NT, but not for Windows 95.
- * Define VER_PLATFORM_WIN32_CE for those without newer headers.
- */
-
-#ifndef VER_PLATFORM_WIN32_WINDOWS
-#define VER_PLATFORM_WIN32_WINDOWS 1
-#endif
-#ifndef VER_PLATFORM_WIN32_CE
-#define VER_PLATFORM_WIN32_CE 3
-#endif
-
-#ifdef _WIN64
-# define TCL_I_MODIFIER "I"
-#else
-# define TCL_I_MODIFIER ""
-#endif
-
-/*
* Declarations of functions that are not accessible by way of the
* stubs table.
*/
@@ -82,13 +63,6 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
MODULE_SCOPE int TclWinSymLinkDelete(const TCHAR *LinkOriginal,
int linkOnly);
MODULE_SCOPE int TclWinFileOwned(Tcl_Obj *);
-#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-MODULE_SCOPE void TclWinFreeAllocCache(void);
-MODULE_SCOPE void TclFreeAllocCache(void *);
-MODULE_SCOPE Tcl_Mutex *TclpNewAllocMutex(void);
-MODULE_SCOPE void * TclpGetAllocCache(void);
-MODULE_SCOPE void TclpSetAllocCache(void *);
-#endif /* TCL_THREADS */
MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);
diff --git a/win/tclWinLoad.c b/win/tclWinLoad.c
index 2946ea2..69263e9 100644
--- a/win/tclWinLoad.c
+++ b/win/tclWinLoad.c
@@ -88,7 +88,7 @@ TclpDlopen(
Tcl_DString ds;
- /*
+ /*
* Remember the first error on load attempt to be used if the
* second load attempt below also fails.
*/
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 4543b02..b34fc4f 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -27,7 +27,7 @@
* created for each thread that is using the notifier.
*/
-typedef struct ThreadSpecificData {
+typedef struct {
CRITICAL_SECTION crit; /* Monitor for this notifier. */
DWORD thread; /* Identifier for thread associated with this
* notifier. */
@@ -36,7 +36,6 @@ typedef struct ThreadSpecificData {
int pending; /* Alert message pending, this field is locked
* by the notifierMutex. */
HWND hwnd; /* Messaging window. */
- int timeout; /* Current timeout value. */
int timerActive; /* 1 if interval timer is running. */
} ThreadSpecificData;
@@ -50,8 +49,9 @@ static Tcl_ThreadDataKey dataKey;
*/
static int notifierCount = 0;
-static const TCHAR classname[] = TEXT("TclNotifier");
-TCL_DECLARE_MUTEX(notifierMutex)
+static const TCHAR className[] = TEXT("TclNotifier");
+static int initialized = 0;
+static CRITICAL_SECTION notifierMutex;
/*
* Static routines defined in this file.
@@ -85,12 +85,19 @@ Tcl_InitNotifier(void)
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
WNDCLASS class;
+ TclpMasterLock();
+ if (!initialized) {
+ initialized = 1;
+ InitializeCriticalSection(&notifierMutex);
+ }
+ TclpMasterUnlock();
+
/*
* Register Notifier window class if this is the first thread to use
* this module.
*/
- Tcl_MutexLock(&notifierMutex);
+ EnterCriticalSection(&notifierMutex);
if (notifierCount == 0) {
class.style = 0;
class.cbClsExtra = 0;
@@ -98,7 +105,7 @@ Tcl_InitNotifier(void)
class.hInstance = TclWinGetTclInstance();
class.hbrBackground = NULL;
class.lpszMenuName = NULL;
- class.lpszClassName = classname;
+ class.lpszClassName = className;
class.lpfnWndProc = NotifierProc;
class.hIcon = NULL;
class.hCursor = NULL;
@@ -108,7 +115,7 @@ Tcl_InitNotifier(void)
}
}
notifierCount++;
- Tcl_MutexUnlock(&notifierMutex);
+ LeaveCriticalSection(&notifierMutex);
tsdPtr->pending = 0;
tsdPtr->timerActive = 0;
@@ -183,12 +190,14 @@ Tcl_FinalizeNotifier(
* notifier window class.
*/
- Tcl_MutexLock(&notifierMutex);
- notifierCount--;
- if (notifierCount == 0) {
- UnregisterClass(classname, TclWinGetTclInstance());
+ EnterCriticalSection(&notifierMutex);
+ if (notifierCount) {
+ notifierCount--;
+ if (notifierCount == 0) {
+ UnregisterClass(className, TclWinGetTclInstance());
+ }
}
- Tcl_MutexUnlock(&notifierMutex);
+ LeaveCriticalSection(&notifierMutex);
}
}
@@ -299,11 +308,10 @@ Tcl_SetTimer(
timeout = 1;
}
}
- tsdPtr->timeout = timeout;
if (timeout != 0) {
tsdPtr->timerActive = 1;
SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
- (unsigned long) tsdPtr->timeout, NULL);
+ timeout, NULL);
} else {
tsdPtr->timerActive = 0;
KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
@@ -350,7 +358,7 @@ Tcl_ServiceModeHook(
*/
if (mode == TCL_SERVICE_ALL && !tsdPtr->hwnd) {
- tsdPtr->hwnd = CreateWindow(classname, classname,
+ tsdPtr->hwnd = CreateWindow(className, className,
WS_TILED, 0, 0, 0, 0, NULL, NULL, TclWinGetTclInstance(),
NULL);
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
new file mode 100644
index 0000000..a71f506
--- /dev/null
+++ b/win/tclWinPanic.c
@@ -0,0 +1,88 @@
+/*
+ * tclWinPanic.c --
+ *
+ * Contains the Windows-specific command-line panic proc.
+ *
+ * Copyright (c) 2013 by Jan Nijtmans.
+ * All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tclInt.h"
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ConsolePanic --
+ *
+ * Display a message. If a debugger is present, present it directly to
+ * the debugger, otherwise send it to stderr.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ConsolePanic(
+ const char *format, ...)
+{
+#define TCL_MAX_WARN_LEN 26000
+ va_list argList;
+ WCHAR msgString[TCL_MAX_WARN_LEN];
+ char buf[TCL_MAX_WARN_LEN * 3];
+ HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
+ DWORD dummy;
+
+ va_start(argList, format);
+ vsnprintf(buf+3, sizeof(buf)-3, format, argList);
+ buf[sizeof(buf)-1] = 0;
+ msgString[TCL_MAX_WARN_LEN-1] = L'\0';
+ MultiByteToWideChar(CP_UTF8, 0, buf+3, -1, msgString, TCL_MAX_WARN_LEN);
+
+ /*
+ * Truncate MessageBox string if it is too long to not overflow the buffer.
+ */
+
+ if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
+ memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
+ }
+
+ if (IsDebuggerPresent()) {
+ OutputDebugStringW(msgString);
+ } else if (_isatty(2)) {
+ WriteConsoleW(handle, msgString, wcslen(msgString), &dummy, 0);
+ } else {
+ buf[0] = 0xEF; buf[1] = 0xBB; buf[2] = 0xBF; /* UTF-8 bom */
+ WriteFile(handle, buf, strlen(buf), &dummy, 0);
+ WriteFile(handle, "\n", 1, &dummy, 0);
+ FlushFileBuffers(handle);
+ }
+# if defined(__GNUC__)
+ __builtin_trap();
+# elif defined(_WIN64)
+ __debugbreak();
+# elif defined(_MSC_VER)
+ _asm {int 3}
+# else
+ DebugBreak();
+# endif
+#if defined(_WIN32)
+ ExitProcess(1);
+#else
+ abort();
+#endif
+}
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * tab-width: 8
+ * End:
+ */
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index 83bd26e..83987d6 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -869,7 +869,7 @@ TclpGetPid(
Tcl_MutexLock(&pipeMutex);
for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
- if (infoPtr->hProcess == (HANDLE) pid) {
+ if (infoPtr->dwProcessId == (DWORD) (size_t) pid) {
Tcl_MutexUnlock(&pipeMutex);
return infoPtr->dwProcessId;
}
@@ -941,7 +941,7 @@ TclpCreateProcess(
PROCESS_INFORMATION procInfo;
SECURITY_ATTRIBUTES secAtts;
HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
- char execPath[MAX_PATH * TCL_UTF_MAX];
+ char execPath[MAX_PATH * 3];
WinFile *filePtr;
PipeInit();
@@ -1095,40 +1095,23 @@ TclpCreateProcess(
* detached processes. The GUI window will still pop up to the foreground.
*/
- if (TclWinGetPlatformId() == VER_PLATFORM_WIN32_NT) {
- if (HasConsole()) {
+ if (HasConsole()) {
createFlags = 0;
- } else if (applType == APPL_DOS) {
- /*
- * Under NT, 16-bit DOS applications will not run unless they can
- * be attached to a console. If we are running without a console,
- * run the 16-bit program as an normal process inside of a hidden
- * console application, and then run that hidden console as a
- * detached process.
- */
+ } else if (applType == APPL_DOS) {
+ /*
+ * Under NT, 16-bit DOS applications will not run unless they can
+ * be attached to a console. If we are running without a console,
+ * run the 16-bit program as an normal process inside of a hidden
+ * console application, and then run that hidden console as a
+ * detached process.
+ */
- startInfo.wShowWindow = SW_HIDE;
- startInfo.dwFlags |= STARTF_USESHOWWINDOW;
- createFlags = CREATE_NEW_CONSOLE;
- TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
- } else {
- createFlags = DETACHED_PROCESS;
- }
+ startInfo.wShowWindow = SW_HIDE;
+ startInfo.dwFlags |= STARTF_USESHOWWINDOW;
+ createFlags = CREATE_NEW_CONSOLE;
+ TclDStringAppendLiteral(&cmdLine, "cmd.exe /c");
} else {
- if (HasConsole()) {
- createFlags = 0;
- } else {
- createFlags = DETACHED_PROCESS;
- }
-
- if (applType == APPL_DOS) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "DOS application process not supported on this platform",
- -1));
- Tcl_SetErrorCode(interp, "TCL", "OPERATION", "EXEC", "DOS_APP",
- NULL);
- goto end;
- }
+ createFlags = DETACHED_PROCESS;
}
/*
@@ -1180,7 +1163,7 @@ TclpCreateProcess(
WaitForInputIdle(procInfo.hProcess, 5000);
CloseHandle(procInfo.hThread);
- *pidPtr = (Tcl_Pid) procInfo.hProcess;
+ *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId;
if (*pidPtr != 0) {
TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
}
@@ -1749,7 +1732,7 @@ TclpCreateCommandChannel(
* unique, in case channels share handles (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&pipeChannelType, channelName,
infoPtr, infoPtr->validMask);
@@ -2490,7 +2473,7 @@ Tcl_WaitPid(
prevPtrPtr = &procList;
for (infoPtr = procList; infoPtr != NULL;
prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
- if (infoPtr->hProcess == (HANDLE) pid) {
+ if (infoPtr->dwProcessId == (DWORD) (size_t) pid) {
*prevPtrPtr = infoPtr->nextPtr;
break;
}
@@ -3518,11 +3501,11 @@ TclPipeThreadStop(
SetEvent(pipeTI->evWakeUp);
}
CloseHandle(pipeTI->evControl);
- #ifndef _PTI_USE_CKALLOC
+# ifndef _PTI_USE_CKALLOC
free(pipeTI);
- #else
+# else
ckfree(pipeTI);
- #endif
+# endif
}
}
@@ -3566,13 +3549,13 @@ TclPipeThreadExit(
if (pipeTI->evWakeUp) {
SetEvent(pipeTI->evWakeUp);
}
- #ifndef _PTI_USE_CKALLOC
+# ifndef _PTI_USE_CKALLOC
free(pipeTI);
- #else
+# else
ckfree(pipeTI);
/* be sure all subsystems used are finalized */
Tcl_FinalizeThread();
- #endif
+# endif
}
}
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index 29b1447..21344ec 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -551,7 +551,7 @@ typedef DWORD_PTR * PDWORD_PTR;
* address platform-specific issues.
*/
-#define TclpReleaseFile(file) ckfree((char *) file)
+#define TclpReleaseFile(file) ckfree(file)
/*
* The following macros and declarations wrap the C runtime library
diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c
index fe416ff..8ee426b 100644
--- a/win/tclWinSerial.c
+++ b/win/tclWinSerial.c
@@ -115,7 +115,7 @@ typedef struct SerialInfo {
* [fconfigure -queue] */
} SerialInfo;
-typedef struct ThreadSpecificData {
+typedef struct {
/*
* The following pointer refers to the head of the list of serials that
* are being watched for file events.
@@ -131,7 +131,7 @@ static Tcl_ThreadDataKey dataKey;
* events are generated.
*/
-typedef struct SerialEvent {
+typedef struct {
Tcl_Event header; /* Information that is standard for all
* events. */
SerialInfo *infoPtr; /* Pointer to serial info structure. Note that
@@ -1024,7 +1024,7 @@ SerialOutputProc(
infoPtr->writeBufLen = toWrite;
infoPtr->writeBuf = ckalloc(toWrite);
}
- memcpy(infoPtr->writeBuf, buf, (size_t) toWrite);
+ memcpy(infoPtr->writeBuf, buf, toWrite);
infoPtr->toWrite = toWrite;
ResetEvent(infoPtr->evWritable);
TclPipeThreadSignal(&infoPtr->writeTI);
@@ -1442,7 +1442,7 @@ TclWinOpenSerialChannel(
* are shared between multiple channels (stdin/stdout).
*/
- sprintf(channelName, "file%" TCL_I_MODIFIER "x", (size_t) infoPtr);
+ sprintf(channelName, "file%" TCL_Z_MODIFIER "x", (size_t) infoPtr);
infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName,
infoPtr, permissions);
@@ -1738,7 +1738,7 @@ SerialSetOptionProc(
dcb.XonChar = argv[0][0];
dcb.XoffChar = argv[1][0];
if (argv[0][0] & 0x80 || argv[1][0] & 0x80) {
- Tcl_UniChar character;
+ Tcl_UniChar character = 0;
int charLen;
charLen = Tcl_UtfToUniChar(argv[0], &character);
@@ -1849,7 +1849,7 @@ SerialSetOptionProc(
* -sysbuffer 4096 or -sysbuffer {64536 4096}
*/
- size_t inSize = (size_t) -1, outSize = (size_t) -1;
+ int inSize = -1, outSize = -1;
if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
return TCL_ERROR;
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index e2479e81..f872163 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -62,15 +62,6 @@
#undef TCL_FEATURE_KEEPALIVE_NAGLE
/*
- * Make sure to remove the redirection defines set in tclWinPort.h that is in
- * use in other sections of the core, except for us.
- */
-
-#undef getservbyname
-#undef getsockopt
-#undef setsockopt
-
-/*
* Helper macros to make parts of this file clearer. The macros do exactly
* what they say on the tin. :-) They also only ever refer to their arguments
* once, and so can be used without regard to side effects.
@@ -78,6 +69,7 @@
#define SET_BITS(var, bits) ((var) |= (bits))
#define CLEAR_BITS(var, bits) ((var) &= ~(bits))
+#define GOT_BITS(var, bits) (((var) & (bits)) != 0)
/* "sock" + a pointer in hex + \0 */
#define SOCK_CHAN_LENGTH (4 + sizeof(void *) * 2 + 1)
@@ -90,7 +82,7 @@
*/
static int initialized = 0;
-static const TCHAR classname[] = TEXT("TclSocket");
+static const TCHAR className[] = TEXT("TclSocket");
TCL_DECLARE_MUTEX(socketMutex)
/*
@@ -133,6 +125,8 @@ typedef struct TcpFdList {
struct TcpState {
Tcl_Channel channel; /* Channel associated with this socket. */
+ int testFlags; /* bit field for tests. Is set by testsocket
+ * test procedure */
struct TcpFdList *sockets; /* Windows SOCKET handle. */
int flags; /* Bit field comprised of the flags described
* below. */
@@ -193,6 +187,15 @@ struct TcpState {
#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */
/*
+ * These bits may be ORed together into the "testFlags" field of a TcpState
+ * structure.
+ */
+
+#define TCP_ASYNC_TEST_MODE (1<<0) /* Async testing activated. Do not
+ * automatically continue connection
+ * process */
+
+/*
* The following structure is what is added to the Tcl event queue when a
* socket event occurs.
*/
@@ -301,22 +304,39 @@ static const Tcl_ChannelType tcpChannelType = {
static TclInitProcessGlobalValueProc InitializeHostName;
static ProcessGlobalValue hostName =
{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
+
+/*
+ * Simple wrapper round the SendMessage syscall.
+ */
+
+#define SendSelectMessage(tsdPtr, message, payload) \
+ SendMessage((tsdPtr)->hwnd, SOCKET_SELECT, \
+ (WPARAM) (message), (LPARAM) (payload))
+
/*
* Address print debug functions
*/
#if 0
-void printaddrinfo(struct addrinfo *ai, char *prefix)
+void
+printaddrinfo(
+ struct addrinfo *ai,
+ char *prefix)
{
char host[NI_MAXHOST], port[NI_MAXSERV];
+
getnameinfo(ai->ai_addr, ai->ai_addrlen,
- host, sizeof(host),
- port, sizeof(port),
- NI_NUMERICHOST|NI_NUMERICSERV);
+ host, sizeof(host), port, sizeof(port),
+ NI_NUMERICHOST|NI_NUMERICSERV);
}
-void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
+
+void
+printaddrinfolist(
+ struct addrinfo *addrlist,
+ char *prefix)
{
struct addrinfo *ai;
+
for (ai = addrlist; ai != NULL; ai = ai->ai_next) {
printaddrinfo(ai, prefix);
}
@@ -340,7 +360,7 @@ void printaddrinfolist(struct addrinfo *addrlist, char *prefix)
void
InitializeHostName(
char **valuePtr,
- int *lengthPtr,
+ unsigned int *lengthPtr,
Tcl_Encoding *encodingPtr)
{
TCHAR tbuf[MAX_COMPUTERNAME_LENGTH + 1];
@@ -377,8 +397,8 @@ InitializeHostName(
*encodingPtr = Tcl_GetEncoding(NULL, "utf-8");
*lengthPtr = Tcl_DStringLength(&ds);
- *valuePtr = ckalloc((*lengthPtr) + 1);
- memcpy(*valuePtr, Tcl_DStringValue(&ds), (size_t)(*lengthPtr)+1);
+ *valuePtr = ckalloc(*lengthPtr + 1);
+ memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1);
Tcl_DStringFree(&ds);
}
@@ -533,9 +553,9 @@ TcpBlockModeProc(
TcpState *statePtr = instanceData;
if (mode == TCL_MODE_NONBLOCKING) {
- statePtr->flags |= TCP_NONBLOCKING;
+ SET_BITS(statePtr->flags, TCP_NONBLOCKING);
} else {
- statePtr->flags &= ~(TCP_NONBLOCKING);
+ CLEAR_BITS(statePtr->flags, TCP_NONBLOCKING);
}
return 0;
}
@@ -545,29 +565,28 @@ TcpBlockModeProc(
*
* WaitForConnect --
*
- * Check the state of an async connect process. If a connection
- * attempt terminated, process it, which may finalize it or may
- * start the next attempt. If a connect error occures, it is saved
- * in statePtr->connectError to be reported by 'fconfigure -error'.
+ * Check the state of an async connect process. If a connection attempt
+ * terminated, process it, which may finalize it or may start the next
+ * attempt. If a connect error occures, it is saved in
+ * statePtr->connectError to be reported by 'fconfigure -error'.
*
* There are two modes of operation, defined by errorCodePtr:
- * * non-NULL: Called by explicite read/write command. block if
- * socket is blocking.
+ * * non-NULL: Called by explicite read/write command. Block if socket
+ * is blocking.
* May return two error codes:
* * EWOULDBLOCK: if connect is still in progress
- * * ENOTCONN: if connect failed. This would be the error
- * message of a rect or sendto syscall so this is
- * emulated here.
- * * Null: Called by a backround operation. Do not block and
- * don't return any error code.
+ * * ENOTCONN: if connect failed. This would be the error message
+ * of a rect or sendto syscall so this is emulated here.
+ * * Null: Called by a backround operation. Do not block and don't
+ * return any error code.
*
* Results:
- * 0 if the connection has completed, -1 if still in progress
- * or there is an error.
+ * 0 if the connection has completed, -1 if still in progress or there is
+ * an error.
*
* Side effects:
- * Processes socket events off the system queue.
- * May process asynchroneous connect.
+ * Processes socket events off the system queue. May process
+ * asynchroneous connect.
*
*----------------------------------------------------------------------
*/
@@ -575,20 +594,19 @@ TcpBlockModeProc(
static int
WaitForConnect(
TcpState *statePtr, /* State of the socket. */
- int *errorCodePtr) /* Where to store errors?
- * A passed null-pointer activates background mode.
- */
+ int *errorCodePtr) /* Where to store errors? A passed
+ * null-pointer activates background mode. */
{
int result;
int oldMode;
ThreadSpecificData *tsdPtr;
/*
- * Check if an async connect failed already and error reporting is demanded,
- * return the error ENOTCONN
+ * Check if an async connect failed already and error reporting is
+ * demanded, return the error ENOTCONN.
*/
- if (errorCodePtr != NULL && (statePtr->flags & TCP_ASYNC_FAILED)) {
+ if (errorCodePtr != NULL && GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
*errorCodePtr = ENOTCONN;
return -1;
}
@@ -597,11 +615,26 @@ WaitForConnect(
* Check if an async connect is running. If not return ok
*/
- if (!(statePtr->flags & TCP_ASYNC_CONNECT)) {
+ if (!GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT)) {
return 0;
}
/*
+ * In socket test mode do not continue with the connect
+ * Exceptions are:
+ * - Call by recv/send and blocking socket
+ * (errorCodePtr != NULL && !GOT_BITS(flags, TCP_NONBLOCKING))
+ * - Call by the event queue (errorCodePtr == NULL)
+ */
+
+ if (GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)
+ && errorCodePtr != NULL
+ && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
+ *errorCodePtr = EWOULDBLOCK;
+ return -1;
+ }
+
+ /*
* Be sure to disable event servicing so we are truly modal.
*/
@@ -612,36 +645,51 @@ WaitForConnect(
*/
while (1) {
+ /*
+ * Get the statePtr lock.
+ */
- /* get statePtr lock */
tsdPtr = TclThreadDataKeyGet(&dataKey);
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Check for connect event */
- if (statePtr->readyEvents & FD_CONNECT) {
+ /*
+ * Check for connect event.
+ */
- /* Consume the connect event */
- statePtr->readyEvents &= ~(FD_CONNECT);
+ if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
+ /*
+ * Consume the connect event.
+ */
+
+ CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);
/*
- * For blocking sockets and foreground processing
- * disable async connect as we continue now synchoneously
+ * For blocking sockets and foreground processing, disable async
+ * connect as we continue now synchoneously.
*/
- if ( errorCodePtr != NULL &&
- ! (statePtr->flags & TCP_NONBLOCKING) ) {
+
+ if (errorCodePtr != NULL &&
+ !GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
}
- /* Free list lock */
+ /*
+ * Free list lock.
+ */
+
SetEvent(tsdPtr->socketListLock);
/*
- * Continue connect.
- * If switched to synchroneous connect, the connect is terminated.
+ * Continue connect. If switched to synchroneous connect, the
+ * connect is terminated.
*/
+
result = TcpConnect(NULL, statePtr);
- /* Restore event service mode */
+ /*
+ * Restore event service mode.
+ */
+
(void) Tcl_SetServiceMode(oldMode);
/*
@@ -650,10 +698,11 @@ WaitForConnect(
if (result == TCL_OK) {
/*
- * Check for async connect restart
- * (not possible for foreground blocking operation)
+ * Check for async connect restart (not possible for
+ * foreground blocking operation)
*/
- if ( statePtr->flags & TCP_ASYNC_PENDING ) {
+
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
if (errorCodePtr != NULL) {
*errorCodePtr = EWOULDBLOCK;
}
@@ -663,8 +712,8 @@ WaitForConnect(
}
/*
- * Connect finally failed.
- * For foreground operation return ENOTCONN.
+ * Connect finally failed. For foreground operation return
+ * ENOTCONN.
*/
if (errorCodePtr != NULL) {
@@ -673,7 +722,10 @@ WaitForConnect(
return -1;
}
- /* Free list lock */
+ /*
+ * Free list lock.
+ */
+
SetEvent(tsdPtr->socketListLock);
/*
@@ -681,7 +733,7 @@ WaitForConnect(
* event
*/
- if ( errorCodePtr == NULL ) {
+ if (errorCodePtr == NULL) {
return -1;
}
@@ -690,7 +742,7 @@ WaitForConnect(
* returns directly the error EWOULDBLOCK
*/
- if (statePtr->flags & TCP_NONBLOCKING) {
+ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
*errorCodePtr = EWOULDBLOCK;
return -1;
}
@@ -754,7 +806,7 @@ TcpInputProc(
* socket stack after the first time EOF is detected.
*/
- if (statePtr->flags & SOCKET_EOF) {
+ if (GOT_BITS(statePtr->flags, SOCKET_EOF)) {
return 0;
}
@@ -777,18 +829,22 @@ TcpInputProc(
*/
while (1) {
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
- /* single fd operation: this proc is only called for a connected socket. */
+ SendSelectMessage(tsdPtr, UNSELECT, statePtr);
+
+ /*
+ * Single fd operation: this proc is only called for a connected
+ * socket.
+ */
+
bytesRead = recv(statePtr->sockets->fd, buf, bufSize, 0);
- statePtr->readyEvents &= ~(FD_READ);
+ CLEAR_BITS(statePtr->readyEvents, FD_READ);
/*
* Check for end-of-file condition or successful read.
*/
if (bytesRead == 0) {
- statePtr->flags |= SOCKET_EOF;
+ SET_BITS(statePtr->flags, SOCKET_EOF);
}
if (bytesRead != SOCKET_ERROR) {
break;
@@ -799,8 +855,8 @@ TcpInputProc(
* error and report an EOF.
*/
- if (statePtr->readyEvents & FD_CLOSE) {
- statePtr->flags |= SOCKET_EOF;
+ if (GOT_BITS(statePtr->readyEvents, FD_CLOSE)) {
+ SET_BITS(statePtr->flags, SOCKET_EOF);
bytesRead = 0;
break;
}
@@ -813,7 +869,7 @@ TcpInputProc(
*/
if (error == WSAECONNRESET) {
- statePtr->flags |= SOCKET_EOF;
+ SET_BITS(statePtr->flags, SOCKET_EOF);
bytesRead = 0;
break;
}
@@ -822,7 +878,8 @@ TcpInputProc(
* Check for error condition or underflow in non-blocking case.
*/
- if ((statePtr->flags & TCP_NONBLOCKING) || (error != WSAEWOULDBLOCK)) {
+ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)
+ || (error != WSAEWOULDBLOCK)) {
TclWinConvertError(error);
*errorCodePtr = Tcl_GetErrno();
bytesRead = -1;
@@ -840,7 +897,7 @@ TcpInputProc(
}
}
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
return bytesRead;
}
@@ -898,10 +955,13 @@ TcpOutputProc(
}
while (1) {
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
+ SendSelectMessage(tsdPtr, UNSELECT, statePtr);
+
+ /*
+ * Single fd operation: this proc is only called for a connected
+ * socket.
+ */
- /* single fd operation: this proc is only called for a connected socket. */
written = send(statePtr->sockets->fd, buf, toWrite, 0);
if (written != SOCKET_ERROR) {
/*
@@ -910,8 +970,9 @@ TcpOutputProc(
* until the condition changes.
*/
- if (statePtr->watchEvents & FD_WRITE) {
+ if (GOT_BITS(statePtr->watchEvents, FD_WRITE)) {
Tcl_Time blockTime = { 0, 0 };
+
Tcl_SetMaxBlockTime(&blockTime);
}
break;
@@ -926,8 +987,8 @@ TcpOutputProc(
error = WSAGetLastError();
if (error == WSAEWOULDBLOCK) {
- statePtr->readyEvents &= ~(FD_WRITE);
- if (statePtr->flags & TCP_NONBLOCKING) {
+ CLEAR_BITS(statePtr->readyEvents, FD_WRITE);
+ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
*errorCodePtr = EWOULDBLOCK;
written = -1;
break;
@@ -950,7 +1011,7 @@ TcpOutputProc(
}
}
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
return written;
}
@@ -997,10 +1058,10 @@ TcpCloseProc(
* background.
*/
- while ( statePtr->sockets != NULL ) {
+ while (statePtr->sockets != NULL) {
TcpFdList *thisfd = statePtr->sockets;
- statePtr->sockets = thisfd->next;
+ statePtr->sockets = thisfd->next;
if (closesocket(thisfd->fd) == SOCKET_ERROR) {
TclWinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
@@ -1018,18 +1079,25 @@ TcpCloseProc(
/*
* Clear an eventual tsd info list pointer.
+ *
* This may be called, if an async socket connect fails or is closed
* between connect and thread action callback.
*/
+
if (tsdPtr->pendingTcpState != NULL
&& tsdPtr->pendingTcpState == statePtr) {
+ /*
+ * Get infoPtr lock, because this concerns the notifier thread.
+ */
- /* get infoPtr lock, because this concerns the notifier thread */
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
tsdPtr->pendingTcpState = NULL;
- /* Free list lock */
+ /*
+ * Free list lock.
+ */
+
SetEvent(tsdPtr->socketListLock);
}
@@ -1090,8 +1158,11 @@ TcpClose2Proc(
return TCL_ERROR;
}
- /* single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
- * TCL_WRITABLE so this should never be called for a server socket. */
+ /*
+ * Single fd operation: Tcl_OpenTcpServer() does not set TCL_READABLE or
+ * TCL_WRITABLE so this should never be called for a server socket.
+ */
+
if (shutdown(statePtr->sockets->fd, sd) == SOCKET_ERROR) {
TclWinConvertError((DWORD) WSAGetLastError());
errorCode = Tcl_GetErrno();
@@ -1143,7 +1214,7 @@ TcpSetOptionProc(
}
#ifdef TCL_FEATURE_KEEPALIVE_NAGLE
- #error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
+#error "TCL_FEATURE_KEEPALIVE_NAGLE not reviewed for whether to treat statePtr->sockets as single fd or list"
sock = statePtr->sockets->fd;
if (!strcasecmp(optionName, "-keepalive")) {
@@ -1252,9 +1323,14 @@ TcpGetOptionProc(
/*
* Go one step in async connect
- * If any error is thrown save it as backround error to report eventually below
+ *
+ * If any error is thrown save it as backround error to report eventually
+ * below.
*/
- WaitForConnect(statePtr, NULL);
+
+ if (!GOT_BITS(statePtr->testFlags, TCP_ASYNC_TEST_MODE)) {
+ WaitForConnect(statePtr, NULL);
+ }
sock = statePtr->sockets->fd;
if (optionName != NULL) {
@@ -1263,31 +1339,26 @@ TcpGetOptionProc(
if ((len > 1) && (optionName[1] == 'e') &&
(strncmp(optionName, "-error", len) == 0)) {
-
/*
- * Do not return any errors if async connect is running
- */
- if ( ! (statePtr->flags & TCP_ASYNC_PENDING) ) {
-
-
- if ( statePtr->flags & TCP_ASYNC_FAILED ) {
+ * Do not return any errors if async connect is running.
+ */
+ if (!GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
/*
* In case of a failed async connect, eventually report the
- * connect error only once.
- * Do not report the system error, as this comes again and again.
+ * connect error only once. Do not report the system error,
+ * as this comes again and again.
*/
- if ( statePtr->connectError != 0 ) {
+ if (statePtr->connectError != 0) {
Tcl_DStringAppend(dsPtr,
Tcl_ErrnoMsg(statePtr->connectError), -1);
statePtr->connectError = 0;
}
-
} else {
-
/*
- * Report an eventual last error of the socket system
+ * Report an eventual last error of the socket system.
*/
int optlen;
@@ -1295,24 +1366,30 @@ TcpGetOptionProc(
DWORD err;
/*
- * Populater the err Variable with a possix error
+ * Populate the err variable with a POSIX error
*/
+
optlen = sizeof(int);
ret = getsockopt(sock, SOL_SOCKET, SO_ERROR,
(char *)&err, &optlen);
+
/*
- * The error was not returned directly but should be
- * taken from WSA
+ * The error was not returned directly but should be taken
+ * from WSA.
*/
+
if (ret == SOCKET_ERROR) {
err = WSAGetLastError();
}
+
/*
- * Return error message
+ * Return error message.
*/
+
if (err) {
TclWinConvertError(err);
- Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
+ Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()),
+ -1);
}
}
}
@@ -1321,14 +1398,14 @@ TcpGetOptionProc(
if ((len > 1) && (optionName[1] == 'c') &&
(strncmp(optionName, "-connecting", len) == 0)) {
-
Tcl_DStringAppend(dsPtr,
- (statePtr->flags & TCP_ASYNC_PENDING)
+ GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)
? "1" : "0", -1);
return TCL_OK;
}
- if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
+ if (interp != NULL
+ && Tcl_GetVar2(interp, SUPPRESS_RDNS_VAR, NULL, 0) != NULL) {
reverseDNS = NI_NUMERICHOST;
}
@@ -1337,20 +1414,23 @@ TcpGetOptionProc(
address peername;
socklen_t size = sizeof(peername);
- if ( (statePtr->flags & TCP_ASYNC_PENDING) ) {
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
/*
* In async connect output an empty string
*/
+
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringAppendElement(dsPtr, "");
} else {
return TCL_OK;
}
- } else if ( getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
+ } else if (getpeername(sock, (LPSOCKADDR) &(peername.sa),
+ &size) == 0) {
/*
* Peername fetch succeeded - output list
*/
+
if (len == 0) {
Tcl_DStringAppendElement(dsPtr, "-peername");
Tcl_DStringStartSublist(dsPtr);
@@ -1399,11 +1479,12 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, "-sockname");
Tcl_DStringStartSublist(dsPtr);
}
- if ( (statePtr->flags & TCP_ASYNC_PENDING ) ) {
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
/*
* In async connect output an empty string
*/
- found = 1;
+
+ found = 1;
} else {
for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
sock = fds->fd;
@@ -1417,9 +1498,11 @@ TcpGetOptionProc(
Tcl_DStringAppendElement(dsPtr, host);
/*
- * We don't want to resolve INADDR_ANY and sin6addr_any; they
- * can sometimes cause problems (and never have a name).
+ * We don't want to resolve INADDR_ANY and sin6addr_any;
+ * they can sometimes cause problems (and never have a
+ * name).
*/
+
flags |= NI_NUMERICSERV;
if (sockname.sa.sa_family == AF_INET) {
if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
@@ -1503,7 +1586,8 @@ TcpGetOptionProc(
return Tcl_BadChannelOption(interp, optionName,
"connecting peername sockname keepalive nagle");
#else
- return Tcl_BadChannelOption(interp, optionName, "connecting peername sockname");
+ return Tcl_BadChannelOption(interp, optionName,
+ "connecting peername sockname");
#endif /*TCL_FEATURE_KEEPALIVE_NAGLE*/
}
@@ -1544,11 +1628,11 @@ TcpWatchProc(
if (!statePtr->acceptProc) {
statePtr->watchEvents = 0;
- if (mask & TCL_READABLE) {
- statePtr->watchEvents |= (FD_READ|FD_CLOSE);
+ if (GOT_BITS(mask, TCL_READABLE)) {
+ SET_BITS(statePtr->watchEvents, FD_READ | FD_CLOSE);
}
- if (mask & TCL_WRITABLE) {
- statePtr->watchEvents |= (FD_WRITE|FD_CLOSE);
+ if (GOT_BITS(mask, TCL_WRITABLE)) {
+ SET_BITS(statePtr->watchEvents, FD_WRITE | FD_CLOSE);
}
/*
@@ -1639,13 +1723,13 @@ TcpConnect(
TcpState *statePtr)
{
DWORD error;
- /*
- * We are started with async connect and the connect notification
- * was not jet received
- */
- int async_connect = statePtr->flags & TCP_ASYNC_CONNECT;
- /* We were called by the event procedure and continue our loop */
- int async_callback = statePtr->flags & TCP_ASYNC_PENDING;
+ int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
+ /* We are started with async connect and the
+ * connect notification was not yet
+ * received. */
+ int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING);
+ /* We were called by the event procedure and
+ * continue our loop. */
ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
if (async_callback) {
@@ -1653,11 +1737,10 @@ TcpConnect(
}
for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL;
- statePtr->addr = statePtr->addr->ai_next) {
-
- for (statePtr->myaddr = statePtr->myaddrlist; statePtr->myaddr != NULL;
- statePtr->myaddr = statePtr->myaddr->ai_next) {
-
+ statePtr->addr = statePtr->addr->ai_next) {
+ for (statePtr->myaddr = statePtr->myaddrlist;
+ statePtr->myaddr != NULL;
+ statePtr->myaddr = statePtr->myaddr->ai_next) {
/*
* No need to try combinations of local and remote addresses
* of different families.
@@ -1671,25 +1754,37 @@ TcpConnect(
* Close the socket if it is still open from the last unsuccessful
* iteration.
*/
+
if (statePtr->sockets->fd != INVALID_SOCKET) {
closesocket(statePtr->sockets->fd);
}
- /* get statePtr lock */
+ /*
+ * Get statePtr lock.
+ */
+
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
/*
* Reset last error from last try
*/
+
statePtr->notifierConnectError = 0;
Tcl_SetErrno(0);
- statePtr->sockets->fd = socket(statePtr->myaddr->ai_family, SOCK_STREAM, 0);
+ statePtr->sockets->fd = socket(statePtr->myaddr->ai_family,
+ SOCK_STREAM, 0);
+
+ /*
+ * Free list lock.
+ */
- /* Free list lock */
SetEvent(tsdPtr->socketListLock);
- /* continue on socket creation error */
+ /*
+ * Continue on socket creation error.
+ */
+
if (statePtr->sockets->fd == INVALID_SOCKET) {
TclWinConvertError((DWORD) WSAGetLastError());
continue;
@@ -1700,31 +1795,39 @@ TcpConnect(
* processes by default. Turn off the inherit bit.
*/
- SetHandleInformation((HANDLE) statePtr->sockets->fd, HANDLE_FLAG_INHERIT, 0);
+ SetHandleInformation((HANDLE) statePtr->sockets->fd,
+ HANDLE_FLAG_INHERIT, 0);
/*
* Set kernel space buffering
*/
- TclSockMinimumBuffers((void *) statePtr->sockets->fd, TCP_BUFFER_SIZE);
+ TclSockMinimumBuffers((void *) statePtr->sockets->fd,
+ TCP_BUFFER_SIZE);
/*
* Try to bind to a local port.
*/
if (bind(statePtr->sockets->fd, statePtr->myaddr->ai_addr,
- statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
+ statePtr->myaddr->ai_addrlen) == SOCKET_ERROR) {
TclWinConvertError((DWORD) WSAGetLastError());
continue;
}
+
/*
* For asynchroneous connect set the socket in nonblocking mode
* and activate connect notification
*/
+
if (async_connect) {
TcpState *statePtr2;
int in_socket_list = 0;
- /* get statePtr lock */
+
+ /*
+ * Get statePtr lock.
+ */
+
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
/*
@@ -1734,8 +1837,8 @@ TcpConnect(
* It is set after this call by TcpThreadActionProc and is set
* on a second round.
*
- * If not, we buffer my statePtr in the tsd memory so it is not
- * lost by the event procedure
+ * If not, we buffer my statePtr in the tsd memory so it is
+ * not lost by the event procedure
*/
for (statePtr2 = tsdPtr->socketList; statePtr2 != NULL;
@@ -1748,21 +1851,27 @@ TcpConnect(
if (!in_socket_list) {
tsdPtr->pendingTcpState = statePtr;
}
+
/*
* Set connect mask to connect events
- * This is activated by a SOCKET_SELECT message to the notifier
- * thread.
+ *
+ * This is activated by a SOCKET_SELECT message to the
+ * notifier thread.
*/
- statePtr->selectEvents |= FD_CONNECT;
+
+ SET_BITS(statePtr->selectEvents, FD_CONNECT);
/*
- * Free list lock
+ * Free list lock.
*/
+
SetEvent(tsdPtr->socketListLock);
- /* activate accept notification */
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
+ /*
+ * Activate accept notification.
+ */
+
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
}
/*
@@ -1778,12 +1887,11 @@ TcpConnect(
if (async_connect && error == WSAEWOULDBLOCK) {
/*
* Asynchroneous connect
- */
-
- /*
+ *
* Remember that we jump back behind this next round
*/
- statePtr->flags |= TCP_ASYNC_PENDING;
+
+ SET_BITS(statePtr->flags, TCP_ASYNC_PENDING);
return TCL_OK;
reenter:
@@ -1793,14 +1901,31 @@ TcpConnect(
*
* Clear the reenter flag
*/
- statePtr->flags &= ~(TCP_ASYNC_PENDING);
- /* get statePtr lock */
+
+ CLEAR_BITS(statePtr->flags, TCP_ASYNC_PENDING);
+
+ /*
+ * Get statePtr lock.
+ */
+
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Get signaled connect error */
+
+ /*
+ * Get signaled connect error.
+ */
+
TclWinConvertError((DWORD) statePtr->notifierConnectError);
- /* Clear eventual connect flag */
- statePtr->selectEvents &= ~(FD_CONNECT);
- /* Free list lock */
+
+ /*
+ * Clear eventual connect flag.
+ */
+
+ CLEAR_BITS(statePtr->selectEvents, FD_CONNECT);
+
+ /*
+ * Free list lock.
+ */
+
SetEvent(tsdPtr->socketListLock);
}
@@ -1808,6 +1933,7 @@ TcpConnect(
* Clear the tsd socket list pointer if we did not wait for
* the FD_CONNECT asynchroneously
*/
+
tsdPtr->pendingTcpState = NULL;
if (Tcl_GetErrno() == 0) {
@@ -1816,7 +1942,7 @@ TcpConnect(
}
}
-out:
+ out:
/*
* Socket connected or connection failed
*/
@@ -1827,13 +1953,13 @@ out:
CLEAR_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
- if ( Tcl_GetErrno() == 0 ) {
+ if (Tcl_GetErrno() == 0) {
/*
* Succesfully connected
- */
- /*
+ *
* Set up the select mask for read/write events.
*/
+
statePtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
/*
@@ -1841,35 +1967,56 @@ out:
* automatically places the socket into non-blocking mode.
*/
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
} else {
/*
* Connect failed
- */
-
- /*
+ *
* For async connect schedule a writable event to report the fail.
*/
+
if (async_callback) {
/*
* Set up the select mask for read/write events.
*/
+
statePtr->selectEvents = FD_WRITE|FD_READ;
- /* get statePtr lock */
+
+ /*
+ * Get statePtr lock.
+ */
+
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Signal ready readable and writable events */
- statePtr->readyEvents |= FD_WRITE | FD_READ;
- /* Flag error to event routine */
- statePtr->flags |= TCP_ASYNC_FAILED;
- /* Save connect error to be reported by 'fconfigure -error' */
+
+ /*
+ * Signal ready readable and writable events.
+ */
+
+ SET_BITS(statePtr->readyEvents, FD_WRITE | FD_READ);
+
+ /*
+ * Flag error to event routine.
+ */
+
+ SET_BITS(statePtr->flags, TCP_ASYNC_FAILED);
+
+ /*
+ * Save connect error to be reported by 'fconfigure -error'.
+ */
+
statePtr->connectError = Tcl_GetErrno();
- /* Free list lock */
+
+ /*
+ * Free list lock.
+ */
+
SetEvent(tsdPtr->socketListLock);
}
+
/*
* Error message on synchroneous connect
*/
+
if (interp != NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"couldn't open socket: %s", Tcl_PosixError(interp)));
@@ -1947,7 +2094,7 @@ Tcl_OpenTcpClient(
statePtr->addrlist = addrlist;
statePtr->myaddrlist = myaddrlist;
if (async) {
- statePtr->flags |= TCP_ASYNC_CONNECT;
+ SET_BITS(statePtr->flags, TCP_ASYNC_CONNECT);
}
/*
@@ -2017,7 +2164,7 @@ Tcl_MakeTcpClientChannel(
*/
statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)statePtr);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
sprintf(channelName, SOCK_TEMPLATE, statePtr);
statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
@@ -2029,7 +2176,7 @@ Tcl_MakeTcpClientChannel(
/*
*----------------------------------------------------------------------
*
- * Tcl_OpenTcpServer --
+ * Tcl_OpenTcpServerEx --
*
* Opens a TCP server socket and creates a channel around it.
*
@@ -2044,10 +2191,11 @@ Tcl_MakeTcpClientChannel(
*/
Tcl_Channel
-Tcl_OpenTcpServer(
+Tcl_OpenTcpServerEx(
Tcl_Interp *interp, /* For error reporting - may be NULL. */
- int port, /* Port number to open. */
+ const char *service, /* Port number to open. */
const char *myHost, /* Name of local host. */
+ unsigned int flags, /* Flags. */
Tcl_TcpAcceptProc *acceptProc,
/* Callback for accepting connections from new
* clients. */
@@ -2061,6 +2209,7 @@ Tcl_OpenTcpServer(
char channelName[SOCK_CHAN_LENGTH];
u_long flag = 1; /* Indicates nonblocking mode. */
const char *errorMsg = NULL;
+ int optvalue, port;
if (TclpHasSockets(interp) != TCL_OK) {
return NULL;
@@ -2080,7 +2229,13 @@ Tcl_OpenTcpServer(
* Construct the addresses for each end of the socket.
*/
- if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
+ if (TclSockGetPort(interp, service, "tcp", &port) != TCL_OK) {
+ errorMsg = "invalid port number";
+ goto error;
+ }
+
+ if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1,
+ &errorMsg)) {
goto error;
}
@@ -2119,17 +2274,26 @@ Tcl_OpenTcpServer(
}
/*
- * Bind to the specified port. Note that we must not call
- * setsockopt with SO_REUSEADDR because Microsoft allows addresses
- * to be reused even if they are still in use.
+ * The SO_REUSEADDR option on Windows behaves like SO_REUSEPORT on
+ * unix systems.
+ */
+
+ if (GOT_BITS(flags, TCL_TCPSERVER_REUSEPORT)) {
+ optvalue = 1;
+ (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
+ (char *) &optvalue, sizeof(optvalue));
+ }
+
+ /*
+ * Bind to the specified port.
*
* Bind should not be affected by the socket having already been
* set into nonblocking mode. If there is trouble, this is one
* place to look for bugs.
*/
- if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
- == SOCKET_ERROR) {
+ if (bind(sock, addrPtr->ai_addr,
+ addrPtr->ai_addrlen) == SOCKET_ERROR) {
TclWinConvertError((DWORD) WSAGetLastError());
closesocket(sock);
continue;
@@ -2164,13 +2328,14 @@ Tcl_OpenTcpServer(
/*
* Add this socket to the global list of sockets.
*/
+
statePtr = NewSocketInfo(sock);
} else {
- AddSocketInfoFd( statePtr, sock );
+ AddSocketInfoFd(statePtr, sock);
}
}
-error:
+ error:
if (addrlist != NULL) {
freeaddrinfo(addrlist);
}
@@ -2195,8 +2360,7 @@ error:
*/
ioctlsocket(sock, (long) FIONBIO, &flag);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
if (Tcl_SetChannelOption(interp, statePtr->channel, "-eofchar", "")
== TCL_ERROR) {
Tcl_Close(NULL, statePtr->channel);
@@ -2265,8 +2429,7 @@ TcpAccept(
*/
newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) newInfoPtr);
+ SendSelectMessage(tsdPtr, SELECT, newInfoPtr);
sprintf(channelName, SOCK_TEMPLATE, newInfoPtr);
newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
@@ -2336,7 +2499,7 @@ InitSockets(void)
windowClass.hInstance = TclWinGetTclInstance();
windowClass.hbrBackground = NULL;
windowClass.lpszMenuName = NULL;
- windowClass.lpszClassName = classname;
+ windowClass.lpszClassName = className;
windowClass.lpfnWndProc = SocketProc;
windowClass.hIcon = NULL;
windowClass.hCursor = NULL;
@@ -2466,7 +2629,7 @@ SocketExitHandler(
*/
TclpFinalizeSockets();
- UnregisterClass(classname, TclWinGetTclInstance());
+ UnregisterClass(className, TclWinGetTclInstance());
initialized = 0;
Tcl_MutexUnlock(&socketMutex);
}
@@ -2497,7 +2660,7 @@ SocketSetupProc(
Tcl_Time blockTime = { 0, 0 };
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!(flags & TCL_FILE_EVENTS)) {
+ if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
return;
}
@@ -2507,9 +2670,8 @@ SocketSetupProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
- if (statePtr->readyEvents &
- (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
- ) {
+ if (GOT_BITS(statePtr->readyEvents,
+ statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)) {
Tcl_SetMaxBlockTime(&blockTime);
break;
}
@@ -2543,7 +2705,7 @@ SocketCheckProc(
SocketEvent *evPtr;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
- if (!(flags & TCL_FILE_EVENTS)) {
+ if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
return;
}
@@ -2556,11 +2718,10 @@ SocketCheckProc(
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
- if ((statePtr->readyEvents &
- (statePtr->watchEvents | FD_CONNECT | FD_ACCEPT))
- && !(statePtr->flags & SOCKET_PENDING)
- ) {
- statePtr->flags |= SOCKET_PENDING;
+ if (GOT_BITS(statePtr->readyEvents,
+ statePtr->watchEvents | FD_CONNECT | FD_ACCEPT)
+ && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) {
+ SET_BITS(statePtr->flags, SOCKET_PENDING);
evPtr = ckalloc(sizeof(SocketEvent));
evPtr->header.proc = SocketEventProc;
evPtr->socket = statePtr->sockets->fd;
@@ -2606,7 +2767,7 @@ SocketEventProc(
address addr;
int len;
- if (!(flags & TCL_FILE_EVENTS)) {
+ if (!GOT_BITS(flags, TCL_FILE_EVENTS)) {
return 0;
}
@@ -2635,29 +2796,26 @@ SocketEventProc(
* Clear flag that (this) event is pending
*/
- statePtr->flags &= ~SOCKET_PENDING;
+ CLEAR_BITS(statePtr->flags, SOCKET_PENDING);
/*
* Continue async connect if pending and ready
*/
- if ( statePtr->readyEvents & FD_CONNECT ) {
- if ( statePtr->flags & TCP_ASYNC_PENDING ) {
-
+ if (GOT_BITS(statePtr->readyEvents, FD_CONNECT)) {
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING)) {
/*
* Do one step and save eventual connect error
*/
SetEvent(tsdPtr->socketListLock);
WaitForConnect(statePtr,NULL);
-
} else {
-
/*
* No async connect reenter pending. Just clear event.
*/
- statePtr->readyEvents &= ~(FD_CONNECT);
+ CLEAR_BITS(statePtr->readyEvents, FD_CONNECT);
SetEvent(tsdPtr->socketListLock);
}
return 1;
@@ -2666,20 +2824,23 @@ SocketEventProc(
/*
* Handle connection requests directly.
*/
- if (statePtr->readyEvents & FD_ACCEPT) {
- for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
+ if (GOT_BITS(statePtr->readyEvents, FD_ACCEPT)) {
+ for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
/*
- * Accept the incoming connection request.
- */
- len = sizeof(address);
+ * Accept the incoming connection request.
+ */
+ len = sizeof(address);
newSocket = accept(fds->fd, &(addr.sa), &len);
- /* On Tcl server sockets with multiple OS fds we loop over the fds trying
- * an accept() on each, so we expect INVALID_SOCKET. There are also other
- * network stack conditions that can result in FD_ACCEPT but a subsequent
- * failure on accept() by the time we get around to it.
+ /*
+ * On Tcl server sockets with multiple OS fds we loop over the fds
+ * trying an accept() on each, so we expect INVALID_SOCKET. There
+ * are also other network stack conditions that can result in
+ * FD_ACCEPT but a subsequent failure on accept() by the time we
+ * get around to it.
+ *
* Access to sockets (acceptEventCount, readyEvents) in socketList
* is still protected by the lock (prevents reintroduction of
* SF Tcl Bug 3056775.
@@ -2691,35 +2852,40 @@ SocketEventProc(
}
/*
- * It is possible that more than one FD_ACCEPT has been sent, so an extra
- * count must be kept. Decrement the count, and reset the readyEvent bit
- * if the count is no longer > 0.
+ * It is possible that more than one FD_ACCEPT has been sent, so
+ * an extra count must be kept. Decrement the count, and reset the
+ * readyEvent bit if the count is no longer > 0.
*/
+
statePtr->acceptEventCount--;
if (statePtr->acceptEventCount <= 0) {
- statePtr->readyEvents &= ~(FD_ACCEPT);
+ CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);
}
SetEvent(tsdPtr->socketListLock);
- /* Caution: TcpAccept() has the side-effect of evaluating the server
- * accept script (via AcceptCallbackProc() in tclIOCmd.c), which can
- * close the server socket and invalidate statePtr and fds.
- * If TcpAccept() accepts a socket we must return immediately and let
- * SocketCheckProc queue additional FD_ACCEPT events.
+ /*
+ * Caution: TcpAccept() has the side-effect of evaluating the
+ * server accept script (via AcceptCallbackProc() in tclIOCmd.c),
+ * which can close the server socket and invalidate statePtr and
+ * fds. If TcpAccept() accepts a socket we must return immediately
+ * and let SocketCheckProc queue additional FD_ACCEPT events.
*/
+
TcpAccept(fds, newSocket, addr);
return 1;
}
- /* Loop terminated with no sockets accepted; clear the ready mask so
+ /*
+ * Loop terminated with no sockets accepted; clear the ready mask so
* we can detect the next connection request. Note that connection
* requests are level triggered, so if there is a request already
* pending, a new event will be generated.
*/
+
statePtr->acceptEventCount = 0;
- statePtr->readyEvents &= ~(FD_ACCEPT);
+ CLEAR_BITS(statePtr->readyEvents, FD_ACCEPT);
SetEvent(tsdPtr->socketListLock);
return 1;
@@ -2734,7 +2900,7 @@ SocketEventProc(
events = statePtr->readyEvents & statePtr->watchEvents;
- if (events & FD_CLOSE) {
+ if (GOT_BITS(events, FD_CLOSE)) {
/*
* If the socket was closed and the channel is still interested in
* read events, then we need to ensure that we keep polling for this
@@ -2748,17 +2914,14 @@ SocketEventProc(
Tcl_Time blockTime = { 0, 0 };
Tcl_SetMaxBlockTime(&blockTime);
- mask |= TCL_READABLE|TCL_WRITABLE;
- } else if (events & FD_READ) {
-
+ SET_BITS(mask, TCL_READABLE | TCL_WRITABLE);
+ } else if (GOT_BITS(events, FD_READ)) {
/*
* Throw the readable event if an async connect failed.
*/
- if ( statePtr->flags & TCP_ASYNC_FAILED ) {
-
- mask |= TCL_READABLE;
-
+ if (GOT_BITS(statePtr->flags, TCP_ASYNC_FAILED)) {
+ SET_BITS(mask, TCL_READABLE);
} else {
fd_set readFds;
struct timeval timeout;
@@ -2771,8 +2934,7 @@ SocketEventProc(
* async select handler and keep waiting.
*/
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) UNSELECT, (LPARAM) statePtr);
+ SendSelectMessage(tsdPtr, UNSELECT, statePtr);
FD_ZERO(&readFds);
FD_SET(statePtr->sockets->fd, &readFds);
@@ -2780,11 +2942,10 @@ SocketEventProc(
timeout.tv_sec = 0;
if (select(0, &readFds, NULL, NULL, &timeout) != 0) {
- mask |= TCL_READABLE;
+ SET_BITS(mask, TCL_READABLE);
} else {
- statePtr->readyEvents &= ~(FD_READ);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) SELECT, (LPARAM) statePtr);
+ CLEAR_BITS(statePtr->readyEvents, FD_READ);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
}
}
}
@@ -2793,8 +2954,8 @@ SocketEventProc(
* writable event
*/
- if (events & FD_WRITE) {
- mask |= TCL_WRITABLE;
+ if (GOT_BITS(events, FD_WRITE)) {
+ SET_BITS(mask, TCL_WRITABLE);
}
/*
@@ -2831,13 +2992,19 @@ AddSocketInfoFd(
{
TcpFdList *fds = statePtr->sockets;
- if ( fds == NULL ) {
- /* Add the first FD */
+ if (fds == NULL) {
+ /*
+ * Add the first FD.
+ */
+
statePtr->sockets = ckalloc(sizeof(TcpFdList));
fds = statePtr->sockets;
} else {
- /* Find end of list and append FD */
- while ( fds->next != NULL ) {
+ /*
+ * Find end of list and append FD.
+ */
+
+ while (fds->next != NULL) {
fds = fds->next;
}
@@ -2845,7 +3012,10 @@ AddSocketInfoFd(
fds = fds->next;
}
- /* Populate new FD */
+ /*
+ * Populate new FD.
+ */
+
fds->fd = socket;
fds->statePtr = statePtr;
fds->next = NULL;
@@ -2915,6 +3085,7 @@ WaitForSocketEvent(
int result = 1;
int oldMode;
ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);
+
/*
* Be sure to disable event servicing so we are truly modal.
*/
@@ -2925,29 +3096,42 @@ WaitForSocketEvent(
* Reset WSAAsyncSelect so we have a fresh set of events pending.
*/
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
- (LPARAM) statePtr);
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
- (LPARAM) statePtr);
+ SendSelectMessage(tsdPtr, UNSELECT, statePtr);
+ SendSelectMessage(tsdPtr, SELECT, statePtr);
while (1) {
int event_found;
- /* get statePtr lock */
+ /*
+ * Get statePtr lock.
+ */
+
WaitForSingleObject(tsdPtr->socketListLock, INFINITE);
- /* Check if event occured */
- event_found = (statePtr->readyEvents & events);
+ /*
+ * Check if event occured.
+ */
+
+ event_found = GOT_BITS(statePtr->readyEvents, events);
+
+ /*
+ * Free list lock.
+ */
- /* Free list lock */
SetEvent(tsdPtr->socketListLock);
- /* exit loop if event occured */
+ /*
+ * Exit loop if event occured.
+ */
+
if (event_found) {
break;
}
- /* Exit loop if event did not occur but this is a non-blocking channel */
+ /*
+ * Exit loop if event did not occur but this is a non-blocking channel
+ */
+
if (statePtr->flags & TCP_NONBLOCKING) {
*errorCodePtr = EWOULDBLOCK;
result = 0;
@@ -2992,7 +3176,7 @@ SocketThread(
* Create a dummy window receiving socket events.
*/
- tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0,
+ tsdPtr->hwnd = CreateWindow(className, className, WS_TILED, 0, 0, 0, 0,
NULL, NULL, windowClass.hInstance, arg);
/*
@@ -3104,55 +3288,59 @@ SocketProc(
for (statePtr = tsdPtr->socketList; statePtr != NULL;
statePtr = statePtr->nextPtr) {
- if ( FindFDInList(statePtr,socket) ) {
+ if (FindFDInList(statePtr, socket)) {
info_found = 1;
break;
}
}
+
/*
- * Check if there is a pending info structure not jet in the
- * list
+ * Check if there is a pending info structure not jet in the list.
*/
- if ( !info_found
+
+ if (!info_found
&& tsdPtr->pendingTcpState != NULL
- && FindFDInList(tsdPtr->pendingTcpState,socket) ) {
+ && FindFDInList(tsdPtr->pendingTcpState, socket)) {
statePtr = tsdPtr->pendingTcpState;
info_found = 1;
}
if (info_found) {
-
/*
* Update the socket state.
*
* A count of FD_ACCEPTS is stored, so if an FD_CLOSE event
- * happens, then clear the FD_ACCEPT count. Otherwise,
- * increment the count if the current event is an FD_ACCEPT.
+ * happens, then clear the FD_ACCEPT count. Otherwise, increment
+ * the count if the current event is an FD_ACCEPT.
*/
- if (event & FD_CLOSE) {
+ if (GOT_BITS(event, FD_CLOSE)) {
statePtr->acceptEventCount = 0;
- statePtr->readyEvents &= ~(FD_WRITE|FD_ACCEPT);
- } else if (event & FD_ACCEPT) {
+ CLEAR_BITS(statePtr->readyEvents, FD_WRITE | FD_ACCEPT);
+ } else if (GOT_BITS(event, FD_ACCEPT)) {
statePtr->acceptEventCount++;
}
- if (event & FD_CONNECT) {
+ if (GOT_BITS(event, FD_CONNECT)) {
/*
* Remember any error that occurred so we can report
* connection failures.
*/
+
if (error != ERROR_SUCCESS) {
statePtr->notifierConnectError = error;
}
}
+
/*
* Inform main thread about signaled events
*/
- statePtr->readyEvents |= event;
+
+ SET_BITS(statePtr->readyEvents, event);
/*
* Wake up the Main Thread.
*/
+
SetEvent(tsdPtr->readyEvent);
Tcl_ThreadAlert(tsdPtr->threadId);
}
@@ -3233,6 +3421,7 @@ FindFDInList(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
#undef TclWinGetSockOpt
int
TclWinGetSockOpt(
@@ -3272,6 +3461,7 @@ TclWinGetServByName(
{
return getservbyname(name, proto);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -3361,8 +3551,7 @@ TcpThreadActionProc(
* thread.
*/
- SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
- (WPARAM) notifyCmd, (LPARAM) statePtr);
+ SendSelectMessage(tsdPtr, notifyCmd, statePtr);
}
/*
diff --git a/win/tclWinTest.c b/win/tclWinTest.c
index aa2c15a..40be3d5 100644
--- a/win/tclWinTest.c
+++ b/win/tclWinTest.c
@@ -276,11 +276,11 @@ TestwinclockCmd(
result = Tcl_NewObj();
Tcl_ListObjAppendElement(interp, result,
- Tcl_NewIntObj((int) (t2.QuadPart / 10000000)));
+ Tcl_NewWideIntObj(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_NewWideIntObj((t2.QuadPart / 10) % 1000000));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(tclTime.sec));
+ Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(tclTime.usec));
Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p1.QuadPart));
Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(p2.QuadPart));
@@ -572,7 +572,7 @@ TestplatformChmod(
*/
if (set_readOnly == acl_readOnly_found || SetNamedSecurityInfoA(
- (LPSTR) nativePath, SE_FILE_OBJECT,
+ (LPSTR) nativePath, SE_FILE_OBJECT,
DACL_SECURITY_INFORMATION /*| PROTECTED_DACL_SECURITY_INFORMATION*/,
NULL, NULL, newAcl, NULL) == ERROR_SUCCESS) {
res = 0;
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 0f83526..d169ebb 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -13,8 +13,6 @@
#include "tclWinInt.h"
-#include <float.h>
-
/* Workaround for mingw versions which don't provide this in float.h */
#ifndef _MCW_EM
# define _MCW_EM 0x0008001F /* Error masks */
@@ -29,10 +27,7 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask
*/
static CRITICAL_SECTION masterLock;
-static int init = 0;
-#define MASTER_LOCK TclpMasterLock()
-#define MASTER_UNLOCK TclpMasterUnlock()
-
+static int initialized = 0;
/*
* This is the master lock used to serialize initialization and finalization
@@ -46,7 +41,7 @@ static CRITICAL_SECTION initLock;
* obvious reasons, cannot use any dyamically allocated storage.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
static struct Tcl_Mutex_ {
CRITICAL_SECTION crit;
@@ -81,7 +76,7 @@ static CRITICAL_SECTION joinLock;
* The per-thread event and queue pointers.
*/
-#ifdef TCL_THREADS
+#if TCL_THREADS
typedef struct ThreadSpecificData {
HANDLE condEvent; /* Per-thread condition event */
@@ -110,7 +105,7 @@ static Tcl_ThreadDataKey dataKey;
* the queue.
*/
-typedef struct WinCondition {
+typedef struct {
CRITICAL_SECTION condLock; /* Lock to serialize queuing on the
* condition. */
struct ThreadSpecificData *firstPtr; /* Queue pointers */
@@ -122,10 +117,9 @@ typedef struct WinCondition {
*/
#ifdef USE_THREAD_ALLOC
-static int once;
static DWORD tlsKey;
-typedef struct allocMutex {
+typedef struct {
Tcl_Mutex tlock;
CRITICAL_SECTION wlock;
} allocMutex;
@@ -136,7 +130,7 @@ typedef struct allocMutex {
* to TclWinThreadStart.
*/
-typedef struct WinThread {
+typedef struct {
LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
LPVOID lpParameter; /* Original startup data */
unsigned int fpControl; /* Floating point control word from the
@@ -184,7 +178,7 @@ TclWinThreadStart(
lpOrigStartAddress = winThreadPtr->lpStartAddress;
lpOrigParameter = winThreadPtr->lpParameter;
- ckfree((char *)winThreadPtr);
+ ckfree(winThreadPtr);
return lpOrigStartAddress(lpOrigParameter);
}
@@ -357,7 +351,7 @@ Tcl_GetCurrentThread(void)
void
TclpInitLock(void)
{
- if (!init) {
+ if (!initialized) {
/*
* There is a fundamental race here that is solved by creating the
* first Tcl interpreter in a single threaded environment. Once the
@@ -365,7 +359,7 @@ TclpInitLock(void)
* that create interpreters in parallel.
*/
- init = 1;
+ initialized = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
@@ -419,7 +413,7 @@ TclpInitUnlock(void)
void
TclpMasterLock(void)
{
- if (!init) {
+ if (!initialized) {
/*
* There is a fundamental race here that is solved by creating the
* first Tcl interpreter in a single threaded environment. Once the
@@ -427,7 +421,7 @@ TclpMasterLock(void)
* that create interpreters in parallel.
*/
- init = 1;
+ initialized = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
@@ -480,7 +474,7 @@ TclpMasterUnlock(void)
Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (!allocOnce) {
InitializeCriticalSection(&allocLock.crit);
allocOnce = 1;
@@ -494,7 +488,7 @@ Tcl_GetAllocMutex(void)
/*
*----------------------------------------------------------------------
*
- * TclpFinalizeLock
+ * TclFinalizeLock
*
* This procedure is used to destroy all private resources used in this
* file.
@@ -512,7 +506,7 @@ Tcl_GetAllocMutex(void)
void
TclFinalizeLock(void)
{
- MASTER_LOCK;
+ TclpMasterLock();
DeleteCriticalSection(&joinLock);
/*
@@ -520,9 +514,9 @@ TclFinalizeLock(void)
*/
DeleteCriticalSection(&masterLock);
- init = 0;
+ initialized = 0;
-#ifdef TCL_THREADS
+#if TCL_THREADS
if (allocOnce) {
DeleteCriticalSection(&allocLock.crit);
allocOnce = 0;
@@ -538,7 +532,7 @@ TclFinalizeLock(void)
DeleteCriticalSection(&initLock);
}
-#ifdef TCL_THREADS
+#if TCL_THREADS
/* locally used prototype */
static void FinalizeConditionEvent(ClientData data);
@@ -567,7 +561,7 @@ Tcl_MutexLock(
CRITICAL_SECTION *csPtr;
if (*mutexPtr == NULL) {
- MASTER_LOCK;
+ TclpMasterLock();
/*
* Double inside master lock check to avoid a race.
@@ -579,7 +573,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
}
- MASTER_UNLOCK;
+ TclpMasterUnlock();
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
EnterCriticalSection(csPtr);
@@ -681,7 +675,7 @@ Tcl_ConditionWait(
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
- MASTER_LOCK;
+ TclpMasterLock();
/*
* Create the per-thread event and queue pointers.
@@ -695,7 +689,7 @@ Tcl_ConditionWait(
tsdPtr->flags = WIN_THREAD_RUNNING;
doExit = 1;
}
- MASTER_UNLOCK;
+ TclpMasterUnlock();
if (doExit) {
/*
@@ -710,7 +704,7 @@ Tcl_ConditionWait(
}
if (*condPtr == NULL) {
- MASTER_LOCK;
+ TclpMasterLock();
/*
* Initialize the per-condition queue pointers and Mutex.
@@ -724,7 +718,7 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) winCondPtr;
TclRememberCondition(condPtr);
}
- MASTER_UNLOCK;
+ TclpMasterUnlock();
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
winCondPtr = *((WinCondition **)condPtr);
@@ -944,9 +938,9 @@ TclpFinalizeCondition(
Tcl_Mutex *
TclpNewAllocMutex(void)
{
- struct allocMutex *lockPtr;
+ allocMutex *lockPtr;
- lockPtr = malloc(sizeof(struct allocMutex));
+ lockPtr = malloc(sizeof(allocMutex));
if (lockPtr == NULL) {
Tcl_Panic("could not allocate lock");
}
@@ -968,24 +962,24 @@ TclpFreeAllocMutex(
free(lockPtr);
}
-void *
-TclpGetAllocCache(void)
+void
+TclpInitAllocCache(void)
{
- void *result;
-
- if (!once) {
- /*
- * We need to make sure that TclpFreeAllocCache is called on each
- * thread that calls this, but only on threads that call this.
- */
+ /*
+ * We need to make sure that TclpFreeAllocCache is called on each
+ * thread that calls this, but only on threads that call this.
+ */
- tlsKey = TlsAlloc();
- once = 1;
- if (tlsKey == TLS_OUT_OF_INDEXES) {
- Tcl_Panic("could not allocate thread local storage");
- }
+ tlsKey = TlsAlloc();
+ if (tlsKey == TLS_OUT_OF_INDEXES) {
+ Tcl_Panic("could not allocate thread local storage");
}
+}
+void *
+TclpGetAllocCache(void)
+{
+ void *result;
result = TlsGetValue(tlsKey);
if ((result == NULL) && (GetLastError() != NO_ERROR)) {
Tcl_Panic("TlsGetValue failed from TclpGetAllocCache");
@@ -1023,7 +1017,7 @@ TclpFreeAllocCache(
if (!success) {
Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache");
}
- } else if (once) {
+ } else {
/*
* Called by us in TclFinalizeThreadAlloc() during the library
* finalization initiated from Tcl_Finalize()
@@ -1033,9 +1027,7 @@ TclpFreeAllocCache(
if (!success) {
Tcl_Panic("TlsFree failed from TclpFreeAllocCache");
}
- once = 0; /* reset for next time. */
}
-
}
#endif /* USE_THREAD_ALLOC */
diff --git a/win/tclWinTime.c b/win/tclWinTime.c
index 7f4f7e5..dd603d1 100644
--- a/win/tclWinTime.c
+++ b/win/tclWinTime.c
@@ -27,6 +27,7 @@
* month, where index 1 is January.
*/
+#ifndef TCL_NO_DEPRECATED
static const int normalDays[] = {
-1, 30, 58, 89, 119, 150, 180, 211, 242, 272, 303, 333, 364
};
@@ -35,17 +36,18 @@ static const int leapDays[] = {
-1, 30, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365
};
-typedef struct ThreadSpecificData {
+typedef struct {
char tzName[64]; /* Time zone name */
struct tm tm; /* time information */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
+#endif /* TCL_NO_DEPRECATED */
/*
* Data for managing high-resolution timers.
*/
-typedef struct TimeInfo {
+typedef struct {
CRITICAL_SECTION cs; /* Mutex guarding this structure. */
int initialized; /* Flag == 1 if this structure is
* initialized. */
@@ -113,7 +115,9 @@ static TimeInfo timeInfo = {
* Declarations for functions defined later in this file.
*/
+#ifndef TCL_NO_DEPRECATED
static struct tm * ComputeGMT(const time_t *tp);
+#endif /* TCL_NO_DEPRECATED */
static void StopCalibration(ClientData clientData);
static DWORD WINAPI CalibrationThread(LPVOID arg);
static void UpdateTimeEachSecond(void);
@@ -339,7 +343,7 @@ NativeGetTime(
*/
SYSTEM_INFO systemInfo;
- unsigned int regs[4];
+ int regs[4];
GetSystemInfo(&systemInfo);
if (TclWinCPUID(0, regs) == TCL_OK
@@ -351,7 +355,7 @@ NativeGetTime(
|| ((regs[0] & 0x00F00000) /* Extended family */
&& (regs[3] & 0x10000000))) /* Hyperthread */
&& (((regs[1]&0x00FF0000) >> 16)/* CPU count */
- == systemInfo.dwNumberOfProcessors)) {
+ == (int)systemInfo.dwNumberOfProcessors)) {
timeInfo.perfCounterAvailable = TRUE;
} else {
timeInfo.perfCounterAvailable = FALSE;
@@ -522,6 +526,7 @@ StopCalibration(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
struct tm *
TclpGetDate(
const time_t *t,
@@ -733,6 +738,7 @@ ComputeGMT(
return tmPtr;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -1077,6 +1083,7 @@ AccumulateSample(
*----------------------------------------------------------------------
*/
+#ifndef TCL_NO_DEPRECATED
struct tm *
TclpGmtime(
const time_t *timePtr) /* Pointer to the number of seconds since the
@@ -1121,6 +1128,7 @@ TclpLocaltime(
return localtime(timePtr);
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
diff --git a/win/tclooConfig.sh b/win/tclooConfig.sh
index 2279542..4c2068c 100644
--- a/win/tclooConfig.sh
+++ b/win/tclooConfig.sh
@@ -16,4 +16,4 @@ TCLOO_STUB_LIB_SPEC=""
TCLOO_INCLUDE_SPEC=""
TCLOO_PRIVATE_INCLUDE_SPEC=""
TCLOO_CFLAGS=""
-TCLOO_VERSION=1.1.0
+TCLOO_VERSION=1.2.0
diff --git a/win/tclsh.rc b/win/tclsh.rc
index 161da50..bd1a4da 100644
--- a/win/tclsh.rc
+++ b/win/tclsh.rc
@@ -8,12 +8,6 @@
//
// build-up the name suffix that defines the type of build this is.
//
-#if TCL_THREADS
-#define SUFFIX_THREADS "t"
-#else
-#define SUFFIX_THREADS ""
-#endif
-
#if STATIC_BUILD
#define SUFFIX_STATIC "s"
#else
@@ -26,7 +20,7 @@
#define SUFFIX_DEBUG ""
#endif
-#define SUFFIX SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
+#define SUFFIX SUFFIX_STATIC SUFFIX_DEBUG
LANGUAGE 0x9, 0x1 /* LANG_ENGLISH, SUBLANG_DEFAULT */