summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2016-08-19 12:45:10 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2016-08-19 12:45:10 (GMT)
commitf1a557e68f5eb0588808d2a44cf33a1ca5926a4e (patch)
tree816c2b2f7b054d5c3d13dae3893b51f86ff63c75
parent88cdd20ced085368f180bdea5c9fce74960c05f0 (diff)
parent758db779152a98af7e54cd845a87956b5fb6924a (diff)
downloadtcl-f1a557e68f5eb0588808d2a44cf33a1ca5926a4e.zip
tcl-f1a557e68f5eb0588808d2a44cf33a1ca5926a4e.tar.gz
tcl-f1a557e68f5eb0588808d2a44cf33a1ca5926a4e.tar.bz2
merge zipfs
-rw-r--r--README2
-rw-r--r--changes74
-rw-r--r--[-rwxr-xr-x]compat/zlib/win32/zlib1.dllbin107520 -> 107520 bytes
-rw-r--r--[-rwxr-xr-x]compat/zlib/win64/zlib1.dllbin112640 -> 112640 bytes
-rw-r--r--debian/changelog6
-rw-r--r--doc/SetResult.32
-rw-r--r--doc/chan.n26
-rw-r--r--doc/clock.n13
-rw-r--r--doc/exec.n5
-rw-r--r--doc/fcopy.n12
-rw-r--r--doc/file.n11
-rw-r--r--doc/package.n4
-rw-r--r--doc/proc.n28
-rw-r--r--doc/zipfs.32
-rw-r--r--doc/zipfs.n4
-rw-r--r--doc/zlib.n18
-rw-r--r--generic/tcl.h22
-rw-r--r--generic/tclBasic.c27
-rw-r--r--generic/tclClock.c12
-rw-r--r--generic/tclCmdAH.c43
-rw-r--r--generic/tclCmdIL.c3
-rw-r--r--generic/tclCmdMZ.c12
-rw-r--r--generic/tclDictObj.c18
-rw-r--r--generic/tclDisassemble.c135
-rw-r--r--generic/tclEncoding.c1
-rw-r--r--generic/tclEnsemble.c398
-rw-r--r--generic/tclExecute.c73
-rw-r--r--generic/tclHash.c37
-rw-r--r--generic/tclIO.c159
-rw-r--r--generic/tclIO.h6
-rw-r--r--generic/tclIOCmd.c45
-rw-r--r--generic/tclIOUtil.c3
-rw-r--r--generic/tclIndexObj.c19
-rw-r--r--generic/tclInt.h60
-rw-r--r--generic/tclInterp.c32
-rw-r--r--generic/tclMain.c51
-rw-r--r--generic/tclNamesp.c23
-rw-r--r--generic/tclOO.c25
-rw-r--r--generic/tclOO.h2
-rw-r--r--generic/tclOOCall.c9
-rw-r--r--generic/tclOODefineCmds.c58
-rw-r--r--generic/tclOOMethod.c33
-rw-r--r--generic/tclObj.c2
-rw-r--r--generic/tclPathObj.c10
-rw-r--r--generic/tclProc.c25
-rw-r--r--generic/tclStringObj.c87
-rw-r--r--generic/tclTest.c38
-rw-r--r--generic/tclTestObj.c10
-rw-r--r--generic/tclTomMath.h12
-rw-r--r--generic/tclUtf.c22
-rw-r--r--generic/tclVar.c131
-rw-r--r--generic/tclZlib.c65
-rw-r--r--generic/zipfs.c62
-rwxr-xr-x[-rw-r--r--]library/clock.tcl60
-rw-r--r--library/init.tcl2
-rwxr-xr-x[-rw-r--r--]library/msgs/af.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/af_za.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_jo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_lb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ar_sy.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/bg.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/bn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/bn_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ca.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/cs.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/da.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/de.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/de_at.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/de_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/el.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_au.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_bw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_ca.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_gb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_hk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_ie.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_nz.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_ph.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_sg.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_za.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/en_zw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/eo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ar.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_bo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_cl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_co.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_cr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_do.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ec.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_gt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_hn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_mx.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ni.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_pa.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_pe.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_pr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_py.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_sv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_uy.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/es_ve.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/et.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/eu.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/eu_es.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fa.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fa_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fa_ir.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fi.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fo_fo.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr_ca.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/fr_ch.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ga.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ga_ie.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gl_es.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/gv_gb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/he.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hi.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hi_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/hu.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/id.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/id_id.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/is.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/it.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/it_ch.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ja.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kl_gl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ko.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ko_kr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kok.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kok_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/kw_gb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/lt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/lv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mr_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ms.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ms_my.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/mt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nb.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nl_be.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/nn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/pl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/pt.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/pt_br.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ro.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ru.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ru_ua.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sh.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sl.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sq.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sv.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/sw.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ta.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/ta_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/te.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/te_in.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/th.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/tr.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/uk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/vi.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_cn.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_hk.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_sg.msg0
-rwxr-xr-x[-rw-r--r--]library/msgs/zh_tw.msg0
-rw-r--r--library/tcltest/tcltest.tcl4
-rwxr-xr-x[-rw-r--r--]library/tzdata/Africa/Asmara0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Atikokan0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Blanc-Sablon0
-rw-r--r--library/tzdata/America/Cambridge_Bay2
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Petersburg0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Tell_City0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Vincennes0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Indiana/Winamac0
-rw-r--r--library/tzdata/America/Inuvik2
-rw-r--r--library/tzdata/America/Iqaluit2
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Moncton0
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/North_Dakota/New_Salem0
-rw-r--r--library/tzdata/America/Pangnirtung2
-rw-r--r--library/tzdata/America/Rankin_Inlet2
-rwxr-xr-x[-rw-r--r--]library/tzdata/America/Resolute2
-rw-r--r--library/tzdata/America/Yellowknife2
-rw-r--r--library/tzdata/Antarctica/Casey2
-rw-r--r--library/tzdata/Antarctica/Davis4
-rw-r--r--library/tzdata/Antarctica/DumontDUrville4
-rw-r--r--library/tzdata/Antarctica/Macquarie4
-rw-r--r--library/tzdata/Antarctica/Mawson2
-rw-r--r--library/tzdata/Antarctica/Palmer2
-rw-r--r--library/tzdata/Antarctica/Rothera2
-rw-r--r--library/tzdata/Antarctica/Syowa2
-rw-r--r--library/tzdata/Antarctica/Troll2
-rw-r--r--library/tzdata/Antarctica/Vostok2
-rw-r--r--library/tzdata/Asia/Baku2
-rw-r--r--library/tzdata/Asia/Novokuznetsk133
-rw-r--r--library/tzdata/Asia/Novosibirsk135
-rwxr-xr-x[-rw-r--r--]library/tzdata/Atlantic/Faroe0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Australia/Eucla0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Guernsey0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Isle_of_Man0
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Jersey0
-rw-r--r--library/tzdata/Europe/Minsk6
-rwxr-xr-x[-rw-r--r--]library/tzdata/Europe/Podgorica0
-rw-r--r--library/tzdata/Indian/Kerguelen2
-rw-r--r--macosx/GNUmakefile2
-rw-r--r--macosx/Tcl.xcode/project.pbxproj16
-rw-r--r--macosx/Tcl.xcodeproj/project.pbxproj16
-rw-r--r--macosx/configure.ac2
-rw-r--r--tests/chanio.test69
-rw-r--r--tests/clock.test135
-rw-r--r--tests/cmdAH.test96
-rw-r--r--tests/compile.test119
-rw-r--r--tests/env.test12
-rw-r--r--tests/exec.test16
-rw-r--r--tests/fileName.test14
-rw-r--r--tests/history.test7
-rw-r--r--tests/info.test12
-rw-r--r--tests/interp.test99
-rw-r--r--tests/io.test35
-rw-r--r--tests/load.test54
-rw-r--r--tests/msgcat.test9
-rw-r--r--tests/namespace-old.test169
-rw-r--r--tests/namespace.test510
-rwxr-xr-x[-rw-r--r--]tests/notify.test0
-rw-r--r--tests/oo.test52
-rw-r--r--tests/package.test38
-rw-r--r--tests/parseOld.test13
-rw-r--r--tests/resolver.test3
-rw-r--r--tests/safe.test20
-rw-r--r--tests/set-old.test6
-rw-r--r--tests/set.test119
-rw-r--r--tests/socket.test1
-rwxr-xr-x[-rw-r--r--]tests/tcltest.test7
-rw-r--r--tests/unload.test170
-rw-r--r--tests/var.test64
-rw-r--r--tests/zlib.test32
-rwxr-xr-xunix/configure2
-rw-r--r--unix/configure.in2
-rwxr-xr-xunix/installManPage2
-rw-r--r--unix/tcl.spec2
-rw-r--r--unix/tclUnixNotfy.c8
-rw-r--r--unix/tclUnixThrd.c15
-rwxr-xr-xwin/configure2
-rw-r--r--win/configure.in2
-rwxr-xr-xwin/tclWinFile.c111
-rw-r--r--win/tclWinInit.c4
-rw-r--r--win/tclWinInt.h1
-rw-r--r--win/tclWinNotify.c8
-rw-r--r--win/tclWinPipe.c7
-rw-r--r--win/tclWinPort.h14
-rw-r--r--win/tclWinSock.c17
-rw-r--r--win/tclWinThrd.c29
268 files changed, 2892 insertions, 1612 deletions
diff --git a/README b/README
index f3e50dd..401b6e6 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
README: Tcl
- This is the Tcl 8.6.5 source distribution.
+ This is the Tcl 8.6.6 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
diff --git a/changes b/changes
index 1e24269..034380b 100644
--- a/changes
+++ b/changes
@@ -8624,3 +8624,77 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich)
2016-02-22 (bug)[9b4702] [info exists env(missing)] kills trace (nijtmans)
--- Released 8.6.5, February 29, 2016 --- http://core.tcl.tk/tcl/ for details
+
+2016-03-01 (bug)[803042] mem leak due to reference cycle (porter)
+
+2016-03-08 (bug)[bbc304] reflected watch race condition (porter)
+
+2016-03-17 (bug)[fadc99] compile-5.3 (rodriguez,porter)
+
+2016-03-17 (enhancement)[1a25fd] compile [variable ${ns}::v] (porter)
+
+2016-03-20 (bug)[1af8de] crash in compiled [string replace] (harder,fellows)
+
+2016-03-21 (bug)[d30718] segv in notifier finalize (hirofumi,nijtmans)
+
+2016-03-23 (enhancement)[7d0db7] parallel make (yarda,nijtmans)
+
+2016-03-23 [f12535] enable test bindings customization (vogel,nijtmans)
+
+2016-04-04 (bug)[47ac84] compiled [lreplace] fixes (aspect,ferrieux,fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-04-08 (bug)[866368] RE \w includes 'Punctuation Connector' (nijtmans)
+
+2016-04-08 (bug)[2538f3] Win crash Tcl_OpenTcpServer() (griffin)
+
+2016-04-10 [07d13d] Restore TclBlend support lost in 8.6.1 (buratti)
+
+2016-05-13 (bug)[3154ea] Mem corruption in assembler exceptions (tkob,kenny)
+
+2016-05-13 (bug) registry package support any Unicode env (nijtmans)
+=> registry 1.3.2
+
+2016-05-21 (bug)[f7d4e] [namespace delete] performance (fellows)
+
+2016-06-02 (TIP 447) execution time verbosity option (cerutti)
+=> tcltest 2.4.0
+
+2016-06-16 (bug)[16828b] crash due to [vwait] trace undo fail (dah,porter)
+
+2016-06-16 (enhancement)[4b61af] good [info frame] from more cases (beric)
+
+2016-06-21 (bug)[c383eb] crash in [glob -path a] (oehlmann,porter)
+
+2016-06-21 (update) Update Unicode data to 9.0 (nijtmans)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-06-22 (bug)[16896d] Tcl_DString tolerate append to self. (dah,porter)
+
+2016-06-23 (bug)[d55322] crash in [dict update] (yorick,fellows)
+
+2016-06-27 (bug)[dd260a] crash in [chan configure -dictionary] (madden,aspect)
+
+2016-07-02 (bug)[f961d7] usage message with parameters with spaces (porter)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-07-02 (enhancement)[09fabc] Sort order of -relateddir (lanam)
+
+2016-07-07 (bug)[5d7ca0] Win: [file executable] for .cmd and .ps1 (nadkarni)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-07-08 (bug)[a47641] [file normalize] & Windows junctions (nadkarni)
+
+2016-07-09 [ae61a6] [file] handling of Win hardcoded names (CON) (nadkarni)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-07-09 [3613671] [file owned] (more) useful on Win (nadkarni)
+
+2016-07-09 (bug)[1493a4] [namespace upvar] use of resolvers (beric,fellows)
+ *** POTENTIAL INCOMPATIBILITY ***
+
+2016-07-10 (bug)[da340d] integer division in clock math (nadkarni)
+
+2016-07-20 tzdata updated to Olson's tzdata2016f (venkat)
+
+--- Released 8.6.6, July 27, 2016 --- http://core.tcl.tk/tcl/ for details
diff --git a/compat/zlib/win32/zlib1.dll b/compat/zlib/win32/zlib1.dll
index 9ea38d5..9ea38d5 100755..100644
--- a/compat/zlib/win32/zlib1.dll
+++ b/compat/zlib/win32/zlib1.dll
Binary files differ
diff --git a/compat/zlib/win64/zlib1.dll b/compat/zlib/win64/zlib1.dll
index bd1dbc6..bd1dbc6 100755..100644
--- a/compat/zlib/win64/zlib1.dll
+++ b/compat/zlib/win64/zlib1.dll
Binary files differ
diff --git a/debian/changelog b/debian/changelog
index 5a39d08..8bd8fa3 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+sdltcl8.6 (8.6.6-1) unstable; urgency=low
+
+ * Update to 8.6.6
+
+ -- Christian Werner <chw@ch-werner.de> Wed, 13 Jul 2016 10:00:00 +0200
+
sdltcl8.6 (8.6.5-1) unstable; urgency=low
* Update to 8.6.5
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index dc8f487..e5b81d7 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -164,7 +164,7 @@ The source interpreter will have its result reset by this operation.
.SH "DEPRECATED INTERFACES"
.SS "OLD STRING PROCEDURES"
.PP
-Use of the following procedures (is deprecated
+Use of the following procedures is deprecated
since they manipulate the Tcl result as a string.
Procedures such as \fBTcl_SetObjResult\fR
that manipulate the result as a value
diff --git a/doc/chan.n b/doc/chan.n
index 7ea0d19..81aa9f4 100644
--- a/doc/chan.n
+++ b/doc/chan.n
@@ -287,12 +287,14 @@ slow destinations like network sockets.
.RS
.PP
The \fBchan copy\fR command transfers data from \fIinputChan\fR until
-end of file or \fIsize\fR bytes have been transferred. If no
-\fB\-size\fR argument is given, then the copy goes until end of file.
-All the data read from \fIinputChan\fR is copied to \fIoutputChan\fR.
-Without the \fB\-command\fR option, \fBchan copy\fR blocks until the
-copy is complete and returns the number of bytes written to
-\fIoutputChan\fR.
+end of file or \fIsize\fR bytes or characters have been transferred;
+\fIsize\fR is in bytes if the two channels are using the same encoding,
+and is in characters otherwise. If no \fB\-size\fR argument is given,
+then the copy goes until end of file. All the data read from
+\fIinputChan\fR is copied to \fIoutputChan\fR. Without the
+\fB\-command\fR option, \fBchan copy\fR blocks until the copy is
+complete and returns the number of bytes or characters (using the same
+rules as for the \fB\-size\fR option) written to \fIoutputChan\fR.
.PP
The \fB\-command\fR argument makes \fBchan copy\fR work in the
background. In this case it returns immediately and the
@@ -547,6 +549,18 @@ this, spawn with "2>@" or
">@" redirection operators onto the write side of a pipe, and then
immediately close it in the parent. This is necessary to get an EOF on
the read side once the child has exited or otherwise closed its output.
+.RS
+.PP
+Note that the pipe buffering semantics can vary at the operating system level
+substantially; it is not safe to assume that a write performed on the output
+side of the pipe will appear instantly to the input side. This is a
+fundamental difference and Tcl cannot conceal it. The overall stream semantics
+\fIare\fR compatible, so blocking reads and writes will not see most of the
+differences, but the details of what exactly gets written when are not. This
+is most likely to show up when using pipelines for testing; care should be
+taken to ensure that deadlocks do not occur and that potential short reads are
+allowed for.
+.RE
.VE 8.6
.TP
\fBchan pop \fIchannelId\fR
diff --git a/doc/clock.n b/doc/clock.n
index ac50e36..889a5da 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -89,9 +89,10 @@ have 59 or 61 seconds.
.TP
\fIunit\fR
One of the words, \fBseconds\fR, \fBminutes\fR, \fBhours\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.
+\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.
.SS "OPTIONS"
.TP
\fB\-base\fR time
@@ -174,7 +175,8 @@ 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, \fBweekdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR.
+\fBdays\fR, \fBweeks\fR, \fBmonths\fR, or \fByears\fR, or
+any unique prefix of such a word.
.PP
Addition of seconds, minutes and hours is fairly straightforward;
the given time increment (times sixty for minutes, or 3600 for hours)
@@ -211,8 +213,7 @@ 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 \fBweekdays\fR keyword is similar to \fBdays\fR,
-with the only difference that weekends - Saturdays and Sundays - are skipped.
+the epoch time.
.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)
diff --git a/doc/exec.n b/doc/exec.n
index 9d58d90..70ace32 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -271,8 +271,9 @@ limitation as \fBexec\fR wants to communicate over pipes. The Expect
extension addresses this issue when communicating with a TUI application.
.PP
When attempting to execute an application, \fBexec\fR first searches for
-the name as it was specified. Then, in order, \fB.com\fR, \fB.exe\fR, and
-\fB.bat\fR are appended to the end of the specified name and it searches
+the name as it was specified. Then, in order,
+\fB.com\fR, \fB.exe\fR, \fB.bat\fR and \fB.cmd\fR
+are appended to the end of the specified name and it searches
for the longer name. If a directory name was not specified as part of the
application name, the following directories are automatically searched in
order when attempting to locate the application:
diff --git a/doc/fcopy.n b/doc/fcopy.n
index e5dd1d6..d39c803 100644
--- a/doc/fcopy.n
+++ b/doc/fcopy.n
@@ -25,12 +25,15 @@ network sockets.
.PP
The \fBfcopy\fR
command transfers data from \fIinchan\fR until end of file
-or \fIsize\fR bytes have been
-transferred. If no \fB\-size\fR argument is given,
+or \fIsize\fR bytes or characters have been
+transferred; \fIsize\fR is in bytes if the two channels are using the
+same encoding, and is in characters otherwise.
+If no \fB\-size\fR argument is given,
then the copy goes until end of file.
All the data read from \fIinchan\fR is copied to \fIoutchan\fR.
Without the \fB\-command\fR option, \fBfcopy\fR blocks until the copy is complete
-and returns the number of bytes written to \fIoutchan\fR.
+and returns the number of bytes or characters (using the same rules as
+for the \fB\-size\fR option) written to \fIoutchan\fR.
.PP
The \fB\-command\fR argument makes \fBfcopy\fR work in the background.
In this case it returns immediately and the \fIcallback\fR is invoked
@@ -174,3 +177,6 @@ vwait done
eof(n), fblocked(n), fconfigure(n), file(n)
.SH KEYWORDS
blocking, channel, end of line, end of file, nonblocking, read, translation
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/doc/file.n b/doc/file.n
index 8e765da..2f8b70c 100644
--- a/doc/file.n
+++ b/doc/file.n
@@ -162,7 +162,9 @@ returns \fB/home\fR (or something similar).
\fBfile executable \fIname\fR
.
Returns \fB1\fR if file \fIname\fR is executable by the current user,
-\fB0\fR otherwise.
+\fB0\fR otherwise. On Windows, which does not have an executable attribute,
+the command treats all directories and any files with extensions
+\fBexe\fR, \fBcom\fR, \fBcmd\fR or \fBbat\fR as executable.
.TP
\fBfile exists \fIname\fR
.
@@ -482,10 +484,9 @@ not the effective ones.
.TP
\fBWindows\fR\0\0\0\0
.
-The \fBfile owned\fR subcommand currently always reports that the current user
-is the owner of the file, without regard for what the operating system
-believes to be true, making an ownership test useless. This issue (#3613671)
-may be fixed in a future release of Tcl.
+The \fBfile owned\fR subcommand uses the user identifier (SID) of
+the process token, not the thread token which may be impersonating
+some other user.
.SH EXAMPLES
.PP
This procedure shows how to search for C files in a given directory
diff --git a/doc/package.n b/doc/package.n
index 47b2aa6..a6a972f 100644
--- a/doc/package.n
+++ b/doc/package.n
@@ -283,8 +283,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
-(to any value) or the Tcl package itself is unstable. Otherwise
+unless the environment variable \fBTCL_PKG_PREFER_LATEST\fR
+is set. If that environment variable is defined (with any value) then
the initial (and permanent) selection mode value is set to
.QW latest .
.RE
diff --git a/doc/proc.n b/doc/proc.n
index 129f4df..fdccaca 100644
--- a/doc/proc.n
+++ b/doc/proc.n
@@ -34,8 +34,9 @@ one or two fields. If there is only a single field in the specifier
then it is the name of the argument; if there are two fields, then
the first is the argument name and the second is its default value.
Arguments with default values that are followed by non-defaulted
-arguments become required arguments. In 8.6 this will be considered an
-error.
+arguments become required arguments; enough actual arguments must be
+supplied to allow all arguments up to and including the last required
+formal argument.
.PP
When \fIname\fR is invoked a local variable
will be created for each of the formal arguments to the procedure; its
@@ -48,11 +49,14 @@ actual arguments for all the
formal arguments that do not have defaults, and there must not be any extra
actual arguments.
Arguments with default values that are followed by non-defaulted
-arguments become required arguments (in 8.6 it will be considered an
-error).
+arguments become de-facto required arguments, though this may change
+in a future version of Tcl; portable code should ensure that all
+optional arguments come after all required arguments.
+.PP
There is one special case to permit procedures with
variable numbers of arguments. If the last formal argument has the name
-\fBargs\fR, then a call to the procedure may contain more actual arguments
+.QW \fBargs\fR ,
+then a call to the procedure may contain more actual arguments
than the procedure has formal arguments. In this case, all of the actual arguments
starting at the one that would be assigned to \fBargs\fR are combined into
a list (as if the \fBlist\fR command had been used); this combined value
@@ -80,6 +84,20 @@ If an error occurs while executing the procedure
body, then the procedure-as-a-whole will return that same error.
.SH EXAMPLES
.PP
+This is a procedure that takes two arguments and prints both their sum
+and their product. It also returns the string
+.QW OK
+to the caller as an explicit result.
+.PP
+.CS
+\fBproc\fR printSumProduct {x y} {
+ set sum [expr {$x + $y}]
+ set prod [expr {$x * $y}]
+ puts "sum is $sum, product is $prod"
+ return "OK"
+}
+.CE
+.PP
This is a procedure that accepts arbitrarily many arguments and prints
them out, one by one.
.PP
diff --git a/doc/zipfs.3 b/doc/zipfs.3
index b8f84f0..92e9f03 100644
--- a/doc/zipfs.3
+++ b/doc/zipfs.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 Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
.so man.macros
.BS
diff --git a/doc/zipfs.n b/doc/zipfs.n
index b21ad57..a0eb292 100644
--- a/doc/zipfs.n
+++ b/doc/zipfs.n
@@ -40,7 +40,7 @@ Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
Recursively lists files including and below the directory \fIdir\fR.
The result list consists of relative path names starting from the
given directory. This command is also used by the \fB::zipfs::mkzip\fR
-and \fB::zipfs::mkimg\fR commands.
+and \fB::zipfs::mkimg\fR commands.
.TP
\fB::zipfs::info\fR \fIfile\fR
.
@@ -91,7 +91,7 @@ of the respective file name.
.PP
Caution: the choice of the \fIindir\fR parameter
(less the optional stripped prefix) determines the later root name of the
-archive's content.
+archive's content.
.RE
.TP
\fB::zipfs::mount ?\fIzipfile\fR? ?\fImountpoint\fR?
diff --git a/doc/zlib.n b/doc/zlib.n
index 9f3078d..fd29e0d 100644
--- a/doc/zlib.n
+++ b/doc/zlib.n
@@ -174,7 +174,11 @@ to the \fBzlib push\fR command:
.VS "TIP 400"
Sets the compression dictionary to use when working with compressing or
decompressing the data to be \fIbinData\fR. Not valid for transformations that
-work with gzip-format data.
+work with gzip-format data. The dictionary should consist of strings (byte
+sequences) that are likely to be encountered later in the data to be compressed,
+with the most commonly used strings preferably put towards the end of the
+dictionary. Tcl provides no mechanism for choosing a good such dictionary for
+a particular data sequence.
.VE
.TP
\fB\-header\fI dictionary\fR
@@ -207,11 +211,13 @@ compression algorithm depends on what format is being produced or consumed.
.TP
\fB\-dictionary\fI binData\fR
.VS "TIP 400"
-This read-write options gets or sets the compression dictionary to use when
-working with compressing or decompressing the data to be \fIbinData\fR. It is
-not valid for transformations that work with gzip-format data, and should not
-normally be set on compressing transformations other than at the point where
-the transformation is stacked.
+This read-write options gets or sets the initial compression dictionary to use
+when working with compressing or decompressing the data to be \fIbinData\fR.
+It is not valid for transformations that work with gzip-format data, and should
+not normally be set on compressing transformations other than at the point where
+the transformation is stacked. Note that this cannot be used to get the
+current active compression dictionary mid-stream, as that information is not
+exposed by the underlying library.
.VE
.TP
\fB\-flush\fI type\fR
diff --git a/generic/tcl.h b/generic/tcl.h
index b6eb20e..48f8f8d 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -56,10 +56,10 @@ extern "C" {
#define TCL_MAJOR_VERSION 8
#define TCL_MINOR_VERSION 6
#define TCL_RELEASE_LEVEL TCL_FINAL_RELEASE
-#define TCL_RELEASE_SERIAL 5
+#define TCL_RELEASE_SERIAL 6
#define TCL_VERSION "8.6"
-#define TCL_PATCH_LEVEL "8.6.5"
+#define TCL_PATCH_LEVEL "8.6.6"
/*
*----------------------------------------------------------------------------
@@ -1165,6 +1165,18 @@ typedef Tcl_HashEntry * (Tcl_AllocHashEntryProc) (Tcl_HashTable *tablePtr,
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.
*/
@@ -1173,9 +1185,15 @@ 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: */
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e5d7406..d6a460d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -128,7 +128,7 @@ static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected,
int actual, Tcl_Obj *const *objv);
static Tcl_NRPostProc NRCoroutineCallerCallback;
static Tcl_NRPostProc NRCoroutineExitCallback;
-static int NRCommand(ClientData data[], Tcl_Interp *interp, int result);
+static Tcl_NRPostProc NRCommand;
static Tcl_ObjCmdProc OldMathFuncProc;
static void OldMathFuncDeleteProc(ClientData clientData);
@@ -146,7 +146,6 @@ static int TEOV_RunEnterTraces(Tcl_Interp *interp,
Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc,
Tcl_Obj *const objv[]);
static Tcl_NRPostProc RewindCoroutineCallback;
-static Tcl_NRPostProc TailcallCleanup;
static Tcl_NRPostProc TEOEx_ByteCodeCallback;
static Tcl_NRPostProc TEOEx_ListCallback;
static Tcl_NRPostProc TEOV_Error;
@@ -723,9 +722,7 @@ Tcl_CreateInterp(void)
* Initialize the ensemble error message rewriting support.
*/
- iPtr->ensembleRewrite.sourceObjs = NULL;
- iPtr->ensembleRewrite.numRemovedObjs = 0;
- iPtr->ensembleRewrite.numInsertedObjs = 0;
+ TclResetRewriteEnsemble(interp, 1);
/*
* TIP#143: Initialise the resource limit support.
@@ -4220,7 +4217,7 @@ EvalObjvCore(
* TCL_EVAL_INVOKE was not set: clear rewrite rules
*/
- iPtr->ensembleRewrite.sourceObjs = NULL;
+ TclResetRewriteEnsemble(interp, 1);
if (flags & TCL_EVAL_GLOBAL) {
TEOV_SwitchVarFrame(interp);
@@ -8373,7 +8370,7 @@ TclNRTailcallEval(
* a now-gone namespace: cleanup and return.
*/
- TailcallCleanup(data, interp, result);
+ Tcl_DecrRefCount(listPtr);
return result;
}
@@ -8382,18 +8379,26 @@ TclNRTailcallEval(
*/
TclMarkTailcall(interp);
- TclNRAddCallback(interp, TailcallCleanup, listPtr, NULL, NULL,NULL);
+ TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
iPtr->lookupNsPtr = (Namespace *) nsPtr;
return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL);
}
-static int
-TailcallCleanup(
+int
+TclNRReleaseValues(
ClientData data[],
Tcl_Interp *interp,
int result)
{
- Tcl_DecrRefCount((Tcl_Obj *) data[0]);
+ int i = 0;
+ while (i < 4) {
+ if (data[i]) {
+ Tcl_DecrRefCount((Tcl_Obj *) data[i]);
+ } else {
+ break;
+ }
+ i++;
+ }
return result;
}
diff --git a/generic/tclClock.c b/generic/tclClock.c
index 949cb1c..c3b29e9 100644
--- a/generic/tclClock.c
+++ b/generic/tclClock.c
@@ -1499,7 +1499,19 @@ GetJulianDayFromEraYearMonthDay(
* Try an initial conversion in the Gregorian calendar.
*/
+#if 0 /* BUG http://core.tcl.tk/tcl/tktview?name=da340d4f32 */
ym1o4 = ym1 / 4;
+#else
+ /*
+ * Have to make sure quotient is truncated towards 0 when negative.
+ * See above bug for details. The casts are necessary.
+ */
+ if (ym1 >= 0)
+ ym1o4 = ym1 / 4;
+ else {
+ ym1o4 = - (int) (((unsigned int) -ym1) / 4);
+ }
+#endif
if (ym1 % 4 < 0) {
ym1o4--;
}
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 54e0227..88cc17d 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -12,6 +12,9 @@
*/
#include "tclInt.h"
+#ifdef _WIN32
+# include "tclWinInt.h"
+#endif
#include <locale.h>
/*
@@ -1157,6 +1160,16 @@ FileAttrAccessTimeCmd(
if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
+#if defined(_WIN32)
+ /* We use a value of 0 to indicate the access time not available */
+ if (buf.st_atime == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not get access time for file \"%s\"",
+ TclGetString(objv[1])));
+ return TCL_ERROR;
+ }
+#endif
+
if (objc == 3) {
/*
* Need separate variable for reading longs from an object on 64-bit
@@ -1229,6 +1242,15 @@ FileAttrModifyTimeCmd(
if (GetStatBuf(interp, objv[1], Tcl_FSStat, &buf) != TCL_OK) {
return TCL_ERROR;
}
+#if defined(_WIN32)
+ /* We use a value of 0 to indicate the modification time not available */
+ if (buf.st_mtime == 0) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "could not get modification time for file \"%s\"",
+ TclGetString(objv[1])));
+ return TCL_ERROR;
+ }
+#endif
if (objc == 3) {
/*
* Need separate variable for reading longs from an object on 64-bit
@@ -1574,28 +1596,25 @@ FileAttrIsOwnedCmd(
int objc,
Tcl_Obj *const objv[])
{
+#ifdef __CYGWIN__
+#define geteuid() (short)(geteuid)()
+#endif
+#if !defined(_WIN32)
Tcl_StatBuf buf;
+#endif
int value = 0;
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
return TCL_ERROR;
}
- if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
- /*
- * For Windows, there are no user ids associated with a file, so we
- * always return 1.
- *
- * TODO: use GetSecurityInfo to get the real owner of the file and
- * test for equivalence to the current user.
- */
-
-#if defined(_WIN32) || defined(__CYGWIN__)
- value = 1;
+#if defined(_WIN32)
+ value = TclWinFileOwned(objv[1]);
#else
+ if (GetStatBuf(NULL, objv[1], Tcl_FSStat, &buf) == TCL_OK) {
value = (geteuid() == buf.st_uid);
-#endif
}
+#endif
Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
return TCL_OK;
}
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index c93e593..0a1b4fe 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -105,8 +105,7 @@ typedef struct SortInfo {
*/
static int DictionaryCompare(const char *left, const char *right);
-static int IfConditionCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc IfConditionCallback;
static int InfoArgsCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int InfoBodyCmd(ClientData dummy, Tcl_Interp *interp,
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 13f9e7d..885a0bc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -22,14 +22,10 @@
static inline Tcl_Obj * During(Tcl_Interp *interp, int resultCode,
Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
-static int SwitchPostProc(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostBody(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostFinal(ClientData data[], Tcl_Interp *interp,
- int result);
-static int TryPostHandler(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc SwitchPostProc;
+static Tcl_NRPostProc TryPostBody;
+static Tcl_NRPostProc TryPostFinal;
+static Tcl_NRPostProc TryPostHandler;
static int UniCharIsAscii(int character);
static int UniCharIsHexDigit(int character);
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index c8474e6..428173d 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -70,18 +70,12 @@ static inline void DeleteChainTable(struct Dict *dict);
static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
Tcl_Obj *keyPtr, int *newPtr);
static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
-static int FinalizeDictUpdate(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeDictWith(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DictForNRCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
-static int DictMapNRCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const *objv);
-static int DictForLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
-static int DictMapLoopCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeDictUpdate;
+static Tcl_NRPostProc FinalizeDictWith;
+static Tcl_ObjCmdProc DictForNRCmd;
+static Tcl_ObjCmdProc DictMapNRCmd;
+static Tcl_NRPostProc DictForLoopCallback;
+static Tcl_NRPostProc DictMapLoopCallback;
/*
* Table of dict subcommand names and implementations.
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index c85fe13..1d616fb 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -6,7 +6,7 @@
*
* Copyright (c) 1996-1998 Sun Microsystems, Inc.
* Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
- * Copyright (c) 2013 Donal K. Fellows.
+ * Copyright (c) 2013-2016 Donal K. Fellows.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -1279,9 +1279,11 @@ Tcl_DisassembleObjCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const types[] = {
+ "constructor", "destructor",
"lambda", "method", "objmethod", "proc", "script", NULL
};
enum Types {
+ DISAS_CLASS_CONSTRUCTOR, DISAS_CLASS_DESTRUCTOR,
DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
DISAS_SCRIPT
};
@@ -1290,6 +1292,7 @@ Tcl_DisassembleObjCmd(
Proc *procPtr = NULL;
Tcl_HashEntry *hPtr;
Object *oPtr;
+ Method *methodPtr;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "type ...");
@@ -1384,6 +1387,136 @@ Tcl_DisassembleObjCmd(
codeObjPtr = objv[2];
break;
+ case DISAS_CLASS_CONSTRUCTOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a constructor.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ methodPtr = oPtr->classPtr->constructorPtr;
+ if (methodPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" has no defined constructor",
+ TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "CONSRUCTOR", NULL);
+ return TCL_ERROR;
+ }
+ procPtr = TclOOGetProcFromMethod(methodPtr);
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of constructor", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile if necessary.
+ */
+
+ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of constructor",
+ TclGetString(objv[2]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+
+ case DISAS_CLASS_DESTRUCTOR:
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "className");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the body of a destructor.
+ */
+
+ oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+ if (oPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (oPtr->classPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" is not a class", TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+ TclGetString(objv[2]), NULL);
+ return TCL_ERROR;
+ }
+
+ methodPtr = oPtr->classPtr->destructorPtr;
+ if (methodPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" has no defined destructor",
+ TclGetString(objv[2])));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "DESRUCTOR", NULL);
+ return TCL_ERROR;
+ }
+ procPtr = TclOOGetProcFromMethod(methodPtr);
+ if (procPtr == NULL) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "body not available for this kind of destructor", -1));
+ Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+ "METHODTYPE", NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compile if necessary.
+ */
+
+ if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+ Command cmd;
+
+ /*
+ * Yes, this is ugly, but we need to pass the namespace in to the
+ * compiler in two places.
+ */
+
+ cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+ procPtr->cmdPtr = &cmd;
+ result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+ (Namespace *) oPtr->namespacePtr, "body of destructor",
+ TclGetString(objv[2]));
+ procPtr->cmdPtr = NULL;
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ codeObjPtr = procPtr->bodyPtr;
+ break;
+
case DISAS_CLASS_METHOD:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c
index 5b96730..5c65a3c 100644
--- a/generic/tclEncoding.c
+++ b/generic/tclEncoding.c
@@ -367,7 +367,6 @@ DupEncodingIntRep(
Tcl_Obj *dupPtr)
{
dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
- dupPtr->typePtr = &encodingType;
}
/*
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 986a553..8e5e410 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -30,11 +30,10 @@ static int NsEnsembleStringOrder(const void *strPtr1,
const void *strPtr2);
static void DeleteEnsembleConfig(ClientData clientData);
static void MakeCachedEnsembleCommand(Tcl_Obj *objPtr,
- EnsembleConfig *ensemblePtr,
- const char *subcmdName, Tcl_Obj *prefixObjPtr);
+ EnsembleConfig *ensemblePtr, Tcl_HashEntry *hPtr,
+ Tcl_Obj *fix);
static void FreeEnsembleCmdRep(Tcl_Obj *objPtr);
static void DupEnsembleCmdRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static void StringOfEnsembleCmdRep(Tcl_Obj *objPtr);
static void CompileToInvokedCommand(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Tcl_Obj *replacements,
Command *cmdPtr, CompileEnv *envPtr);
@@ -42,6 +41,8 @@ static int CompileBasicNArgCommand(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
CompileEnv *envPtr);
+static Tcl_NRPostProc FreeER;
+
/*
* The lists of subcommands and options for the [namespace ensemble] command.
*/
@@ -77,14 +78,30 @@ enum EnsConfigOpts {
* that implements it.
*/
-const Tcl_ObjType tclEnsembleCmdType = {
+static const Tcl_ObjType ensembleCmdType = {
"ensembleCommand", /* the type's name */
FreeEnsembleCmdRep, /* freeIntRepProc */
DupEnsembleCmdRep, /* dupIntRepProc */
- StringOfEnsembleCmdRep, /* updateStringProc */
+ NULL, /* updateStringProc */
NULL /* setFromAnyProc */
};
+/*
+ * The internal rep for caching ensemble subcommand lookups and
+ * spell corrections.
+ */
+
+typedef struct {
+ 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. */
+} EnsembleCmdRep;
+
static inline Tcl_Obj *
NewNsObj(
@@ -1643,6 +1660,8 @@ NsEnsembleImplementationCmdNR(
* names. */
int reparseCount = 0; /* Number of reparses. */
Tcl_Obj *errorObj; /* Used for building error messages. */
+ Tcl_Obj *subObj;
+ int subIdx;
/*
* Must recheck objc, since numParameters might have changed. Cf. test
@@ -1650,24 +1669,18 @@ NsEnsembleImplementationCmdNR(
*/
restartEnsembleParse:
- if (objc < 2 + ensemblePtr->numParameters) {
+ subIdx = 1 + ensemblePtr->numParameters;
+ if (objc < subIdx + 1) {
/*
* We don't have a subcommand argument. Make error message.
*/
Tcl_DString buf; /* Message being built */
- Tcl_Obj **elemPtrs; /* Parameter names */
- int len; /* Number of parameters to append */
Tcl_DStringInit(&buf);
- if (ensemblePtr->parameterList == NULL) {
- len = 0;
- } else if (TclListObjGetElements(NULL, ensemblePtr->parameterList,
- &len, &elemPtrs) != TCL_OK) {
- Tcl_Panic("List of ensemble parameters is not a list");
- }
- for (; len>0; len--,elemPtrs++) {
- TclDStringAppendObj(&buf, *elemPtrs);
+ if (ensemblePtr->parameterList) {
+ Tcl_DStringAppend(&buf,
+ TclGetString(ensemblePtr->parameterList), -1);
TclDStringAppendLiteral(&buf, " ");
}
TclDStringAppendLiteral(&buf, "subcommand ?arg ...?");
@@ -1695,6 +1708,8 @@ NsEnsembleImplementationCmdNR(
* up in there and go straight to dispatch.
*/
+ subObj = objv[subIdx];
+
if (ensemblePtr->epoch == ensemblePtr->nsPtr->exportLookupEpoch) {
/*
* Table of subcommands is still valid; therefore there might be a
@@ -1703,15 +1718,16 @@ NsEnsembleImplementationCmdNR(
* part where we do the invocation of the subcommand.
*/
- if (objv[1+ensemblePtr->numParameters]->typePtr==&tclEnsembleCmdType){
- EnsembleCmdRep *ensembleCmd = objv[1+ensemblePtr->numParameters]
- ->internalRep.twoPtrValue.ptr1;
+ if (subObj->typePtr==&ensembleCmdType){
+ EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
- if (ensembleCmd->nsPtr == ensemblePtr->nsPtr &&
- ensembleCmd->epoch == ensemblePtr->epoch &&
- ensembleCmd->token == ensemblePtr->token) {
- prefixObj = ensembleCmd->realPrefixObj;
+ if (ensembleCmd->epoch == ensemblePtr->epoch &&
+ ensembleCmd->token == (Command *)ensemblePtr->token) {
+ prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
Tcl_IncrRefCount(prefixObj);
+ if (ensembleCmd->fix) {
+ TclSpellFix(interp, objv, objc, subIdx, subObj, ensembleCmd->fix);
+ }
goto runResultingSubcommand;
}
}
@@ -1726,18 +1742,14 @@ NsEnsembleImplementationCmdNR(
*/
hPtr = Tcl_FindHashEntry(&ensemblePtr->subcommandTable,
- TclGetString(objv[1 + ensemblePtr->numParameters]));
+ TclGetString(subObj));
if (hPtr != NULL) {
- char *fullName = Tcl_GetHashKey(&ensemblePtr->subcommandTable, hPtr);
-
- prefixObj = Tcl_GetHashValue(hPtr);
/*
* Cache for later in the subcommand object.
*/
- MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
- ensemblePtr, fullName, prefixObj);
+ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, NULL);
} else if (!(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX)) {
/*
* Could not map, no prefixing, go to unknown/error handling.
@@ -1757,9 +1769,9 @@ NsEnsembleImplementationCmdNR(
char *fullName = NULL; /* Full name of the subcommand. */
int stringLength, i;
int tableLength = ensemblePtr->subcommandTable.numEntries;
+ Tcl_Obj *fix;
- subcmdName = TclGetString(objv[1 + ensemblePtr->numParameters]);
- stringLength = objv[1 + ensemblePtr->numParameters]->length;
+ subcmdName = Tcl_GetStringFromObj(subObj, &stringLength);
for (i=0 ; i<tableLength ; i++) {
register int cmp = strncmp(subcmdName,
ensemblePtr->subcommandArrayPtr[i],
@@ -1799,16 +1811,22 @@ NsEnsembleImplementationCmdNR(
Tcl_Panic("full name %s not found in supposedly synchronized hash",
fullName);
}
- prefixObj = Tcl_GetHashValue(hPtr);
+
+ /*
+ * Record the spelling correction for usage message.
+ */
+
+ fix = Tcl_NewStringObj(fullName, -1);
/*
* Cache for later in the subcommand object.
*/
- MakeCachedEnsembleCommand(objv[1 + ensemblePtr->numParameters],
- ensemblePtr, fullName, prefixObj);
+ MakeCachedEnsembleCommand(subObj, ensemblePtr, hPtr, fix);
+ TclSpellFix(interp, objv, objc, subIdx, subObj, fix);
}
+ prefixObj = Tcl_GetHashValue(hPtr);
Tcl_IncrRefCount(prefixObj);
runResultingSubcommand:
@@ -1827,47 +1845,26 @@ NsEnsembleImplementationCmdNR(
*/
{
- Tcl_Obj **prefixObjv; /* The list of objects to substitute in as the
- * target command prefix. */
Tcl_Obj *copyPtr; /* The actual list of words to dispatch to.
* Will be freed by the dispatch engine. */
- int prefixObjc, copyObjc;
- Interp *iPtr = (Interp *) interp;
+ Tcl_Obj **copyObjv;
+ int copyObjc, prefixObjc;
- /*
- * Get the prefix that we're rewriting to. To do this we need to
- * ensure that the internal representation of the list does not change
- * so that we can safely keep the internal representations of the
- * elements in the list.
- *
- * TODO: Use conventional list operations to make this code sane!
- */
+ Tcl_ListObjLength(NULL, prefixObj, &prefixObjc);
- TclListObjGetElements(NULL, prefixObj, &prefixObjc, &prefixObjv);
-
- copyObjc = objc - 2 + prefixObjc;
- copyPtr = Tcl_NewListObj(copyObjc, NULL);
- if (copyObjc > 0) {
- register Tcl_Obj **copyObjv;
- /* Space used to construct the list of
- * arguments to pass to the command that
- * implements the ensemble subcommand. */
- register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
- register int i;
-
- listRepPtr->elemCount = copyObjc;
- copyObjv = &listRepPtr->elements;
- memcpy(copyObjv, prefixObjv, sizeof(Tcl_Obj *) * prefixObjc);
- memcpy(copyObjv+prefixObjc, objv+1,
- sizeof(Tcl_Obj *) * ensemblePtr->numParameters);
- memcpy(copyObjv+prefixObjc+ensemblePtr->numParameters,
- objv+ensemblePtr->numParameters+2,
- sizeof(Tcl_Obj *) * (objc-ensemblePtr->numParameters-2));
-
- for (i=0; i < copyObjc; i++) {
- Tcl_IncrRefCount(copyObjv[i]);
- }
- }
+ if (objc == 2) {
+ copyPtr = TclListObjCopy(NULL, prefixObj);
+ } else {
+ copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
+ Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ ensemblePtr->numParameters, objv + 1);
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ objc - 2 - ensemblePtr->numParameters,
+ objv + 2 + ensemblePtr->numParameters);
+ }
+ Tcl_IncrRefCount(copyPtr);
+ TclNRAddCallback(interp, TclNRReleaseValues, copyPtr, NULL, NULL, NULL);
TclDecrRefCount(prefixObj);
/*
@@ -1876,25 +1873,10 @@ NsEnsembleImplementationCmdNR(
* count both as inserted and removed arguments.
*/
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs =
- 2 + ensemblePtr->numParameters;
- iPtr->ensembleRewrite.numInsertedObjs =
- prefixObjc + ensemblePtr->numParameters;
+ if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters,
+ prefixObjc + ensemblePtr->numParameters, objv)) {
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
NULL);
- } else {
- register int ni = 2 + ensemblePtr->numParameters
- - iPtr->ensembleRewrite.numInsertedObjs;
- /* Position in objv of new front of insertion
- * relative to old one. */
- if (ni > 0) {
- iPtr->ensembleRewrite.numRemovedObjs += ni;
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
- }
}
/*
@@ -1902,7 +1884,8 @@ NsEnsembleImplementationCmdNR(
*/
TclSkipTailcall(interp);
- return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
+ Tcl_ListObjGetElements(NULL, copyPtr, &copyObjc, &copyObjv);
+ return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL);
}
unknownOrAmbiguousSubcommand:
@@ -1934,20 +1917,17 @@ NsEnsembleImplementationCmdNR(
Tcl_ResetResult(interp);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
+ TclGetString(subObj), NULL);
if (ensemblePtr->subcommandTable.numEntries == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"unknown subcommand \"%s\": namespace %s does not"
- " export any commands",
- TclGetString(objv[1+ensemblePtr->numParameters]),
+ " export any commands", TclGetString(subObj),
ensemblePtr->nsPtr->fullName));
- Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "SUBCOMMAND",
- TclGetString(objv[1+ensemblePtr->numParameters]), NULL);
return TCL_ERROR;
}
errorObj = Tcl_ObjPrintf("unknown%s subcommand \"%s\": must be ",
(ensemblePtr->flags & TCL_ENSEMBLE_PREFIX ? " or ambiguous" : ""),
- TclGetString(objv[1+ensemblePtr->numParameters]));
+ TclGetString(subObj));
if (ensemblePtr->subcommandTable.numEntries == 1) {
Tcl_AppendToObj(errorObj, ensemblePtr->subcommandArrayPtr[0], -1);
} else {
@@ -2013,7 +1993,7 @@ TclInitRewriteEnsemble(
if (numIns < numRemoved) {
iPtr->ensembleRewrite.numRemovedObjs += numRemoved - numIns;
- iPtr->ensembleRewrite.numInsertedObjs += numInserted - 1;
+ iPtr->ensembleRewrite.numInsertedObjs = numInserted;
} else {
iPtr->ensembleRewrite.numInsertedObjs += numInserted - numRemoved;
}
@@ -2054,6 +2034,149 @@ TclResetRewriteEnsemble(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclSpellFix --
+ *
+ * Record a spelling correction that needs making in the
+ * generation of the WrongNumArgs usage message.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Can create an alternative ensemble rewrite structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FreeER(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ Tcl_Obj **tmp = (Tcl_Obj **)data[0];
+
+ ckfree(tmp[2]);
+ ckfree(tmp);
+ return result;
+}
+
+void
+TclSpellFix(
+ Tcl_Interp *interp,
+ Tcl_Obj *const *objv,
+ int objc,
+ int badIdx,
+ Tcl_Obj *bad,
+ Tcl_Obj *fix)
+{
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Obj *const *search;
+ Tcl_Obj **store;
+ int idx;
+ int size;
+
+ if (iPtr->ensembleRewrite.sourceObjs == NULL) {
+ iPtr->ensembleRewrite.sourceObjs = objv;
+ iPtr->ensembleRewrite.numRemovedObjs = 0;
+ iPtr->ensembleRewrite.numInsertedObjs = 0;
+ }
+
+ /* Compute the valid length of the ensemble root */
+
+ size = iPtr->ensembleRewrite.numRemovedObjs + objc
+ - iPtr->ensembleRewrite.numInsertedObjs;
+
+ search = iPtr->ensembleRewrite.sourceObjs;
+ if (search[0] == NULL) {
+ /* Awful casting abuse here */
+ search = (Tcl_Obj *const *) search[1];
+ }
+
+ if (badIdx < iPtr->ensembleRewrite.numInsertedObjs) {
+ /*
+ * Misspelled value was inserted. We cannot directly jump
+ * to the bad value, but have to search.
+ */
+ idx = 1;
+ while (idx < size) {
+ if (search[idx] == bad) {
+ break;
+ }
+ idx++;
+ }
+ if (idx == size) {
+ return;
+ }
+ } else {
+ /* Jump to the misspelled value. */
+ idx = iPtr->ensembleRewrite.numRemovedObjs + badIdx
+ - iPtr->ensembleRewrite.numInsertedObjs;
+
+ /* Verify */
+ if (search[idx] != bad) {
+ Tcl_Panic("SpellFix: programming error");
+ }
+ }
+
+ search = iPtr->ensembleRewrite.sourceObjs;
+ if (search[0] == NULL) {
+ store = (Tcl_Obj **)search[2];
+ } else {
+ Tcl_Obj **tmp = ckalloc(3 * sizeof(Tcl_Obj *));
+ tmp[0] = NULL;
+ tmp[1] = (Tcl_Obj *)iPtr->ensembleRewrite.sourceObjs;
+ tmp[2] = (Tcl_Obj *)ckalloc(size * sizeof(Tcl_Obj *));
+ memcpy(tmp[2], tmp[1], size*sizeof(Tcl_Obj *));
+
+ iPtr->ensembleRewrite.sourceObjs = (Tcl_Obj *const *) tmp;
+ TclNRAddCallback(interp, FreeER, tmp, NULL, NULL, NULL);
+ store = (Tcl_Obj **)tmp[2];
+ }
+
+ store[idx] = fix;
+ Tcl_IncrRefCount(fix);
+ TclNRAddCallback(interp, TclNRReleaseValues, fix, NULL, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclFetchEnsembleRoot --
+ *
+ * Returns the root of ensemble rewriting, if any.
+ * If no root exists, returns objv instead.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *const *
+TclFetchEnsembleRoot(
+ Tcl_Interp *interp,
+ Tcl_Obj *const *objv,
+ int objc,
+ int *objcPtr)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (iPtr->ensembleRewrite.sourceObjs) {
+ *objcPtr = objc + iPtr->ensembleRewrite.numRemovedObjs
+ - iPtr->ensembleRewrite.numInsertedObjs;
+ return iPtr->ensembleRewrite.sourceObjs;
+ }
+ *objcPtr = objc;
+ return objv;
+}
+
+/*
* ----------------------------------------------------------------------
*
* EnsmebleUnknownCallback --
@@ -2218,17 +2341,17 @@ static void
MakeCachedEnsembleCommand(
Tcl_Obj *objPtr,
EnsembleConfig *ensemblePtr,
- const char *subcommandName,
- Tcl_Obj *prefixObjPtr)
+ Tcl_HashEntry *hPtr,
+ Tcl_Obj *fix)
{
register EnsembleCmdRep *ensembleCmd;
- int length;
- if (objPtr->typePtr == &tclEnsembleCmdType) {
+ if (objPtr->typePtr == &ensembleCmdType) {
ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- TclNsDecrRefCount(ensembleCmd->nsPtr);
- ckfree(ensembleCmd->fullSubcmdName);
+ TclCleanupCommandMacro(ensembleCmd->token);
+ if (ensembleCmd->fix) {
+ Tcl_DecrRefCount(ensembleCmd->fix);
+ }
} else {
/*
* Kill the old internal rep, and replace it with a brand new one of
@@ -2238,22 +2361,21 @@ MakeCachedEnsembleCommand(
TclFreeIntRep(objPtr);
ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
- objPtr->typePtr = &tclEnsembleCmdType;
+ objPtr->typePtr = &ensembleCmdType;
}
/*
* Populate the internal rep.
*/
- ensembleCmd->nsPtr = ensemblePtr->nsPtr;
ensembleCmd->epoch = ensemblePtr->epoch;
- ensembleCmd->token = ensemblePtr->token;
- ensemblePtr->nsPtr->refCount++;
- ensembleCmd->realPrefixObj = prefixObjPtr;
- length = strlen(subcommandName)+1;
- ensembleCmd->fullSubcmdName = ckalloc(length);
- memcpy(ensembleCmd->fullSubcmdName, subcommandName, (unsigned) length);
- Tcl_IncrRefCount(ensembleCmd->realPrefixObj);
+ ensembleCmd->token = (Command *) ensemblePtr->token;
+ ensembleCmd->token->refCount++;
+ if (fix) {
+ Tcl_IncrRefCount(fix);
+ }
+ ensembleCmd->fix = fix;
+ ensembleCmd->hPtr = hPtr;
}
/*
@@ -2634,9 +2756,10 @@ FreeEnsembleCmdRep(
{
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- Tcl_DecrRefCount(ensembleCmd->realPrefixObj);
- ckfree(ensembleCmd->fullSubcmdName);
- TclNsDecrRefCount(ensembleCmd->nsPtr);
+ TclCleanupCommandMacro(ensembleCmd->token);
+ if (ensembleCmd->fix) {
+ Tcl_DecrRefCount(ensembleCmd->fix);
+ }
ckfree(ensembleCmd);
objPtr->typePtr = NULL;
}
@@ -2666,48 +2789,17 @@ DupEnsembleCmdRep(
{
EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
- int length = strlen(ensembleCmd->fullSubcmdName);
- copyPtr->typePtr = &tclEnsembleCmdType;
+ copyPtr->typePtr = &ensembleCmdType;
copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
- ensembleCopy->nsPtr = ensembleCmd->nsPtr;
ensembleCopy->epoch = ensembleCmd->epoch;
ensembleCopy->token = ensembleCmd->token;
- ensembleCopy->nsPtr->refCount++;
- ensembleCopy->realPrefixObj = ensembleCmd->realPrefixObj;
- Tcl_IncrRefCount(ensembleCopy->realPrefixObj);
- ensembleCopy->fullSubcmdName = ckalloc(length + 1);
- memcpy(ensembleCopy->fullSubcmdName, ensembleCmd->fullSubcmdName,
- (unsigned) length+1);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * StringOfEnsembleCmdRep --
- *
- * Creates a string representation of a Tcl_Obj that holds a subcommand
- * of an ensemble.
- *
- * Results:
- * None.
- *
- * Side effects:
- * The object gains a string (UTF-8) representation.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-StringOfEnsembleCmdRep(
- Tcl_Obj *objPtr)
-{
- EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
- int length = strlen(ensembleCmd->fullSubcmdName);
-
- objPtr->length = length;
- objPtr->bytes = ckalloc(length + 1);
- memcpy(objPtr->bytes, ensembleCmd->fullSubcmdName, (unsigned) length+1);
+ ensembleCopy->token->refCount++;
+ ensembleCopy->fix = ensembleCmd->fix;
+ if (ensembleCopy->fix) {
+ Tcl_IncrRefCount(ensembleCopy->fix);
+ }
+ ensembleCopy->hPtr = ensembleCmd->hPtr;
}
/*
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 70ccc05..e539161 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -35,14 +35,14 @@
#endif
/*
- * 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.
+ * 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.
*/
-#ifndef ASYNC_CHECK_COUNT
-# define ASYNC_CHECK_COUNT 64
-#endif /* !ASYNC_CHECK_COUNT */
+#ifndef ASYNC_CHECK_COUNT_MASK
+# define ASYNC_CHECK_COUNT_MASK 63
+#endif /* !ASYNC_CHECK_COUNT_MASK */
/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
@@ -2078,6 +2078,13 @@ TclNRExecuteByteCode(
#endif
/*
+ * Test namespace-50.9 demonstrates the need for this call.
+ * Use a --enable-symbols=mem bug to see.
+ */
+
+ TclResetRewriteEnsemble(interp, 1);
+
+ /*
* Push the callback for bytecode execution
*/
@@ -2115,14 +2122,8 @@ TEBCresume(
* sporadically: no special need for speed.
*/
- 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. */
+ int instructionCount = 0; /* Counter that is used to work out when to
+ * call Tcl_AsyncReady() */
const char *curInstName;
#ifdef TCL_COMPILE_DEBUG
int traceInstructions; /* Whether we are doing instruction-level
@@ -2320,11 +2321,10 @@ TEBCresume(
/*
* Check for asynchronous handlers [Bug 746722]; we do the check every
- * ASYNC_CHECK_COUNT instructions.
+ * ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-1).
*/
- if ((--interruptCounter) == 0) {
- interruptCounter = ASYNC_CHECK_COUNT;
+ if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
DECACHE_STACK_INFO();
if (TclAsyncReady(iPtr)) {
result = Tcl_AsyncInvoke(interp, result);
@@ -3160,35 +3160,34 @@ TEBCresume(
fflush(stdout);
}
#endif /*TCL_COMPILE_DEBUG*/
- {
- Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
- register List *listRepPtr = copyPtr->internalRep.twoPtrValue.ptr1;
- Tcl_Obj **copyObjv = &listRepPtr->elements;
- int i;
- listRepPtr->elemCount = objc - opnd + 1;
- copyObjv[0] = objPtr;
- memcpy(copyObjv+1, objv+opnd, sizeof(Tcl_Obj *) * (objc - opnd));
- for (i=1 ; i<objc-opnd+1 ; i++) {
- Tcl_IncrRefCount(copyObjv[i]);
- }
- objPtr = copyPtr;
- }
bcFramePtr->data.tebc.pc = (char *) pc;
iPtr->cmdFramePtr = bcFramePtr;
if (iPtr->flags & INTERP_DEBUG_FRAME) {
ArgumentBCEnter(interp, codePtr, TD, pc, objc, objv);
}
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = opnd;
- iPtr->ensembleRewrite.numInsertedObjs = 1;
+
+ TclInitRewriteEnsemble(interp, opnd, 1, objv);
+
+ {
+ Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL);
+
+ Tcl_ListObjAppendElement(NULL, copyPtr, objPtr);
+ Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0,
+ objc - opnd, objv + opnd);
+ Tcl_DecrRefCount(objPtr);
+ objPtr = copyPtr;
+ }
+
DECACHE_STACK_INFO();
pc += 6;
TEBC_YIELD();
TclMarkTailcall(interp);
- TclNRAddCallback(interp, TclClearRootEnsemble, NULL,NULL,NULL,NULL);
- return TclNREvalObjEx(interp, objPtr, TCL_EVAL_INVOKE, NULL, INT_MIN);
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv);
+ TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL);
+ return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL);
/*
* -----------------------------------------------------------------
@@ -4421,8 +4420,8 @@ TEBCresume(
savedNsPtr = iPtr->varFramePtr->nsPtr;
iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
otherPtr = TclObjLookupVarEx(interp, OBJ_AT_TOS, NULL,
- (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
- /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+ (TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
+ "access", /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
iPtr->varFramePtr->nsPtr = savedNsPtr;
if (!otherPtr) {
TRACE_ERROR(interp);
diff --git a/generic/tclHash.c b/generic/tclHash.c
index 3ea9dd9..1991aea 100644
--- a/generic/tclHash.c
+++ b/generic/tclHash.c
@@ -321,9 +321,11 @@ 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;
@@ -334,9 +336,11 @@ 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;
@@ -364,9 +368,15 @@ 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++;
/*
@@ -406,7 +416,9 @@ Tcl_DeleteHashEntry(
const Tcl_HashKeyType *typePtr;
Tcl_HashTable *tablePtr;
Tcl_HashEntry **bucketPtr;
+#if TCL_HASH_KEY_STORE_HASH
int index;
+#endif
tablePtr = entryPtr->tablePtr;
@@ -421,6 +433,7 @@ 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));
@@ -429,6 +442,9 @@ Tcl_DeleteHashEntry(
}
bucketPtr = &tablePtr->buckets[index];
+#else
+ bucketPtr = entryPtr->bucketPtr;
+#endif
if (*bucketPtr == entryPtr) {
*bucketPtr = entryPtr->nextPtr;
@@ -1046,6 +1062,7 @@ 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));
@@ -1054,6 +1071,26 @@ 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/tclIO.c b/generic/tclIO.c
index f93d00d..80f6fa4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -313,15 +313,20 @@ static int WillRead(Channel *chanPtr);
&& (strncmp(optionName, (nameString), len) == 0))
/*
- * The ChannelObjType type. We actually store the ChannelState structure
- * as that lives longest and we want to return the bottomChanPtr when
- * requested (consistent with Tcl_GetChannel). The setFromAny and
- * updateString can be NULL as they should not be called.
+ * The ChannelObjType type. Used to store the result of looking up
+ * a channel name in the context of an interp. Saves the lookup
+ * result and values needed to check its continued validity.
*/
+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
+ * was done. Use to verify validity. */
+ int refCount; /* Share this struct among many Tcl_Obj. */
+} ResolvedChanName;
+
static void DupChannelIntRep(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
-static int SetChannelFromAny(Tcl_Interp *interp,
- Tcl_Obj *objPtr);
static void FreeChannelIntRep(Tcl_Obj *objPtr);
static const Tcl_ObjType chanObjType = {
@@ -329,18 +334,9 @@ static const Tcl_ObjType chanObjType = {
FreeChannelIntRep, /* freeIntRepProc */
DupChannelIntRep, /* dupIntRepProc */
NULL, /* updateStringProc */
- NULL /* setFromAnyProc SetChannelFromAny */
+ NULL /* setFromAnyProc */
};
-#define GET_CHANNELSTATE(objPtr) \
- ((ChannelState *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_CHANNELSTATE(objPtr, storePtr) \
- ((objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (storePtr))
-#define GET_CHANNELINTERP(objPtr) \
- ((Tcl_Interp *) (objPtr)->internalRep.twoPtrValue.ptr2)
-#define SET_CHANNELINTERP(objPtr, storePtr) \
- ((objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (storePtr))
-
#define BUSY_STATE(st, fl) \
((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
(((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
@@ -1021,7 +1017,7 @@ DeleteChannelTable(
*/
Tcl_DeleteHashEntry(hPtr);
- SetFlag(statePtr, CHANNEL_TAINTED);
+ statePtr->epoch++;
if (statePtr->refCount-- <= 1) {
if (!GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
(void) Tcl_Close(interp, (Tcl_Channel) chanPtr);
@@ -1365,7 +1361,7 @@ DetachChannel(
return TCL_ERROR;
}
Tcl_DeleteHashEntry(hPtr);
- SetFlag(statePtr, CHANNEL_TAINTED);
+ statePtr->epoch++;
/*
* Remove channel handlers that refer to this interpreter, so that
@@ -1498,12 +1494,57 @@ TclGetChannelFromObj(
int flags)
{
ChannelState *statePtr;
+ ResolvedChanName *resPtr = NULL;
+ Tcl_Channel chan;
+
+ if (interp == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (objPtr->typePtr == &chanObjType) {
+ /*
+ * 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. */
+ goto valid;
+ }
+ }
+
+ chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
- if (SetChannelFromAny(interp, objPtr) != TCL_OK) {
+ if (chan == NULL) {
+ if (resPtr) {
+ FreeChannelIntRep(objPtr);
+ }
return TCL_ERROR;
}
- statePtr = GET_CHANNELSTATE(objPtr);
+ if (resPtr && resPtr->refCount == 1) {
+ /* 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;
+ }
+ statePtr = ((Channel *)chan)->state;
+ resPtr->statePtr = statePtr;
+ Tcl_Preserve((ClientData) statePtr);
+ resPtr->interp = interp;
+ resPtr->epoch = statePtr->epoch;
+
+ valid:
*channelPtr = (Tcl_Channel) statePtr->bottomChanPtr;
if (modePtr != NULL) {
@@ -1676,6 +1717,8 @@ Tcl_CreateChannel(
statePtr->chanMsg = NULL;
statePtr->unreportedMsg = NULL;
+ statePtr->epoch = 0;
+
/*
* Link the channel into the list of all channels; create an on-exit
* handler if there is not one already, to close off all the channels in
@@ -11121,78 +11164,16 @@ DupChannelIntRep(
register Tcl_Obj *copyPtr) /* Object with internal rep to set. Must not
* currently have an internal rep.*/
{
- ChannelState *statePtr = GET_CHANNELSTATE(srcPtr);
+ ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- SET_CHANNELSTATE(copyPtr, statePtr);
- SET_CHANNELINTERP(copyPtr, GET_CHANNELINTERP(srcPtr));
- Tcl_Preserve(statePtr);
+ resPtr->refCount++;
+ copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->typePtr = srcPtr->typePtr;
}
/*
*----------------------------------------------------------------------
*
- * SetChannelFromAny --
- *
- * Create an internal representation of type "Channel" for an object.
- *
- * Results:
- * This operation always succeeds and returns TCL_OK.
- *
- * Side effects:
- * Any old internal reputation for objPtr is freed and the internal
- * representation is set to "Channel".
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetChannelFromAny(
- Tcl_Interp *interp, /* Used for error reporting if not NULL. */
- register Tcl_Obj *objPtr) /* The object to convert. */
-{
- ChannelState *statePtr;
-
- if (interp == NULL) {
- return TCL_ERROR;
- }
- if (objPtr->typePtr == &chanObjType) {
- /*
- * TODO: TAINT Flag and dup'd channel values?
- * The channel is valid until any call to DetachChannel occurs.
- * Ensure consistency checks are done.
- */
-
- statePtr = GET_CHANNELSTATE(objPtr);
- if (GotFlag(statePtr, CHANNEL_TAINTED|CHANNEL_CLOSED)) {
- ResetFlag(statePtr, CHANNEL_TAINTED);
- Tcl_Release(statePtr);
- objPtr->typePtr = NULL;
- } else if (interp != GET_CHANNELINTERP(objPtr)) {
- Tcl_Release(statePtr);
- objPtr->typePtr = NULL;
- }
- }
- if (objPtr->typePtr != &chanObjType) {
- Tcl_Channel chan = Tcl_GetChannel(interp, TclGetString(objPtr), NULL);
-
- if (chan == NULL) {
- return TCL_ERROR;
- }
-
- TclFreeIntRep(objPtr);
- statePtr = ((Channel *) chan)->state;
- Tcl_Preserve(statePtr);
- SET_CHANNELSTATE(objPtr, statePtr);
- SET_CHANNELINTERP(objPtr, interp);
- objPtr->typePtr = &chanObjType;
- }
- return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* FreeChannelIntRep --
*
* Release statePtr storage.
@@ -11210,8 +11191,14 @@ static void
FreeChannelIntRep(
Tcl_Obj *objPtr) /* Object with internal rep to free. */
{
- Tcl_Release(GET_CHANNELSTATE(objPtr));
+ ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
objPtr->typePtr = NULL;
+ if (--resPtr->refCount) {
+ return;
+ }
+ Tcl_Release(resPtr->statePtr);
+ ckfree(resPtr);
}
#if 0
diff --git a/generic/tclIO.h b/generic/tclIO.h
index b799375..ffbfa31 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -214,6 +214,8 @@ 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
+ * lookup results. */
} ChannelState;
/*
@@ -275,10 +277,6 @@ typedef struct ChannelState {
* usable, but it may not be closed
* again from within the close
* handler. */
-#define CHANNEL_TAINTED (1<<20) /* Channel stack structure has changed.
- * Used by Channel Tcl_Obj type to
- * determine if we have to revalidate
- * the channel. */
#define CHANNEL_CLOSEDWRITE (1<<21) /* Channel write side has been closed.
* No further Tcl-level write IO on
* the channel is allowed. */
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index de65da5..834f225 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -16,7 +16,7 @@
*/
typedef struct AcceptCallback {
- Tcl_Obj *script; /* Script to invoke. */
+ char *script; /* Script to invoke. */
Tcl_Interp *interp; /* Interpreter in which to run it. */
} AcceptCallback;
@@ -37,7 +37,8 @@ static Tcl_ThreadDataKey dataKey;
*/
static void FinalizeIOCmdTSD(ClientData clientData);
-static Tcl_TcpAcceptProc AcceptCallbackProc;
+static void AcceptCallbackProc(ClientData callbackData,
+ Tcl_Channel chan, char *address, int port);
static int ChanPendingObjCmd(ClientData unused,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -1372,22 +1373,15 @@ AcceptCallbackProc(
*/
if (acceptCallbackPtr->interp != NULL) {
+ char portBuf[TCL_INTEGER_SPACE];
+ char *script = acceptCallbackPtr->script;
Tcl_Interp *interp = acceptCallbackPtr->interp;
- Tcl_Obj *script, *objv[2];
- int result = TCL_OK;
-
- 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]);
+ int result;
+ Tcl_Preserve(script);
Tcl_Preserve(interp);
+
+ TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
/*
@@ -1397,9 +1391,8 @@ AcceptCallbackProc(
Tcl_RegisterChannel(NULL, chan);
- result = Tcl_EvalObjEx(interp, script, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
- Tcl_DecrRefCount(script);
-
+ result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
+ " ", address, " ", portBuf, NULL);
if (result != TCL_OK) {
Tcl_BackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
@@ -1413,6 +1406,7 @@ 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
@@ -1456,7 +1450,7 @@ TcpServerCloseProc(
UnregisterTcpServerInterpCleanupProc(acceptCallbackPtr->interp,
acceptCallbackPtr);
}
- Tcl_DecrRefCount(acceptCallbackPtr->script);
+ Tcl_EventuallyFree(acceptCallbackPtr->script, TCL_DYNAMIC);
ckfree(acceptCallbackPtr);
}
@@ -1491,8 +1485,7 @@ Tcl_SocketObjCmd(
SKT_ASYNC, SKT_MYADDR, SKT_MYPORT, SKT_SERVER
};
int optionIndex, a, server = 0, port, myport = 0, async = 0;
- const char *host, *myaddr = NULL;
- Tcl_Obj *script = NULL;
+ const char *host, *script = NULL, *myaddr = NULL;
Tcl_Channel chan;
if (TclpHasSockets(interp) != TCL_OK) {
@@ -1555,7 +1548,7 @@ Tcl_SocketObjCmd(
"no argument given for -server option", -1));
return TCL_ERROR;
}
- script = objv[a];
+ script = TclGetString(objv[a]);
break;
default:
Tcl_Panic("Tcl_SocketObjCmd: bad option index to SocketOptions");
@@ -1596,14 +1589,16 @@ Tcl_SocketObjCmd(
if (server) {
AcceptCallback *acceptCallbackPtr =
ckalloc(sizeof(AcceptCallback));
+ unsigned len = strlen(script) + 1;
+ char *copyScript = ckalloc(len);
- Tcl_IncrRefCount(script);
- acceptCallbackPtr->script = script;
+ memcpy(copyScript, script, len);
+ acceptCallbackPtr->script = copyScript;
acceptCallbackPtr->interp = interp;
chan = Tcl_OpenTcpServer(interp, port, host, AcceptCallbackProc,
acceptCallbackPtr);
if (chan == NULL) {
- Tcl_DecrRefCount(script);
+ ckfree(copyScript);
ckfree(acceptCallbackPtr);
return TCL_ERROR;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 0ef6d3b..142693e 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -71,8 +71,7 @@ typedef struct ThreadSpecificData {
* Prototypes for functions defined later in this file.
*/
-static int EvalFileCallback(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc EvalFileCallback;
static FilesystemRecord*FsGetFirstFilesystem(void);
static void FsThrExitProc(ClientData cd);
static Tcl_Obj * FsListMounts(Tcl_Obj *pathPtr, const char *pattern);
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index ce8b9fb..0e0ddc9 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -925,6 +925,14 @@ Tcl_WrongNumArgs(
Tcl_Obj *const *origObjv = iPtr->ensembleRewrite.sourceObjs;
/*
+ * Check for spelling fixes, and substitute the fixed values.
+ */
+
+ if (origObjv[0] == NULL) {
+ origObjv = (Tcl_Obj *const *)origObjv[2];
+ }
+
+ /*
* We only know how to do rewriting if all the replaced objects are
* actually arguments (in objv) to this function. Otherwise it just
* gets too complicated and we'd be better off just giving a slightly
@@ -957,12 +965,6 @@ Tcl_WrongNumArgs(
elementStr = EXPAND_OF(indexRep);
elemLen = strlen(elementStr);
- } else if (origObjv[i]->typePtr == &tclEnsembleCmdType) {
- register EnsembleCmdRep *ecrPtr =
- origObjv[i]->internalRep.twoPtrValue.ptr1;
-
- elementStr = ecrPtr->fullSubcmdName;
- elemLen = strlen(elementStr);
} else {
elementStr = TclGetStringFromObj(origObjv[i], &elemLen);
}
@@ -1011,11 +1013,6 @@ Tcl_WrongNumArgs(
register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
- } else if (objv[i]->typePtr == &tclEnsembleCmdType) {
- register EnsembleCmdRep *ecrPtr =
- objv[i]->internalRep.twoPtrValue.ptr1;
-
- Tcl_AppendStringsToObj(objPtr, ecrPtr->fullSubcmdName, NULL);
} else {
/*
* Quote the argument if it contains spaces (Bug 942757).
diff --git a/generic/tclInt.h b/generic/tclInt.h
index cd49c85..8445931 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -168,6 +168,35 @@ typedef struct Tcl_ResolverInfo {
/* Procedure handling variable name resolution
* at compile time. */
} Tcl_ResolverInfo;
+/*
+ * This flag bit should not interfere with TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
+ * lookup is performed for upvar (or similar) purposes, with slightly
+ * different rules:
+ * - Bug #696893 - variable is either proc-local or in the current
+ * namespace; never follow the second (global) resolution path
+ * - Bug #631741 - do not use special namespace or interp resolvers
+ *
+ * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
+ * (Bug #835020)
+ */
+
+#define TCL_AVOID_RESOLVERS 0x40000
+
+/*
+ * This flag bit should not interfere with TCL_GLOBAL_ONLY,
+ * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
+ * lookup is performed for upvar (or similar) purposes, with slightly
+ * different rules:
+ * - Bug #696893 - variable is either proc-local or in the current
+ * namespace; never follow the second (global) resolution path
+ * - Bug #631741 - do not use special namespace or interp resolvers
+ *
+ * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
+ * (Bug #835020)
+ */
+
+#define TCL_AVOID_RESOLVERS 0x40000
/*
*----------------------------------------------------------------
@@ -390,27 +419,6 @@ struct NamespacePathEntry {
#define TCL_FIND_ONLY_NS 0x1000
/*
- * The data cached in an ensemble subcommand's Tcl_Obj rep (reference in
- * twoPtrValue.ptr1 field). This structure is not shared between Tcl_Objs
- * referring to the same subcommand, even where one is a duplicate of another.
- */
-
-typedef struct {
- Namespace *nsPtr; /* The namespace backing the ensemble which
- * this is a subcommand of. */
- int epoch; /* Used to confirm when the data in this
- * really structure matches up with the
- * ensemble. */
- Tcl_Command token; /* Reference to the comamnd for which this
- * structure is a cache of the resolution. */
- char *fullSubcmdName; /* The full (local) name of the subcommand,
- * allocated with ckalloc(). */
- Tcl_Obj *realPrefixObj; /* Object containing the prefix words of the
- * command that implements this ensemble
- * subcommand. */
-} EnsembleCmdRep;
-
-/*
* The client data for an ensemble command. This consists of the table of
* commands that are actually exported by the namespace, and an epoch counter
* that, combined with the exportLookupEpoch field of the namespace structure,
@@ -2762,6 +2770,7 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldmObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd;
MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke;
+MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues;
MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr);
MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp);
@@ -2872,8 +2881,7 @@ MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
-MODULE_SCOPE int TclClearRootEnsemble(ClientData data[],
- Tcl_Interp *interp, int result);
+MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, int num,
int *loc);
MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj *objPtr,
@@ -2909,6 +2917,8 @@ 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,
+ Tcl_Obj *const *objv, int objc, int *objcPtr);
MODULE_SCOPE void TclFinalizeAllocSubsystem(void);
MODULE_SCOPE void TclFinalizeAsync(void);
MODULE_SCOPE void TclFinalizeDoubleConversion(void);
@@ -3112,6 +3122,9 @@ MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result);
+MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp,
+ Tcl_Obj *const *objv, int objc, int subIdx,
+ Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void * TclStackRealloc(Tcl_Interp *interp, void *ptr,
int numBytes);
MODULE_SCOPE int TclStringMatch(const char *str, int strLen,
@@ -3135,7 +3148,6 @@ MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
const char *trim, int numTrim);
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
-MODULE_SCOPE 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,
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index cd0dc18..66ce1e0 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -1795,11 +1795,9 @@ AliasNRCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument vector. */
{
- Interp *iPtr = (Interp *) interp;
Alias *aliasPtr = clientData;
int prefc, cmdc, i;
Tcl_Obj **prefv, **cmdv;
- int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
Tcl_Obj *listPtr;
List *listRep;
int flags = TCL_EVAL_INVOKE;
@@ -1831,21 +1829,7 @@ AliasNRCmd(
* only the source command should show, not the full target prefix.
*/
- if (isRootEnsemble) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 1;
- iPtr->ensembleRewrite.numInsertedObjs = prefc;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
- }
-
- /*
- * We are sending a 0-refCount obj, do not need a callback: it will be
- * cleaned up automatically. But we may need to clear the rootEnsemble
- * stuff ...
- */
-
- if (isRootEnsemble) {
+ if (TclInitRewriteEnsemble(interp, 1, prefc, objv)) {
TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
TclSkipTailcall(interp);
@@ -1866,7 +1850,7 @@ AliasObjCmd(
Tcl_Obj **prefv, **cmdv;
Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
Interp *tPtr = (Interp *) targetInterp;
- int isRootEnsemble = (tPtr->ensembleRewrite.sourceObjs == NULL);
+ int isRootEnsemble;
/*
* Append the arguments to the command prefix and invoke the command in
@@ -1896,13 +1880,7 @@ AliasObjCmd(
* only the source command should show, not the full target prefix.
*/
- if (isRootEnsemble) {
- tPtr->ensembleRewrite.sourceObjs = objv;
- tPtr->ensembleRewrite.numRemovedObjs = 1;
- tPtr->ensembleRewrite.numInsertedObjs = prefc;
- } else {
- tPtr->ensembleRewrite.numInsertedObjs += prefc - 1;
- }
+ isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)tPtr, 1, prefc, objv);
/*
* Protect the target interpreter if it isn't the same as the source
@@ -1925,9 +1903,7 @@ AliasObjCmd(
*/
if (isRootEnsemble) {
- tPtr->ensembleRewrite.sourceObjs = NULL;
- tPtr->ensembleRewrite.numRemovedObjs = 0;
- tPtr->ensembleRewrite.numInsertedObjs = 0;
+ TclResetRewriteEnsemble((Tcl_Interp *)tPtr, 1);
}
/*
diff --git a/generic/tclMain.c b/generic/tclMain.c
index 6946375..1a390b9 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -335,6 +335,7 @@ Tcl_MainEx(
#ifdef ZIPFS_IN_TCL
const char *zipFile = NULL;
Tcl_Obj *zipval = NULL;
+ Tcl_Obj *checkAppName = NULL;
int autoRun = 1;
int zipOk = TCL_ERROR;
#ifndef ANDROID
@@ -410,6 +411,9 @@ Tcl_MainEx(
if (path == NULL) {
appName = NewNativeObj(argv[0], -1);
} else {
+#ifdef ZIPFS_IN_TCL
+ checkAppName = path;
+#endif
appName = path;
}
Tcl_SetVar2Ex(interp, "argv0", NULL, appName, TCL_GLOBAL_ONLY);
@@ -496,7 +500,7 @@ Tcl_MainEx(
zipval = NULL;
}
#endif
-
+
/*
* Invoke application-specific initialization.
*/
@@ -565,18 +569,41 @@ Tcl_MainEx(
*/
if ((zipOk == TCL_OK) && autoRun) {
- char *filename;
+ int pushBack = 1;
+ char *filename = NULL;
Tcl_Channel chan;
-#ifdef ZIPFS_BOOTDIR
- filename = ZIPFS_BOOTDIR "/app/main.tcl";
-#else
Tcl_DString dsFile;
Tcl_DStringInit(&dsFile);
+#ifdef ZIPFS_BOOTDIR
+ Tcl_DStringAppend(&dsFile, ZIPFS_BOOTDIR, -1);
+#else
Tcl_DStringAppend(&dsFile, Tcl_GetString(mntpt), -1);
- Tcl_DStringAppend(&dsFile, "/app/main.tcl", -1);
- filename = Tcl_DStringValue(&dsFile);
#endif
+ if (checkAppName != NULL) {
+ filename = Tcl_GetString(checkAppName);
+ if ((strlen(filename) > 8) &&
+ (strncasecmp(filename, "builtin:", 8) == 0)) {
+ filename += 8;
+ while (filename[0] == '/') {
+ ++filename;
+ }
+ if (filename[0] != '\0') {
+ pushBack = 0;
+ } else {
+ filename = NULL;
+ }
+ } else {
+ filename = NULL;
+ }
+ }
+ if (filename != NULL) {
+ Tcl_DStringAppend(&dsFile, "/", 1);
+ Tcl_DStringAppend(&dsFile, filename, -1);
+ } else {
+ Tcl_DStringAppend(&dsFile, "/app/main.tcl", -1);
+ }
+ filename = Tcl_DStringValue(&dsFile);
chan = Tcl_OpenFileChannel(NULL, filename, "r", 0);
if (chan != (Tcl_Channel) NULL) {
Tcl_Obj *arg;
@@ -586,7 +613,7 @@ Tcl_MainEx(
/*
* Push back script file to argv, if any.
*/
- if ((arg = Tcl_GetStartupScript(NULL)) != NULL) {
+ if (pushBack && (arg = Tcl_GetStartupScript(NULL)) != NULL) {
Tcl_Obj *v, *no;
no = Tcl_NewStringObj("argv", 4);
@@ -605,18 +632,18 @@ Tcl_MainEx(
if (Tcl_ObjSetVar2(interp, no, NULL, nv, TCL_GLOBAL_ONLY)
!= NULL) {
Tcl_GlobalEval(interp, "incr argc");
- }
+ }
Tcl_DecrRefCount(nv);
}
Tcl_DecrRefCount(no);
}
Tcl_SetStartupScript(Tcl_NewStringObj(filename, -1), NULL);
- Tcl_SetVar(interp, "argv0", filename, TCL_GLOBAL_ONLY);
+ if (pushBack) {
+ Tcl_SetVar(interp, "argv0", filename, TCL_GLOBAL_ONLY);
+ }
Tcl_SetVar(interp, "tcl_interactive", "0", TCL_GLOBAL_ONLY);
}
-#ifndef ANDROID
Tcl_DStringFree(&dsFile);
-#endif
}
#endif
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index 58a86d9..5930859 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -3354,14 +3354,7 @@ NRNamespaceEvalCmd(
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- framePtr->objc = objc;
- framePtr->objv = objv;
- } else {
- framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
- - iPtr->ensembleRewrite.numInsertedObjs;
- framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
- }
+ framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
if (objc == 3) {
/*
@@ -3768,7 +3761,6 @@ NRNamespaceInscopeCmd(
{
Tcl_Namespace *namespacePtr;
CallFrame *framePtr, **framePtrPtr;
- register Interp *iPtr = (Interp *) interp;
int i;
Tcl_Obj *cmdObjPtr;
@@ -3794,14 +3786,7 @@ NRNamespaceInscopeCmd(
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
namespacePtr, /*isProcCallFrame*/ 0);
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- framePtr->objc = objc;
- framePtr->objv = objv;
- } else {
- framePtr->objc = objc + iPtr->ensembleRewrite.numRemovedObjs
- - iPtr->ensembleRewrite.numInsertedObjs;
- framePtr->objv = iPtr->ensembleRewrite.sourceObjs;
- }
+ framePtr->objv = TclFetchEnsembleRoot(interp, objv, objc, &framePtr->objc);
/*
* Execute the command. If there is just one argument, just treat it as a
@@ -4553,8 +4538,8 @@ NamespaceUpvarCmd(
savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
otherPtr = TclObjLookupVarEx(interp, objv[0], NULL,
- (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
- /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+ (TCL_NAMESPACE_ONLY|TCL_LEAVE_ERR_MSG|TCL_AVOID_RESOLVERS),
+ "access", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
if (otherPtr == NULL) {
return TCL_ERROR;
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 9df5029..ec666ee 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -68,12 +68,9 @@ static int CloneObjectMethod(Tcl_Interp *interp, Object *oPtr,
static void DeletedDefineNamespace(ClientData clientData);
static void DeletedObjdefNamespace(ClientData clientData);
static void DeletedHelpersNamespace(ClientData clientData);
-static int FinalizeAlloc(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeNext(ClientData data[],
- Tcl_Interp *interp, int result);
-static int FinalizeObjectCall(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeAlloc;
+static Tcl_NRPostProc FinalizeNext;
+static Tcl_NRPostProc FinalizeObjectCall;
static int InitFoundation(Tcl_Interp *interp);
static void KillFoundation(ClientData clientData,
Tcl_Interp *interp);
@@ -1687,7 +1684,7 @@ Tcl_NewObjectInstance(
TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);
if (contextPtr != NULL) {
- int result;
+ int isRoot, result;
Tcl_InterpState state;
state = Tcl_SaveInterpState(interp, TCL_OK);
@@ -1698,13 +1695,14 @@ Tcl_NewObjectInstance(
* Adjust the ensmble tracking record if necessary. [Bug 3514761]
*/
- if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
- ((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
- ((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
- }
+ isRoot = TclInitRewriteEnsemble(interp, skip, skip, objv);
result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
objc, objv);
+ if (isRoot) {
+ TclResetRewriteEnsemble(interp, 1);
+ }
+
/*
* It's an error if the object was whacked in the constructor.
* Force this if it isn't already an error (don't want to lose
@@ -1827,9 +1825,8 @@ TclNRNewObjectInstance(
* Adjust the ensmble tracking record if necessary. [Bug 3514761]
*/
- if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
- ((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
- ((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
+ if (TclInitRewriteEnsemble(interp, skip, skip, objv)) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
/*
diff --git a/generic/tclOO.h b/generic/tclOO.h
index 696908a..46f01fb 100644
--- a/generic/tclOO.h
+++ b/generic/tclOO.h
@@ -24,7 +24,7 @@
* win/tclooConfig.sh
*/
-#define TCLOO_VERSION "1.0.4"
+#define TCLOO_VERSION "1.0.5"
#define TCLOO_PATCHLEVEL TCLOO_VERSION
#include "tcl.h"
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index facf90d..1797760 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -70,15 +70,12 @@ static void AddSimpleClassChainToCallContext(Class *classPtr,
Class *const filterDecl);
static int CmpStr(const void *ptr1, const void *ptr2);
static void DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
-static int FinalizeMethodRefs(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc FinalizeMethodRefs;
static void FreeMethodNameRep(Tcl_Obj *objPtr);
static inline int IsStillValid(CallChain *callPtr, Object *oPtr,
int flags, int reuseMask);
-static int ResetFilterFlags(ClientData data[],
- Tcl_Interp *interp, int result);
-static int SetFilterFlags(ClientData data[],
- Tcl_Interp *interp, int result);
+static Tcl_NRPostProc ResetFilterFlags;
+static Tcl_NRPostProc SetFilterFlags;
static inline void StashCallChain(Tcl_Obj *objPtr, CallChain *callPtr);
/*
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index c880754..8747ff5 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -847,9 +847,8 @@ TclOODefineObjCmd(
TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
- int dummy;
+ int isRoot, dummy;
/*
* More than one argument: fire them through the ensemble processing
@@ -861,18 +860,7 @@ TclOODefineObjCmd(
* the moment. Ugly!
*/
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 3;
- iPtr->ensembleRewrite.numInsertedObjs = 1;
- } else {
- int ni = iPtr->ensembleRewrite.numInsertedObjs;
- if (ni < 3) {
- iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs -= 2;
- }
- }
+ isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
/*
* Build the list of arguments using a Tcl_Obj as a workspace. See
@@ -894,6 +882,9 @@ TclOODefineObjCmd(
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
+ if (isRoot) {
+ TclResetRewriteEnsemble(interp, 1);
+ }
Tcl_DecrRefCount(objPtr);
}
DelRef(oPtr);
@@ -927,7 +918,7 @@ TclOOObjDefObjCmd(
Tcl_Obj *const *objv)
{
Foundation *fPtr = TclOOGetFoundation(interp);
- int result;
+ int isRoot, result;
Object *oPtr;
if (objc < 3) {
@@ -962,7 +953,6 @@ TclOOObjDefObjCmd(
TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
int dummy;
@@ -976,18 +966,7 @@ TclOOObjDefObjCmd(
* the moment. Ugly!
*/
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 3;
- iPtr->ensembleRewrite.numInsertedObjs = 1;
- } else {
- int ni = iPtr->ensembleRewrite.numInsertedObjs;
- if (ni < 3) {
- iPtr->ensembleRewrite.numRemovedObjs += 3 - ni;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs -= 2;
- }
- }
+ isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
/*
* Build the list of arguments using a Tcl_Obj as a workspace. See
@@ -1009,6 +988,10 @@ TclOOObjDefObjCmd(
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
+
+ if (isRoot) {
+ TclResetRewriteEnsemble(interp, 1);
+ }
Tcl_DecrRefCount(objPtr);
}
DelRef(oPtr);
@@ -1077,9 +1060,8 @@ TclOODefineSelfObjCmd(
TclDecrRefCount(objNameObj);
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Interp *iPtr = (Interp *) interp;
Tcl_Command cmd;
- int dummy;
+ int isRoot, dummy;
/*
* More than one argument: fire them through the ensemble processing
@@ -1091,18 +1073,7 @@ TclOODefineSelfObjCmd(
* the moment. Ugly!
*/
- if (iPtr->ensembleRewrite.sourceObjs == NULL) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 2;
- iPtr->ensembleRewrite.numInsertedObjs = 1;
- } else {
- int ni = iPtr->ensembleRewrite.numInsertedObjs;
- if (ni < 2) {
- iPtr->ensembleRewrite.numRemovedObjs += 2 - ni;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs -= 1;
- }
- }
+ isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv);
/*
* Build the list of arguments using a Tcl_Obj as a workspace. See
@@ -1124,6 +1095,9 @@ TclOODefineSelfObjCmd(
Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
+ if (isRoot) {
+ TclResetRewriteEnsemble(interp, 1);
+ }
Tcl_DecrRefCount(objPtr);
}
DelRef(oPtr);
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 34fa108..99a8bfc 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -70,10 +70,8 @@ static Tcl_Obj ** InitEnsembleRewrite(Tcl_Interp *interp, int objc,
static int InvokeProcedureMethod(ClientData clientData,
Tcl_Interp *interp, Tcl_ObjectContext context,
int objc, Tcl_Obj *const *objv);
-static int FinalizeForwardCall(ClientData data[], Tcl_Interp *interp,
- int result);
-static int FinalizePMCall(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc FinalizeForwardCall;
+static Tcl_NRPostProc FinalizePMCall;
static int PushMethodCallFrame(Tcl_Interp *interp,
CallContext *contextPtr, ProcedureMethod *pmPtr,
int objc, Tcl_Obj *const *objv,
@@ -1458,6 +1456,11 @@ InvokeForwardMethod(
argObjs = InitEnsembleRewrite(interp, objc, objv, skip,
numPrefixes, prefixObjs, &len);
Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL);
+ /*
+ * NOTE: The combination of direct set of iPtr->lookupNsPtr and the use
+ * of the TCL_EVAL_NOERR flag results in an evaluation configuration
+ * very much like TCL_EVAL_INVOKE.
+ */
((Interp *)interp)->lookupNsPtr
= (Namespace *) contextPtr->oPtr->namespacePtr;
return TclNREvalObjv(interp, len, argObjs, TCL_EVAL_NOERR, NULL);
@@ -1594,12 +1597,9 @@ InitEnsembleRewrite(
int *lengthPtr) /* Where to write the resulting length of the
* array of rewritten arguments. */
{
- Interp *iPtr = (Interp *) interp;
- int isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
- Tcl_Obj **argObjs;
unsigned len = rewriteLength + objc - toRewrite;
+ Tcl_Obj **argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
- argObjs = TclStackAlloc(interp, sizeof(Tcl_Obj *) * len);
memcpy(argObjs, rewriteObjs, rewriteLength * sizeof(Tcl_Obj *));
memcpy(argObjs + rewriteLength, objv + toRewrite,
sizeof(Tcl_Obj *) * (objc - toRewrite));
@@ -1613,22 +1613,9 @@ InitEnsembleRewrite(
* (and unavoidably).
*/
- if (isRootEnsemble) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = toRewrite;
- iPtr->ensembleRewrite.numInsertedObjs = rewriteLength;
- } else {
- int numIns = iPtr->ensembleRewrite.numInsertedObjs;
-
- if (numIns < toRewrite) {
- iPtr->ensembleRewrite.numRemovedObjs += toRewrite - numIns;
- iPtr->ensembleRewrite.numInsertedObjs += rewriteLength - 1;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs +=
- rewriteLength - toRewrite;
- }
+ if (TclInitRewriteEnsemble(interp, toRewrite, rewriteLength, objv)) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
}
-
*lengthPtr = len;
return argObjs;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index a45a392..628c3a7 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4176,7 +4176,7 @@ Tcl_GetCommandFromObj(
* had is invalid one way or another.
*/
- /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
+ /* See [] why we cannot call SetCmdNameFromAny() directly here. */
if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
return NULL;
}
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index 99d576d..c2643bf 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -869,12 +869,16 @@ TclJoinPath(
* object which can be normalized more efficiently. Currently we only
* use the special case when we have exactly two elements, but we
* could expand that in the future.
+ *
+ * Bugfix [a47641a0]. TclNewFSPathObj requires first argument
+ * to be an absolute path. Added a check for that elt is absolute.
*/
if ((i == (elements-2)) && (i == 0)
- && (elt->typePtr == &tclFsPathType)
- && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))) {
- Tcl_Obj *tailObj = objv[i+1];
+ && (elt->typePtr == &tclFsPathType)
+ && !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
+ && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
+ Tcl_Obj *tailObj = objv[i+1];
type = TclGetPathType(tailObj, NULL, NULL, NULL);
if (type == TCL_PATH_RELATIVE) {
diff --git a/generic/tclProc.c b/generic/tclProc.c
index e8c5955..ae9e7cd 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -22,7 +22,6 @@
*/
typedef struct {
- int isRootEnsemble;
Command cmd;
ExtraFrameInfo efi;
} ApplyExtraData;
@@ -1088,12 +1087,10 @@ ProcWrongNumArgs(
if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) {
desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1);
} else {
- ((Interp *) interp)->ensembleRewrite.numInsertedObjs -= skip - 1;
-
#ifdef AVOID_HACKS_FOR_ITCL
desiredObjs[0] = framePtr->objv[skip-1];
#else
- desiredObjs[0] = Tcl_NewListObj(skip, framePtr->objv);
+ desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1);
#endif /* AVOID_HACKS_FOR_ITCL */
}
Tcl_IncrRefCount(desiredObjs[0]);
@@ -1528,6 +1525,10 @@ InitArgsAndLocals(
*/
incorrectArgs:
+ if ((skip != 1) &&
+ TclInitRewriteEnsemble(interp, skip-1, 0, framePtr->objv)) {
+ TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
+ }
memset(varPtr, 0,
((framePtr->compiledLocals + localCt)-varPtr) * sizeof(Var));
return ProcWrongNumArgs(interp, skip);
@@ -2634,7 +2635,7 @@ TclNRApplyObjCmd(
Interp *iPtr = (Interp *) interp;
Proc *procPtr = NULL;
Tcl_Obj *lambdaPtr, *nsObjPtr;
- int result, isRootEnsemble;
+ int result;
Tcl_Namespace *nsPtr;
ApplyExtraData *extraPtr;
@@ -2717,16 +2718,6 @@ TclNRApplyObjCmd(
extraPtr->efi.fields[0].clientData = lambdaPtr;
extraPtr->cmd.clientData = &extraPtr->efi;
- isRootEnsemble = (iPtr->ensembleRewrite.sourceObjs == NULL);
- if (isRootEnsemble) {
- iPtr->ensembleRewrite.sourceObjs = objv;
- iPtr->ensembleRewrite.numRemovedObjs = 1;
- iPtr->ensembleRewrite.numInsertedObjs = 0;
- } else {
- iPtr->ensembleRewrite.numInsertedObjs -= 1;
- }
- extraPtr->isRootEnsemble = isRootEnsemble;
-
result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
if (result == TCL_OK) {
TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
@@ -2743,10 +2734,6 @@ ApplyNR2(
{
ApplyExtraData *extraPtr = data[0];
- if (extraPtr->isRootEnsemble) {
- ((Interp *) interp)->ensembleRewrite.sourceObjs = NULL;
- }
-
TclStackFree(interp, extraPtr);
return result;
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index b480735..11a57e9 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -39,6 +39,15 @@
#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
+
+/*
* Prototypes for functions defined later in this file:
*/
@@ -436,6 +445,18 @@ 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;
}
@@ -1152,7 +1173,11 @@ Tcl_AppendUnicodeToObj(
* objPtr's string rep.
*/
- if (stringPtr->hasUnicode) {
+ if (stringPtr->hasUnicode
+#if COMPAT
+ && stringPtr->numChars > 0
+#endif
+ ) {
AppendUnicodeToUnicodeRep(objPtr, unicode, length);
} else {
AppendUnicodeToUtfRep(objPtr, unicode, length);
@@ -1256,7 +1281,11 @@ Tcl_AppendObjToObj(
* appendObjPtr and append it.
*/
- if (stringPtr->hasUnicode) {
+ if (stringPtr->hasUnicode
+#if COMPAT
+ && stringPtr->numChars > 0
+#endif
+ ) {
/*
* If appendObjPtr is not of the "String" type, don't convert it.
*/
@@ -1289,7 +1318,11 @@ Tcl_AppendObjToObj(
AppendUtfToUtfRep(objPtr, bytes, length);
- if (numChars >= 0 && appendNumChars >= 0) {
+ if (numChars >= 0 && appendNumChars >= 0
+#if COMPAT
+ && appendNumChars == length
+#endif
+ ) {
stringPtr->numChars = numChars + appendNumChars;
}
}
@@ -1413,6 +1446,14 @@ AppendUnicodeToUtfRep(
if (stringPtr->numChars != -1) {
stringPtr->numChars += numChars;
}
+
+#if COMPAT
+ /*
+ * Invalidate the unicode rep.
+ */
+
+ stringPtr->hasUnicode = 0;
+#endif
}
/*
@@ -2830,6 +2871,7 @@ 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
@@ -2872,6 +2914,41 @@ 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;
@@ -2967,7 +3044,7 @@ ExtendStringRepWithUnicode(
*/
int i, origLength, size = 0;
- char *dst;
+ char *dst, buf[TCL_UTF_MAX];
String *stringPtr = GET_STRING(objPtr);
if (numChars < 0) {
@@ -2993,7 +3070,7 @@ ExtendStringRepWithUnicode(
}
for (i = 0; i < numChars && size >= 0; i++) {
- size += TclUtfCount(unicode[i]);
+ size += Tcl_UniCharToUtf((int) unicode[i], buf);
}
if (size < 0) {
Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7c30d36..e33d263 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -323,9 +323,6 @@ static int TestparsevarObjCmd(ClientData dummy,
static int TestparsevarnameObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int TestpreferstableObjCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
static int TestregexpObjCmd(ClientData dummy,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -416,8 +413,7 @@ static int TestHashSystemHashCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int NREUnwind_callback(ClientData data[], Tcl_Interp *interp,
- int result);
+static Tcl_NRPostProc NREUnwind_callback;
static int TestNREUnwind(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
@@ -656,8 +652,6 @@ Tcltest_Init(
NULL, NULL);
Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
NULL, NULL);
- Tcl_CreateObjCommand(interp, "testpreferstable", TestpreferstableObjCmd,
- NULL, NULL);
Tcl_CreateObjCommand(interp, "testregexp", TestregexpObjCmd,
NULL, NULL);
Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
@@ -3799,36 +3793,6 @@ 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(
- ClientData 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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* TestregexpObjCmd --
*
* This procedure implements the "testregexp" command. It is used to give
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index f36b07f..a637498 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -19,6 +19,7 @@
#endif
#include "tclInt.h"
#include "tommath.h"
+#include "tclStringRep.h"
/*
@@ -46,13 +47,6 @@ static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-
-typedef struct TestString {
- int numChars;
- int allocated;
- int maxChars;
- Tcl_UniChar unicode[2];
-} TestString;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
@@ -1141,7 +1135,7 @@ TeststringobjCmd(
int varIndex, option, i, length;
#define MAX_STRINGS 11
const char *index, *string, *strings[MAX_STRINGS+1];
- TestString *strPtr;
+ String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
diff --git a/generic/tclTomMath.h b/generic/tclTomMath.h
index dd9edaf..bb074ba 100644
--- a/generic/tclTomMath.h
+++ b/generic/tclTomMath.h
@@ -87,7 +87,7 @@ extern "C" {
# define DIGIT_BIT 60
#else
/* this is the default case, 28-bit digits */
-
+
/* this is to make porting into LibTomCrypt easier :-) */
#ifndef CRYPT
# if defined(_MSC_VER) || defined(__BORLANDC__)
@@ -105,14 +105,14 @@ extern "C" {
#endif
typedef ulong64 mp_word;
-#ifdef MP_31BIT
+#ifdef MP_31BIT
/* this is an extension that uses 31-bit digits */
# define DIGIT_BIT 31
#else
/* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
# define DIGIT_BIT 28
# define MP_28BIT
-#endif
+#endif
#endif
/* define heap macros */
@@ -646,7 +646,7 @@ int mp_prime_miller_rabin(mp_int *a, mp_int *b, int *result);
*/
/* This gives [for a given bit size] the number of trials required
- * such that Miller-Rabin gives a prob of failure lower than 2^-96
+ * such that Miller-Rabin gives a prob of failure lower than 2^-96
*/
/*
int mp_prime_rabin_miller_trials(int size);
@@ -673,7 +673,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
*/
/* makes a truly random prime of a given size (bytes),
- * call with bbs = 1 if you want it to be congruent to 3 mod 4
+ * call with bbs = 1 if you want it to be congruent to 3 mod 4
*
* You have to supply a callback which fills in a buffer with random bytes. "dat" is a parameter you can
* have passed to the callback (e.g. a state or something). This function doesn't use "dat" itself
@@ -686,7 +686,7 @@ int mp_prime_next_prime(mp_int *a, int t, int bbs_style);
/* makes a truly random prime of a given size (bits),
*
* Flags are as follows:
- *
+ *
* LTM_PRIME_BBS - make prime congruent to 3 mod 4
* LTM_PRIME_SAFE - make sure (p-1)/2 is prime as well (implies LTM_PRIME_BBS)
* LTM_PRIME_2MSB_OFF - make the 2nd highest bit zero
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 6c4cb7f..b878149 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -84,11 +84,17 @@ static const unsigned char totalBytes[256] = {
1,1,1,1
#endif
};
+
+/*
+ * Functions used only in this module.
+ */
+
+static int UtfCount(int ch);
/*
*---------------------------------------------------------------------------
*
- * TclUtfCount --
+ * UtfCount --
*
* Find the number of bytes in the Utf character "ch".
*
@@ -101,8 +107,8 @@ static const unsigned char totalBytes[256] = {
*---------------------------------------------------------------------------
*/
-int
-TclUtfCount(
+INLINE static int
+UtfCount(
int ch) /* The Tcl_UniChar whose size is returned. */
{
if ((ch > 0) && (ch < UNICODE_SELF)) {
@@ -137,7 +143,7 @@ TclUtfCount(
*---------------------------------------------------------------------------
*/
-int
+INLINE int
Tcl_UniCharToUtf(
int ch, /* The Tcl_UniChar to be stored in the
* buffer. */
@@ -823,7 +829,7 @@ Tcl_UtfToUpper(
* char to dst if its size is <= the original char.
*/
- if (bytes < TclUtfCount(upChar)) {
+ if (bytes < UtfCount(upChar)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -876,7 +882,7 @@ Tcl_UtfToLower(
* char to dst if its size is <= the original char.
*/
- if (bytes < TclUtfCount(lowChar)) {
+ if (bytes < UtfCount(lowChar)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -926,7 +932,7 @@ Tcl_UtfToTitle(
bytes = TclUtfToUniChar(src, &ch);
titleChar = Tcl_UniCharToTitle(ch);
- if (bytes < TclUtfCount(titleChar)) {
+ if (bytes < UtfCount(titleChar)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
@@ -938,7 +944,7 @@ Tcl_UtfToTitle(
bytes = TclUtfToUniChar(src, &ch);
lowChar = Tcl_UniCharToLower(ch);
- if (bytes < TclUtfCount(lowChar)) {
+ if (bytes < UtfCount(lowChar)) {
memcpy(dst, src, (size_t) bytes);
dst += bytes;
} else {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index ad1368f..2adffbc 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -206,6 +206,7 @@ static Tcl_UpdateStringProc PanicOnUpdateVarName;
static Tcl_FreeInternalRepProc FreeParsedVarName;
static Tcl_DupInternalRepProc DupParsedVarName;
+static Tcl_UpdateStringProc UpdateParsedVarName;
static Tcl_UpdateStringProc PanicOnUpdateVarName;
static Tcl_SetFromAnyProc PanicOnSetVarName;
@@ -218,10 +219,6 @@ static Tcl_SetFromAnyProc PanicOnSetVarName;
* or NULL if it is this same obj
* twoPtrValue.ptr2: index into locals table
*
- * nsVarName - INTERNALREP DEFINITION:
- * twoPtrValue.ptr1: pointer to the namespace containing the reference
- * twoPtrValue.ptr2: pointer to the corresponding Var
- *
* parsedVarName - INTERNALREP DEFINITION:
* twoPtrValue.ptr1: pointer to the array name Tcl_Obj, or NULL if it is a
* scalar variable
@@ -236,7 +233,7 @@ static const Tcl_ObjType localVarNameType = {
static const Tcl_ObjType tclParsedVarNameType = {
"parsedVarName",
- FreeParsedVarName, DupParsedVarName, PanicOnUpdateVarName, PanicOnSetVarName
+ FreeParsedVarName, DupParsedVarName, UpdateParsedVarName, PanicOnSetVarName
};
/*
@@ -535,6 +532,7 @@ TclObjLookupVarEx(
const char *errMsg = NULL;
CallFrame *varFramePtr = iPtr->varFramePtr;
const char *part2 = part2Ptr? TclGetString(part2Ptr):NULL;
+ char *newPart2 = NULL;
*arrayPtrPtr = NULL;
if (typePtr == &localVarNameType) {
@@ -581,7 +579,9 @@ TclObjLookupVarEx(
}
return NULL;
}
- if ((part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2)) {
+ part2 = newPart2 = part1Ptr->internalRep.twoPtrValue.ptr2;
+ if (newPart2) {
+ part2Ptr = Tcl_NewStringObj(newPart2, -1);
if (createPart2) {
Tcl_IncrRefCount(part2Ptr);
}
@@ -625,7 +625,11 @@ TclObjLookupVarEx(
len2 = len1 - i - 2;
len1 = i;
- part2Ptr = Tcl_NewStringObj(part2, len2);
+ newPart2 = ckalloc(len2 + 1);
+ memcpy(newPart2, part2, (unsigned) len2);
+ *(newPart2+len2) = '\0';
+ part2 = newPart2;
+ part2Ptr = Tcl_NewStringObj(newPart2, -1);
if (createPart2) {
Tcl_IncrRefCount(part2Ptr);
}
@@ -650,8 +654,7 @@ TclObjLookupVarEx(
Tcl_IncrRefCount(part1Ptr);
objPtr->internalRep.twoPtrValue.ptr1 = part1Ptr;
- Tcl_IncrRefCount(part2Ptr);
- objPtr->internalRep.twoPtrValue.ptr2 = part2Ptr;
+ objPtr->internalRep.twoPtrValue.ptr2 = (void *) part2;
typePtr = part1Ptr->typePtr;
part1 = TclGetString(part1Ptr);
@@ -676,6 +679,9 @@ TclObjLookupVarEx(
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
TclGetString(part1Ptr), NULL);
}
+ if (newPart2) {
+ Tcl_DecrRefCount(part2Ptr);
+ }
return NULL;
}
@@ -724,26 +730,14 @@ TclObjLookupVarEx(
*arrayPtrPtr = varPtr;
varPtr = TclLookupArrayElement(interp, part1Ptr, part2Ptr, flags, msg,
createPart1, createPart2, varPtr, -1);
+ if (newPart2) {
+ Tcl_DecrRefCount(part2Ptr);
+ }
}
return varPtr;
}
/*
- * This flag bit should not interfere with TCL_GLOBAL_ONLY,
- * TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG; it signals that the variable
- * lookup is performed for upvar (or similar) purposes, with slightly
- * different rules:
- * - Bug #696893 - variable is either proc-local or in the current
- * namespace; never follow the second (global) resolution path
- * - Bug #631741 - do not use special namespace or interp resolvers
- *
- * It should also not collide with the (deprecated) TCL_PARSE_PART1 flag
- * (Bug #835020)
- */
-
-#define AVOID_RESOLVERS 0x40000
-
-/*
*----------------------------------------------------------------------
*
* TclLookupSimpleVar --
@@ -792,8 +786,8 @@ TclLookupSimpleVar(
Tcl_Obj *varNamePtr, /* This is a simple variable name that could
* represent a scalar or an array. */
int flags, /* Only TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY,
- * AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG bits
- * matter. */
+ * TCL_AVOID_RESOLVERS and TCL_LEAVE_ERR_MSG
+ * bits matter. */
const int create, /* If 1, create hash table entry for varname,
* if it doesn't already exist. If 0, return
* error if it doesn't exist. */
@@ -833,7 +827,7 @@ TclLookupSimpleVar(
*/
if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)
- && !(flags & AVOID_RESOLVERS)) {
+ && !(flags & TCL_AVOID_RESOLVERS)) {
resPtr = iPtr->resolverPtr;
if (cxtNsPtr->varResProc) {
result = cxtNsPtr->varResProc(interp, varName,
@@ -886,7 +880,7 @@ TclLookupSimpleVar(
*indexPtr = -1;
flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
} else {
- if (flags & AVOID_RESOLVERS) {
+ if (flags & TCL_AVOID_RESOLVERS) {
flags = (flags | TCL_NAMESPACE_ONLY);
}
if (flags & TCL_NAMESPACE_ONLY) {
@@ -901,7 +895,7 @@ TclLookupSimpleVar(
varPtr = (Var *) ObjFindNamespaceVar(interp, varNamePtr,
(Tcl_Namespace *) cxtNsPtr,
- (flags | AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
+ (flags | TCL_AVOID_RESOLVERS) & ~TCL_LEAVE_ERR_MSG);
if (varPtr == NULL) {
Tcl_Obj *tailPtr;
@@ -4383,15 +4377,15 @@ TclPtrObjMakeUpvar(
/*
* Lookup and eventually create the new variable. Set the flag bit
- * AVOID_RESOLVERS to indicate the special resolution rules for upvar
- * purposes:
+ * TCL_AVOID_RESOLVERS to indicate the special resolution rules for
+ * upvar purposes:
* - Bug #696893 - variable is either proc-local or in the current
* namespace; never follow the second (global) resolution path.
* - Bug #631741 - do not use special namespace or interp resolvers.
*/
varPtr = TclLookupSimpleVar(interp, myNamePtr,
- myFlags|AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
+ myFlags|TCL_AVOID_RESOLVERS, /* create */ 1, &errMsg, &index);
if (varPtr == NULL) {
TclObjVarErrMsg(interp, myNamePtr, NULL, "create", errMsg, -1);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
@@ -5580,11 +5574,11 @@ FreeParsedVarName(
Tcl_Obj *objPtr)
{
register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
- register Tcl_Obj *elem = objPtr->internalRep.twoPtrValue.ptr2;
+ register char *elem = objPtr->internalRep.twoPtrValue.ptr2;
if (arrayPtr != NULL) {
TclDecrRefCount(arrayPtr);
- TclDecrRefCount(elem);
+ ckfree(elem);
}
objPtr->typePtr = NULL;
}
@@ -5595,17 +5589,58 @@ DupParsedVarName(
Tcl_Obj *dupPtr)
{
register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
- register Tcl_Obj *elem = srcPtr->internalRep.twoPtrValue.ptr2;
+ register char *elem = srcPtr->internalRep.twoPtrValue.ptr2;
+ char *elemCopy;
+ unsigned elemLen;
if (arrayPtr != NULL) {
Tcl_IncrRefCount(arrayPtr);
- Tcl_IncrRefCount(elem);
+ 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);
+
+ totalLen = len1 + len2 + 2;
+ p = ckalloc(totalLen + 1);
+ objPtr->bytes = p;
+ objPtr->length = totalLen;
+
+ memcpy(p, part1, (unsigned) len1);
+ p += len1;
+ *p++ = '(';
+ memcpy(p, part2, (unsigned) len2);
+ p += len2;
+ *p++ = ')';
+ *p = '\0';
+}
/*
*----------------------------------------------------------------------
@@ -5641,11 +5676,12 @@ Tcl_FindNamespaceVar(
* Otherwise, points to namespace in which to
* resolve name. If NULL, look up name in the
* current namespace. */
- int flags) /* An OR'd combination of: AVOID_RESOLVERS,
- * TCL_GLOBAL_ONLY (look up name only in
- * global namespace), TCL_NAMESPACE_ONLY (look
- * up only in contextNsPtr, or the current
- * namespace if contextNsPtr is NULL), and
+ int flags) /* An OR'd combination of:
+ * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
+ * up name only in global namespace),
+ * TCL_NAMESPACE_ONLY (look up only in
+ * contextNsPtr, or the current namespace if
+ * contextNsPtr is NULL), and
* TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
* and TCL_NAMESPACE_ONLY are given,
* TCL_GLOBAL_ONLY is ignored. */
@@ -5671,11 +5707,12 @@ ObjFindNamespaceVar(
* Otherwise, points to namespace in which to
* resolve name. If NULL, look up name in the
* current namespace. */
- int flags) /* An OR'd combination of: AVOID_RESOLVERS,
- * TCL_GLOBAL_ONLY (look up name only in
- * global namespace), TCL_NAMESPACE_ONLY (look
- * up only in contextNsPtr, or the current
- * namespace if contextNsPtr is NULL), and
+ int flags) /* An OR'd combination of:
+ * TCL_AVOID_RESOLVERS, TCL_GLOBAL_ONLY (look
+ * up name only in global namespace),
+ * TCL_NAMESPACE_ONLY (look up only in
+ * contextNsPtr, or the current namespace if
+ * contextNsPtr is NULL), and
* TCL_LEAVE_ERR_MSG. If both TCL_GLOBAL_ONLY
* and TCL_NAMESPACE_ONLY are given,
* TCL_GLOBAL_ONLY is ignored. */
@@ -5705,7 +5742,7 @@ ObjFindNamespaceVar(
cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
}
- if (!(flags & AVOID_RESOLVERS) &&
+ if (!(flags & TCL_AVOID_RESOLVERS) &&
(cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL)) {
resPtr = iPtr->resolverPtr;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 8f70c30..dac47cf 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -1189,40 +1189,33 @@ Tcl_ZlibStreamPut(
*/
outSize = deflateBound(&zshPtr->stream, zshPtr->stream.avail_in)+100;
- if (outSize < 4096) {
- outSize = 4096;
- }
zshPtr->stream.avail_out = outSize;
dataTmp = ckalloc(zshPtr->stream.avail_out);
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
- if ((e==Z_OK || e==Z_BUF_ERROR) && (zshPtr->stream.avail_out == 0)) {
- if (outSize - zshPtr->stream.avail_out > 0) {
- /*
- * Output buffer too small.
- */
-
- obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp,
- outSize - zshPtr->stream.avail_out);
+ while (e == Z_BUF_ERROR || (flush == Z_FINISH && e == Z_OK)) {
+ /*
+ * Output buffer too small to hold the data being generated or we
+ * are doing the end-of-stream flush (which can spit out masses of
+ * data). This means we need to put a new buffer into place after
+ * saving the old generated data to the outData list.
+ */
- /*
- * Now append the compressed data to the outData list.
- */
+ obj = Tcl_NewByteArrayObj((unsigned char *) dataTmp, outSize);
+ Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
- Tcl_ListObjAppendElement(NULL, zshPtr->outData, obj);
- }
if (outSize < 0xFFFF) {
outSize = 0xFFFF; /* There may be *lots* of data left to
* output... */
- ckfree(dataTmp);
- dataTmp = ckalloc(outSize);
+ dataTmp = ckrealloc(dataTmp, outSize);
}
zshPtr->stream.avail_out = outSize;
zshPtr->stream.next_out = (Bytef *) dataTmp;
e = deflate(&zshPtr->stream, flush);
}
+
if (e != Z_OK && !(flush==Z_FINISH && e==Z_STREAM_END)) {
if (zshPtr->interp) {
ConvertError(zshPtr->interp, e, zshPtr->stream.adler);
@@ -2913,9 +2906,9 @@ ZlibTransformClose(
}
}
} while (e != Z_STREAM_END);
- e = deflateEnd(&cd->outStream);
+ (void) deflateEnd(&cd->outStream);
} else {
- e = inflateEnd(&cd->inStream);
+ (void) inflateEnd(&cd->inStream);
}
/*
@@ -3351,10 +3344,13 @@ ZlibTransformGetOption(
Tcl_DStringAppendElement(dsPtr, "");
}
} else {
- int len;
- const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
+ if (cd->compDictObj) {
+ int len;
+ const char *str = Tcl_GetStringFromObj(cd->compDictObj, &len);
- Tcl_DStringAppend(dsPtr, str, len);
+ Tcl_DStringAppend(dsPtr, str, len);
+ }
+ return TCL_OK;
}
}
@@ -3556,7 +3552,6 @@ ZlibStackChannelTransform(
ZlibChannelData *cd = ckalloc(sizeof(ZlibChannelData));
Tcl_Channel chan;
int wbits = 0;
- int e;
if (mode != TCL_ZLIB_STREAM_DEFLATE && mode != TCL_ZLIB_STREAM_INFLATE) {
Tcl_Panic("unknown mode: %d", mode);
@@ -3610,43 +3605,35 @@ ZlibStackChannelTransform(
*/
if (mode == TCL_ZLIB_STREAM_INFLATE) {
- e = inflateInit2(&cd->inStream, wbits);
- if (e != Z_OK) {
+ if (inflateInit2(&cd->inStream, wbits) != Z_OK) {
goto error;
}
cd->inAllocated = DEFAULT_BUFFER_SIZE;
cd->inBuffer = ckalloc(cd->inAllocated);
if (cd->flags & IN_HEADER) {
- e = inflateGetHeader(&cd->inStream, &cd->inHeader.header);
- if (e != Z_OK) {
+ if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) {
goto error;
}
}
if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) {
- e = SetInflateDictionary(&cd->inStream, cd->compDictObj);
- if (e != Z_OK) {
+ if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) {
goto error;
}
- TclDecrRefCount(cd->compDictObj);
- cd->compDictObj = NULL;
}
} else {
- e = deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
- MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY);
- if (e != Z_OK) {
+ if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits,
+ MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) {
goto error;
}
cd->outAllocated = DEFAULT_BUFFER_SIZE;
cd->outBuffer = ckalloc(cd->outAllocated);
if (cd->flags & OUT_HEADER) {
- e = deflateSetHeader(&cd->outStream, &cd->outHeader.header);
- if (e != Z_OK) {
+ if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) {
goto error;
}
}
if (cd->compDictObj) {
- e = SetDeflateDictionary(&cd->outStream, cd->compDictObj);
- if (e != Z_OK) {
+ if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) {
goto error;
}
}
diff --git a/generic/zipfs.c b/generic/zipfs.c
index 84a4276..ad4447d 100644
--- a/generic/zipfs.c
+++ b/generic/zipfs.c
@@ -575,7 +575,7 @@ CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr)
path[j++] = c;
}
if (j == 0) {
- path[j++] = '/';
+ path[j++] = '/';
}
path[j] = 0;
Tcl_DStringSetLength(dsPtr, j);
@@ -4075,35 +4075,45 @@ Zipfs_doInit(Tcl_Interp *interp, int safe)
Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
ZipFS.initialized = ZipFS.idCount = 1;
#if defined(ZIPFS_IN_TCL) || defined(ZIPFS_IN_TK)
- Tcl_StaticPackage(interp, "zipfs", Zipfs_Init, Zipfs_SafeInit);
+ if (interp != NULL) {
+ Tcl_StaticPackage(interp, "zipfs", Zipfs_Init, Zipfs_SafeInit);
+ }
#endif
}
Unlock();
- if (!safe) {
- Tcl_CreateObjCommand(interp, "::zipfs::mount", ZipFSMountObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::unmount",
- ZipFSUnmountObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::mkkey", ZipFSMkKeyObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::mkimg", ZipFSMkImgObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::mkzip", ZipFSMkZipObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::lmkimg",
- ZipFSLMkImgObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::lmkzip",
- ZipFSLMkZipObjCmd, 0, 0);
- Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
- }
- Tcl_CreateObjCommand(interp, "::zipfs::exists", ZipFSExistsObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::info", ZipFSInfoObjCmd, 0, 0);
- Tcl_CreateObjCommand(interp, "::zipfs::list", ZipFSListObjCmd, 0, 0);
- if (!safe) {
- Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax,
- TCL_LINK_INT);
- }
-
- TclMakeEnsemble(interp, "zipfs", safe ? initSafeMap : initMap);
-
- Tcl_PkgProvide(interp, "zipfs", "1.0");
+ if (interp != NULL) {
+ if (!safe) {
+ Tcl_CreateObjCommand(interp, "::zipfs::mount",
+ ZipFSMountObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::unmount",
+ ZipFSUnmountObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::mkkey",
+ ZipFSMkKeyObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::mkimg",
+ ZipFSMkImgObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::mkzip",
+ ZipFSMkZipObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::lmkimg",
+ ZipFSLMkImgObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::lmkzip",
+ ZipFSLMkZipObjCmd, 0, 0);
+ Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
+ }
+ Tcl_CreateObjCommand(interp, "::zipfs::exists",
+ ZipFSExistsObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::info",
+ ZipFSInfoObjCmd, 0, 0);
+ Tcl_CreateObjCommand(interp, "::zipfs::list",
+ ZipFSListObjCmd, 0, 0);
+ if (!safe) {
+ Tcl_LinkVar(interp, "::zipfs::wrmax", (char *) &ZipFS.wrmax,
+ TCL_LINK_INT);
+ }
+
+ TclMakeEnsemble(interp, "zipfs", safe ? initSafeMap : initMap);
+ Tcl_PkgProvide(interp, "zipfs", "1.0");
+ }
return TCL_OK;
#else
if (interp != NULL) {
diff --git a/library/clock.tcl b/library/clock.tcl
index 535a67d..8e4b657 100644..100755
--- a/library/clock.tcl
+++ b/library/clock.tcl
@@ -4248,7 +4248,7 @@ proc ::tcl::clock::add { clockval args } {
?-gmt boolean? ?-locale LOCALE? ?-timezone ZONE?\""
}
if { [catch { expr {wide($clockval)} } result] } {
- return -code error "expected integer but got \"$clockval\""
+ return -code error $result
}
set offsets {}
@@ -4287,6 +4287,9 @@ proc ::tcl::clock::add { clockval args } {
-errorcode [list CLOCK gmtWithTimezone] \
"cannot use -gmt and -timezone in same call"
}
+ if { [catch { expr { wide($clockval) } } result] } {
+ return -code error "expected integer but got \"$clockval\""
+ }
if { ![string is boolean -strict $gmt] } {
return -code error "expected boolean value but got \"$gmt\""
} elseif { $gmt } {
@@ -4323,11 +4326,6 @@ proc ::tcl::clock::add { clockval args } {
$changeover]
}
- weekdays - weekday {
- set clockval [AddWeekDays $quantity $clockval $timezone \
- $changeover]
- }
-
hours - hour {
set clockval [expr { 3600 * $quantity + $clockval }]
}
@@ -4427,56 +4425,6 @@ proc ::tcl::clock::AddMonths { months clockval timezone changeover } {
#----------------------------------------------------------------------
#
-# AddWeekDays --
-#
-# Add a given number of week days (skipping Saturdays and Sundays)
-# to a given clock value in a given time zone.
-#
-# Parameters:
-# days - Number of days to add (may be negative)
-# clockval - Seconds since the epoch before the operation
-# timezone - Time zone in which the operation is to be performed
-# changeover - Julian Day on which the Gregorian calendar was adopted
-# in the target locale.
-#
-# Results:
-# Returns the new clock value as a number of seconds since the epoch.
-#
-# Side effects:
-# None.
-#
-#----------------------------------------------------------------------
-
-proc ::tcl::clock::AddWeekDays { days clockval timezone changeover } {
-
- if {$days == 0} {
- return $clockval
- }
-
- set day [format $clockval -format %u]
-
- set weeks [expr {$days / 5}]
- set rdays [expr {$days % 5}]
- set toAdd [expr {7 * $weeks + $rdays}]
- set resDay [expr {$day + ($toAdd % 7)}]
-
- # Adjust if we start from a weekend
- if {$day > 5} {
- set adj [expr {5 - $day}]
- incr toAdd $adj
- incr resDay $adj
- }
-
- # Adjust if we end up on a weekend
- if {$resDay > 5} {
- incr toAdd 2
- }
-
- AddDays $toAdd $clockval $timezone $changeover
-}
-
-#----------------------------------------------------------------------
-#
# AddDays --
#
# Add a given number of days to a given clock value in a given time
diff --git a/library/init.tcl b/library/init.tcl
index 9fd2170..9ca4514 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -16,7 +16,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
-package require -exact Tcl 8.6.5
+package require -exact Tcl 8.6.6
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
diff --git a/library/msgs/af.msg b/library/msgs/af.msg
index 0892615..0892615 100644..100755
--- a/library/msgs/af.msg
+++ b/library/msgs/af.msg
diff --git a/library/msgs/af_za.msg b/library/msgs/af_za.msg
index fef48ad..fef48ad 100644..100755
--- a/library/msgs/af_za.msg
+++ b/library/msgs/af_za.msg
diff --git a/library/msgs/ar.msg b/library/msgs/ar.msg
index 257157f..257157f 100644..100755
--- a/library/msgs/ar.msg
+++ b/library/msgs/ar.msg
diff --git a/library/msgs/ar_in.msg b/library/msgs/ar_in.msg
index 185e49c..185e49c 100644..100755
--- a/library/msgs/ar_in.msg
+++ b/library/msgs/ar_in.msg
diff --git a/library/msgs/ar_jo.msg b/library/msgs/ar_jo.msg
index 0f5e269..0f5e269 100644..100755
--- a/library/msgs/ar_jo.msg
+++ b/library/msgs/ar_jo.msg
diff --git a/library/msgs/ar_lb.msg b/library/msgs/ar_lb.msg
index e62acd3..e62acd3 100644..100755
--- a/library/msgs/ar_lb.msg
+++ b/library/msgs/ar_lb.msg
diff --git a/library/msgs/ar_sy.msg b/library/msgs/ar_sy.msg
index d5e1c87..d5e1c87 100644..100755
--- a/library/msgs/ar_sy.msg
+++ b/library/msgs/ar_sy.msg
diff --git a/library/msgs/be.msg b/library/msgs/be.msg
index 379a1d7..379a1d7 100644..100755
--- a/library/msgs/be.msg
+++ b/library/msgs/be.msg
diff --git a/library/msgs/bg.msg b/library/msgs/bg.msg
index ff17759..ff17759 100644..100755
--- a/library/msgs/bg.msg
+++ b/library/msgs/bg.msg
diff --git a/library/msgs/bn.msg b/library/msgs/bn.msg
index 664b9d8..664b9d8 100644..100755
--- a/library/msgs/bn.msg
+++ b/library/msgs/bn.msg
diff --git a/library/msgs/bn_in.msg b/library/msgs/bn_in.msg
index 28c000f..28c000f 100644..100755
--- a/library/msgs/bn_in.msg
+++ b/library/msgs/bn_in.msg
diff --git a/library/msgs/ca.msg b/library/msgs/ca.msg
index 36c9772..36c9772 100644..100755
--- a/library/msgs/ca.msg
+++ b/library/msgs/ca.msg
diff --git a/library/msgs/cs.msg b/library/msgs/cs.msg
index 8db8bdd..8db8bdd 100644..100755
--- a/library/msgs/cs.msg
+++ b/library/msgs/cs.msg
diff --git a/library/msgs/da.msg b/library/msgs/da.msg
index e4fec7f..e4fec7f 100644..100755
--- a/library/msgs/da.msg
+++ b/library/msgs/da.msg
diff --git a/library/msgs/de.msg b/library/msgs/de.msg
index 9eb3145..9eb3145 100644..100755
--- a/library/msgs/de.msg
+++ b/library/msgs/de.msg
diff --git a/library/msgs/de_at.msg b/library/msgs/de_at.msg
index 61bc266..61bc266 100644..100755
--- a/library/msgs/de_at.msg
+++ b/library/msgs/de_at.msg
diff --git a/library/msgs/de_be.msg b/library/msgs/de_be.msg
index 3614763..3614763 100644..100755
--- a/library/msgs/de_be.msg
+++ b/library/msgs/de_be.msg
diff --git a/library/msgs/el.msg b/library/msgs/el.msg
index ac19f62..ac19f62 100644..100755
--- a/library/msgs/el.msg
+++ b/library/msgs/el.msg
diff --git a/library/msgs/en_au.msg b/library/msgs/en_au.msg
index 7f9870c..7f9870c 100644..100755
--- a/library/msgs/en_au.msg
+++ b/library/msgs/en_au.msg
diff --git a/library/msgs/en_be.msg b/library/msgs/en_be.msg
index 5072986..5072986 100644..100755
--- a/library/msgs/en_be.msg
+++ b/library/msgs/en_be.msg
diff --git a/library/msgs/en_bw.msg b/library/msgs/en_bw.msg
index 8fd20c7..8fd20c7 100644..100755
--- a/library/msgs/en_bw.msg
+++ b/library/msgs/en_bw.msg
diff --git a/library/msgs/en_ca.msg b/library/msgs/en_ca.msg
index 278efe7..278efe7 100644..100755
--- a/library/msgs/en_ca.msg
+++ b/library/msgs/en_ca.msg
diff --git a/library/msgs/en_gb.msg b/library/msgs/en_gb.msg
index 5c61c43..5c61c43 100644..100755
--- a/library/msgs/en_gb.msg
+++ b/library/msgs/en_gb.msg
diff --git a/library/msgs/en_hk.msg b/library/msgs/en_hk.msg
index 8b33bc0..8b33bc0 100644..100755
--- a/library/msgs/en_hk.msg
+++ b/library/msgs/en_hk.msg
diff --git a/library/msgs/en_ie.msg b/library/msgs/en_ie.msg
index ba621cf..ba621cf 100644..100755
--- a/library/msgs/en_ie.msg
+++ b/library/msgs/en_ie.msg
diff --git a/library/msgs/en_in.msg b/library/msgs/en_in.msg
index a1f155d..a1f155d 100644..100755
--- a/library/msgs/en_in.msg
+++ b/library/msgs/en_in.msg
diff --git a/library/msgs/en_nz.msg b/library/msgs/en_nz.msg
index b419017..b419017 100644..100755
--- a/library/msgs/en_nz.msg
+++ b/library/msgs/en_nz.msg
diff --git a/library/msgs/en_ph.msg b/library/msgs/en_ph.msg
index 682666d..682666d 100644..100755
--- a/library/msgs/en_ph.msg
+++ b/library/msgs/en_ph.msg
diff --git a/library/msgs/en_sg.msg b/library/msgs/en_sg.msg
index 4dc5b1d..4dc5b1d 100644..100755
--- a/library/msgs/en_sg.msg
+++ b/library/msgs/en_sg.msg
diff --git a/library/msgs/en_za.msg b/library/msgs/en_za.msg
index fe43797..fe43797 100644..100755
--- a/library/msgs/en_za.msg
+++ b/library/msgs/en_za.msg
diff --git a/library/msgs/en_zw.msg b/library/msgs/en_zw.msg
index 2a5804f..2a5804f 100644..100755
--- a/library/msgs/en_zw.msg
+++ b/library/msgs/en_zw.msg
diff --git a/library/msgs/eo.msg b/library/msgs/eo.msg
index 1d2a24f..1d2a24f 100644..100755
--- a/library/msgs/eo.msg
+++ b/library/msgs/eo.msg
diff --git a/library/msgs/es.msg b/library/msgs/es.msg
index a24f0a1..a24f0a1 100644..100755
--- a/library/msgs/es.msg
+++ b/library/msgs/es.msg
diff --git a/library/msgs/es_ar.msg b/library/msgs/es_ar.msg
index 7d35027..7d35027 100644..100755
--- a/library/msgs/es_ar.msg
+++ b/library/msgs/es_ar.msg
diff --git a/library/msgs/es_bo.msg b/library/msgs/es_bo.msg
index 498ad0d..498ad0d 100644..100755
--- a/library/msgs/es_bo.msg
+++ b/library/msgs/es_bo.msg
diff --git a/library/msgs/es_cl.msg b/library/msgs/es_cl.msg
index 31d465c..31d465c 100644..100755
--- a/library/msgs/es_cl.msg
+++ b/library/msgs/es_cl.msg
diff --git a/library/msgs/es_co.msg b/library/msgs/es_co.msg
index 77e57f0..77e57f0 100644..100755
--- a/library/msgs/es_co.msg
+++ b/library/msgs/es_co.msg
diff --git a/library/msgs/es_cr.msg b/library/msgs/es_cr.msg
index 7a652fa..7a652fa 100644..100755
--- a/library/msgs/es_cr.msg
+++ b/library/msgs/es_cr.msg
diff --git a/library/msgs/es_do.msg b/library/msgs/es_do.msg
index 0e283da..0e283da 100644..100755
--- a/library/msgs/es_do.msg
+++ b/library/msgs/es_do.msg
diff --git a/library/msgs/es_ec.msg b/library/msgs/es_ec.msg
index 9e921e0..9e921e0 100644..100755
--- a/library/msgs/es_ec.msg
+++ b/library/msgs/es_ec.msg
diff --git a/library/msgs/es_gt.msg b/library/msgs/es_gt.msg
index ecd6faf..ecd6faf 100644..100755
--- a/library/msgs/es_gt.msg
+++ b/library/msgs/es_gt.msg
diff --git a/library/msgs/es_hn.msg b/library/msgs/es_hn.msg
index a758ca2..a758ca2 100644..100755
--- a/library/msgs/es_hn.msg
+++ b/library/msgs/es_hn.msg
diff --git a/library/msgs/es_mx.msg b/library/msgs/es_mx.msg
index 7cfb545..7cfb545 100644..100755
--- a/library/msgs/es_mx.msg
+++ b/library/msgs/es_mx.msg
diff --git a/library/msgs/es_ni.msg b/library/msgs/es_ni.msg
index 7c39495..7c39495 100644..100755
--- a/library/msgs/es_ni.msg
+++ b/library/msgs/es_ni.msg
diff --git a/library/msgs/es_pa.msg b/library/msgs/es_pa.msg
index cecacdc..cecacdc 100644..100755
--- a/library/msgs/es_pa.msg
+++ b/library/msgs/es_pa.msg
diff --git a/library/msgs/es_pe.msg b/library/msgs/es_pe.msg
index 9f90595..9f90595 100644..100755
--- a/library/msgs/es_pe.msg
+++ b/library/msgs/es_pe.msg
diff --git a/library/msgs/es_pr.msg b/library/msgs/es_pr.msg
index 8511b12..8511b12 100644..100755
--- a/library/msgs/es_pr.msg
+++ b/library/msgs/es_pr.msg
diff --git a/library/msgs/es_py.msg b/library/msgs/es_py.msg
index aa93d36..aa93d36 100644..100755
--- a/library/msgs/es_py.msg
+++ b/library/msgs/es_py.msg
diff --git a/library/msgs/es_sv.msg b/library/msgs/es_sv.msg
index fc7954d..fc7954d 100644..100755
--- a/library/msgs/es_sv.msg
+++ b/library/msgs/es_sv.msg
diff --git a/library/msgs/es_uy.msg b/library/msgs/es_uy.msg
index b33525c..b33525c 100644..100755
--- a/library/msgs/es_uy.msg
+++ b/library/msgs/es_uy.msg
diff --git a/library/msgs/es_ve.msg b/library/msgs/es_ve.msg
index 7c2a7b0..7c2a7b0 100644..100755
--- a/library/msgs/es_ve.msg
+++ b/library/msgs/es_ve.msg
diff --git a/library/msgs/et.msg b/library/msgs/et.msg
index 8d32e9e..8d32e9e 100644..100755
--- a/library/msgs/et.msg
+++ b/library/msgs/et.msg
diff --git a/library/msgs/eu.msg b/library/msgs/eu.msg
index cf708b6..cf708b6 100644..100755
--- a/library/msgs/eu.msg
+++ b/library/msgs/eu.msg
diff --git a/library/msgs/eu_es.msg b/library/msgs/eu_es.msg
index 2694418..2694418 100644..100755
--- a/library/msgs/eu_es.msg
+++ b/library/msgs/eu_es.msg
diff --git a/library/msgs/fa.msg b/library/msgs/fa.msg
index 89b2f90..89b2f90 100644..100755
--- a/library/msgs/fa.msg
+++ b/library/msgs/fa.msg
diff --git a/library/msgs/fa_in.msg b/library/msgs/fa_in.msg
index adc9e91..adc9e91 100644..100755
--- a/library/msgs/fa_in.msg
+++ b/library/msgs/fa_in.msg
diff --git a/library/msgs/fa_ir.msg b/library/msgs/fa_ir.msg
index 597ce9d..597ce9d 100644..100755
--- a/library/msgs/fa_ir.msg
+++ b/library/msgs/fa_ir.msg
diff --git a/library/msgs/fi.msg b/library/msgs/fi.msg
index acabba0..acabba0 100644..100755
--- a/library/msgs/fi.msg
+++ b/library/msgs/fi.msg
diff --git a/library/msgs/fo.msg b/library/msgs/fo.msg
index 4696e62..4696e62 100644..100755
--- a/library/msgs/fo.msg
+++ b/library/msgs/fo.msg
diff --git a/library/msgs/fo_fo.msg b/library/msgs/fo_fo.msg
index 2392b8e..2392b8e 100644..100755
--- a/library/msgs/fo_fo.msg
+++ b/library/msgs/fo_fo.msg
diff --git a/library/msgs/fr.msg b/library/msgs/fr.msg
index 55b19bf..55b19bf 100644..100755
--- a/library/msgs/fr.msg
+++ b/library/msgs/fr.msg
diff --git a/library/msgs/fr_be.msg b/library/msgs/fr_be.msg
index cdb13bd..cdb13bd 100644..100755
--- a/library/msgs/fr_be.msg
+++ b/library/msgs/fr_be.msg
diff --git a/library/msgs/fr_ca.msg b/library/msgs/fr_ca.msg
index 00ccfff..00ccfff 100644..100755
--- a/library/msgs/fr_ca.msg
+++ b/library/msgs/fr_ca.msg
diff --git a/library/msgs/fr_ch.msg b/library/msgs/fr_ch.msg
index 7e2bac7..7e2bac7 100644..100755
--- a/library/msgs/fr_ch.msg
+++ b/library/msgs/fr_ch.msg
diff --git a/library/msgs/ga.msg b/library/msgs/ga.msg
index 6edf13a..6edf13a 100644..100755
--- a/library/msgs/ga.msg
+++ b/library/msgs/ga.msg
diff --git a/library/msgs/ga_ie.msg b/library/msgs/ga_ie.msg
index b6acbbc..b6acbbc 100644..100755
--- a/library/msgs/ga_ie.msg
+++ b/library/msgs/ga_ie.msg
diff --git a/library/msgs/gl.msg b/library/msgs/gl.msg
index 4b869e8..4b869e8 100644..100755
--- a/library/msgs/gl.msg
+++ b/library/msgs/gl.msg
diff --git a/library/msgs/gl_es.msg b/library/msgs/gl_es.msg
index d4ed270..d4ed270 100644..100755
--- a/library/msgs/gl_es.msg
+++ b/library/msgs/gl_es.msg
diff --git a/library/msgs/gv.msg b/library/msgs/gv.msg
index 7d332ad..7d332ad 100644..100755
--- a/library/msgs/gv.msg
+++ b/library/msgs/gv.msg
diff --git a/library/msgs/gv_gb.msg b/library/msgs/gv_gb.msg
index 5e96e6f..5e96e6f 100644..100755
--- a/library/msgs/gv_gb.msg
+++ b/library/msgs/gv_gb.msg
diff --git a/library/msgs/he.msg b/library/msgs/he.msg
index 4fd921d..4fd921d 100644..100755
--- a/library/msgs/he.msg
+++ b/library/msgs/he.msg
diff --git a/library/msgs/hi.msg b/library/msgs/hi.msg
index 50c9fb8..50c9fb8 100644..100755
--- a/library/msgs/hi.msg
+++ b/library/msgs/hi.msg
diff --git a/library/msgs/hi_in.msg b/library/msgs/hi_in.msg
index 239793f..239793f 100644..100755
--- a/library/msgs/hi_in.msg
+++ b/library/msgs/hi_in.msg
diff --git a/library/msgs/hr.msg b/library/msgs/hr.msg
index cec145b..cec145b 100644..100755
--- a/library/msgs/hr.msg
+++ b/library/msgs/hr.msg
diff --git a/library/msgs/hu.msg b/library/msgs/hu.msg
index e5e68d9..e5e68d9 100644..100755
--- a/library/msgs/hu.msg
+++ b/library/msgs/hu.msg
diff --git a/library/msgs/id.msg b/library/msgs/id.msg
index 17c6bb5..17c6bb5 100644..100755
--- a/library/msgs/id.msg
+++ b/library/msgs/id.msg
diff --git a/library/msgs/id_id.msg b/library/msgs/id_id.msg
index bb672c1..bb672c1 100644..100755
--- a/library/msgs/id_id.msg
+++ b/library/msgs/id_id.msg
diff --git a/library/msgs/is.msg b/library/msgs/is.msg
index adc2d2a..adc2d2a 100644..100755
--- a/library/msgs/is.msg
+++ b/library/msgs/is.msg
diff --git a/library/msgs/it.msg b/library/msgs/it.msg
index b641cde..b641cde 100644..100755
--- a/library/msgs/it.msg
+++ b/library/msgs/it.msg
diff --git a/library/msgs/it_ch.msg b/library/msgs/it_ch.msg
index b36ed36..b36ed36 100644..100755
--- a/library/msgs/it_ch.msg
+++ b/library/msgs/it_ch.msg
diff --git a/library/msgs/ja.msg b/library/msgs/ja.msg
index 2767665..2767665 100644..100755
--- a/library/msgs/ja.msg
+++ b/library/msgs/ja.msg
diff --git a/library/msgs/kl.msg b/library/msgs/kl.msg
index d877bfe..d877bfe 100644..100755
--- a/library/msgs/kl.msg
+++ b/library/msgs/kl.msg
diff --git a/library/msgs/kl_gl.msg b/library/msgs/kl_gl.msg
index 403aa10..403aa10 100644..100755
--- a/library/msgs/kl_gl.msg
+++ b/library/msgs/kl_gl.msg
diff --git a/library/msgs/ko.msg b/library/msgs/ko.msg
index 0cd17a1..0cd17a1 100644..100755
--- a/library/msgs/ko.msg
+++ b/library/msgs/ko.msg
diff --git a/library/msgs/ko_kr.msg b/library/msgs/ko_kr.msg
index ea5bbd7..ea5bbd7 100644..100755
--- a/library/msgs/ko_kr.msg
+++ b/library/msgs/ko_kr.msg
diff --git a/library/msgs/kok.msg b/library/msgs/kok.msg
index 0869f20..0869f20 100644..100755
--- a/library/msgs/kok.msg
+++ b/library/msgs/kok.msg
diff --git a/library/msgs/kok_in.msg b/library/msgs/kok_in.msg
index abcb1ff..abcb1ff 100644..100755
--- a/library/msgs/kok_in.msg
+++ b/library/msgs/kok_in.msg
diff --git a/library/msgs/kw.msg b/library/msgs/kw.msg
index aaf79b3..aaf79b3 100644..100755
--- a/library/msgs/kw.msg
+++ b/library/msgs/kw.msg
diff --git a/library/msgs/kw_gb.msg b/library/msgs/kw_gb.msg
index 2967680..2967680 100644..100755
--- a/library/msgs/kw_gb.msg
+++ b/library/msgs/kw_gb.msg
diff --git a/library/msgs/lt.msg b/library/msgs/lt.msg
index 27b0985..27b0985 100644..100755
--- a/library/msgs/lt.msg
+++ b/library/msgs/lt.msg
diff --git a/library/msgs/lv.msg b/library/msgs/lv.msg
index a037b15..a037b15 100644..100755
--- a/library/msgs/lv.msg
+++ b/library/msgs/lv.msg
diff --git a/library/msgs/mk.msg b/library/msgs/mk.msg
index 41cf60d..41cf60d 100644..100755
--- a/library/msgs/mk.msg
+++ b/library/msgs/mk.msg
diff --git a/library/msgs/mr.msg b/library/msgs/mr.msg
index cea427a..cea427a 100644..100755
--- a/library/msgs/mr.msg
+++ b/library/msgs/mr.msg
diff --git a/library/msgs/mr_in.msg b/library/msgs/mr_in.msg
index 1889da5..1889da5 100644..100755
--- a/library/msgs/mr_in.msg
+++ b/library/msgs/mr_in.msg
diff --git a/library/msgs/ms.msg b/library/msgs/ms.msg
index e954431..e954431 100644..100755
--- a/library/msgs/ms.msg
+++ b/library/msgs/ms.msg
diff --git a/library/msgs/ms_my.msg b/library/msgs/ms_my.msg
index c1f93d4..c1f93d4 100644..100755
--- a/library/msgs/ms_my.msg
+++ b/library/msgs/ms_my.msg
diff --git a/library/msgs/mt.msg b/library/msgs/mt.msg
index ddd5446..ddd5446 100644..100755
--- a/library/msgs/mt.msg
+++ b/library/msgs/mt.msg
diff --git a/library/msgs/nb.msg b/library/msgs/nb.msg
index 90d49a3..90d49a3 100644..100755
--- a/library/msgs/nb.msg
+++ b/library/msgs/nb.msg
diff --git a/library/msgs/nl.msg b/library/msgs/nl.msg
index 4c5c675..4c5c675 100644..100755
--- a/library/msgs/nl.msg
+++ b/library/msgs/nl.msg
diff --git a/library/msgs/nl_be.msg b/library/msgs/nl_be.msg
index 4b19670..4b19670 100644..100755
--- a/library/msgs/nl_be.msg
+++ b/library/msgs/nl_be.msg
diff --git a/library/msgs/nn.msg b/library/msgs/nn.msg
index bd61ac9..bd61ac9 100644..100755
--- a/library/msgs/nn.msg
+++ b/library/msgs/nn.msg
diff --git a/library/msgs/pl.msg b/library/msgs/pl.msg
index d206f4b..d206f4b 100644..100755
--- a/library/msgs/pl.msg
+++ b/library/msgs/pl.msg
diff --git a/library/msgs/pt.msg b/library/msgs/pt.msg
index 96fdb35..96fdb35 100644..100755
--- a/library/msgs/pt.msg
+++ b/library/msgs/pt.msg
diff --git a/library/msgs/pt_br.msg b/library/msgs/pt_br.msg
index 8684327..8684327 100644..100755
--- a/library/msgs/pt_br.msg
+++ b/library/msgs/pt_br.msg
diff --git a/library/msgs/ro.msg b/library/msgs/ro.msg
index bdd7c61..bdd7c61 100644..100755
--- a/library/msgs/ro.msg
+++ b/library/msgs/ro.msg
diff --git a/library/msgs/ru.msg b/library/msgs/ru.msg
index 65b075d..65b075d 100644..100755
--- a/library/msgs/ru.msg
+++ b/library/msgs/ru.msg
diff --git a/library/msgs/ru_ua.msg b/library/msgs/ru_ua.msg
index 6e1f8a8..6e1f8a8 100644..100755
--- a/library/msgs/ru_ua.msg
+++ b/library/msgs/ru_ua.msg
diff --git a/library/msgs/sh.msg b/library/msgs/sh.msg
index 6ee0fc7..6ee0fc7 100644..100755
--- a/library/msgs/sh.msg
+++ b/library/msgs/sh.msg
diff --git a/library/msgs/sk.msg b/library/msgs/sk.msg
index 9b2f0aa..9b2f0aa 100644..100755
--- a/library/msgs/sk.msg
+++ b/library/msgs/sk.msg
diff --git a/library/msgs/sl.msg b/library/msgs/sl.msg
index 42bc509..42bc509 100644..100755
--- a/library/msgs/sl.msg
+++ b/library/msgs/sl.msg
diff --git a/library/msgs/sq.msg b/library/msgs/sq.msg
index 8fb1fce..8fb1fce 100644..100755
--- a/library/msgs/sq.msg
+++ b/library/msgs/sq.msg
diff --git a/library/msgs/sr.msg b/library/msgs/sr.msg
index 7576668..7576668 100644..100755
--- a/library/msgs/sr.msg
+++ b/library/msgs/sr.msg
diff --git a/library/msgs/sv.msg b/library/msgs/sv.msg
index f7a67c6..f7a67c6 100644..100755
--- a/library/msgs/sv.msg
+++ b/library/msgs/sv.msg
diff --git a/library/msgs/sw.msg b/library/msgs/sw.msg
index b888b43..b888b43 100644..100755
--- a/library/msgs/sw.msg
+++ b/library/msgs/sw.msg
diff --git a/library/msgs/ta.msg b/library/msgs/ta.msg
index 4abb90c..4abb90c 100644..100755
--- a/library/msgs/ta.msg
+++ b/library/msgs/ta.msg
diff --git a/library/msgs/ta_in.msg b/library/msgs/ta_in.msg
index 24590ac..24590ac 100644..100755
--- a/library/msgs/ta_in.msg
+++ b/library/msgs/ta_in.msg
diff --git a/library/msgs/te.msg b/library/msgs/te.msg
index 6111473..6111473 100644..100755
--- a/library/msgs/te.msg
+++ b/library/msgs/te.msg
diff --git a/library/msgs/te_in.msg b/library/msgs/te_in.msg
index 61638b5..61638b5 100644..100755
--- a/library/msgs/te_in.msg
+++ b/library/msgs/te_in.msg
diff --git a/library/msgs/th.msg b/library/msgs/th.msg
index 7486c35..7486c35 100644..100755
--- a/library/msgs/th.msg
+++ b/library/msgs/th.msg
diff --git a/library/msgs/tr.msg b/library/msgs/tr.msg
index 7b2ecf9..7b2ecf9 100644..100755
--- a/library/msgs/tr.msg
+++ b/library/msgs/tr.msg
diff --git a/library/msgs/uk.msg b/library/msgs/uk.msg
index 7d4c64a..7d4c64a 100644..100755
--- a/library/msgs/uk.msg
+++ b/library/msgs/uk.msg
diff --git a/library/msgs/vi.msg b/library/msgs/vi.msg
index c98b2a6..c98b2a6 100644..100755
--- a/library/msgs/vi.msg
+++ b/library/msgs/vi.msg
diff --git a/library/msgs/zh.msg b/library/msgs/zh.msg
index b799a32..b799a32 100644..100755
--- a/library/msgs/zh.msg
+++ b/library/msgs/zh.msg
diff --git a/library/msgs/zh_cn.msg b/library/msgs/zh_cn.msg
index d62ce77..d62ce77 100644..100755
--- a/library/msgs/zh_cn.msg
+++ b/library/msgs/zh_cn.msg
diff --git a/library/msgs/zh_hk.msg b/library/msgs/zh_hk.msg
index badb1dd..badb1dd 100644..100755
--- a/library/msgs/zh_hk.msg
+++ b/library/msgs/zh_hk.msg
diff --git a/library/msgs/zh_sg.msg b/library/msgs/zh_sg.msg
index a2f3e39..a2f3e39 100644..100755
--- a/library/msgs/zh_sg.msg
+++ b/library/msgs/zh_sg.msg
diff --git a/library/msgs/zh_tw.msg b/library/msgs/zh_tw.msg
index e0796b1..e0796b1 100644..100755
--- a/library/msgs/zh_tw.msg
+++ b/library/msgs/zh_tw.msg
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index 169b7d4..cde2660 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -614,7 +614,7 @@ namespace eval tcltest {
set levelMap {
l list
p pass
- b body
+ b body
s skip
t start
e error
@@ -2709,7 +2709,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
DebugPuts 1 "No test directories remain after applying match\
and skip patterns!"
}
- return $matchDirs
+ return [lsort $matchDirs]
}
# tcltest::runAllTests --
diff --git a/library/tzdata/Africa/Asmara b/library/tzdata/Africa/Asmara
index 3d33c94..3d33c94 100644..100755
--- a/library/tzdata/Africa/Asmara
+++ b/library/tzdata/Africa/Asmara
diff --git a/library/tzdata/America/Atikokan b/library/tzdata/America/Atikokan
index e72b04f..e72b04f 100644..100755
--- a/library/tzdata/America/Atikokan
+++ b/library/tzdata/America/Atikokan
diff --git a/library/tzdata/America/Blanc-Sablon b/library/tzdata/America/Blanc-Sablon
index d5485e8..d5485e8 100644..100755
--- a/library/tzdata/America/Blanc-Sablon
+++ b/library/tzdata/America/Blanc-Sablon
diff --git a/library/tzdata/America/Cambridge_Bay b/library/tzdata/America/Cambridge_Bay
index 23004bb..3115ee1 100644
--- a/library/tzdata/America/Cambridge_Bay
+++ b/library/tzdata/America/Cambridge_Bay
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Cambridge_Bay) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-1577923200 -25200 0 MST}
{-880210800 -21600 1 MWT}
{-769395600 -21600 1 MPT}
diff --git a/library/tzdata/America/Indiana/Petersburg b/library/tzdata/America/Indiana/Petersburg
index 6992bfc..6992bfc 100644..100755
--- a/library/tzdata/America/Indiana/Petersburg
+++ b/library/tzdata/America/Indiana/Petersburg
diff --git a/library/tzdata/America/Indiana/Tell_City b/library/tzdata/America/Indiana/Tell_City
index 9eebcf7..9eebcf7 100644..100755
--- a/library/tzdata/America/Indiana/Tell_City
+++ b/library/tzdata/America/Indiana/Tell_City
diff --git a/library/tzdata/America/Indiana/Vincennes b/library/tzdata/America/Indiana/Vincennes
index 1af7fc9..1af7fc9 100644..100755
--- a/library/tzdata/America/Indiana/Vincennes
+++ b/library/tzdata/America/Indiana/Vincennes
diff --git a/library/tzdata/America/Indiana/Winamac b/library/tzdata/America/Indiana/Winamac
index fb6cd37..fb6cd37 100644..100755
--- a/library/tzdata/America/Indiana/Winamac
+++ b/library/tzdata/America/Indiana/Winamac
diff --git a/library/tzdata/America/Inuvik b/library/tzdata/America/Inuvik
index dd0d151..08f0fd6 100644
--- a/library/tzdata/America/Inuvik
+++ b/library/tzdata/America/Inuvik
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Inuvik) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-536457600 -28800 0 PST}
{-147888000 -21600 1 PDDT}
{-131558400 -28800 0 PST}
diff --git a/library/tzdata/America/Iqaluit b/library/tzdata/America/Iqaluit
index 2a2e9fe..ff82866 100644
--- a/library/tzdata/America/Iqaluit
+++ b/library/tzdata/America/Iqaluit
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Iqaluit) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-865296000 -14400 0 EWT}
{-769395600 -14400 1 EPT}
{-765396000 -18000 0 EST}
diff --git a/library/tzdata/America/Moncton b/library/tzdata/America/Moncton
index d286c88..d286c88 100644..100755
--- a/library/tzdata/America/Moncton
+++ b/library/tzdata/America/Moncton
diff --git a/library/tzdata/America/North_Dakota/New_Salem b/library/tzdata/America/North_Dakota/New_Salem
index 5a9d229..5a9d229 100644..100755
--- a/library/tzdata/America/North_Dakota/New_Salem
+++ b/library/tzdata/America/North_Dakota/New_Salem
diff --git a/library/tzdata/America/Pangnirtung b/library/tzdata/America/Pangnirtung
index 640808e..14d8516 100644
--- a/library/tzdata/America/Pangnirtung
+++ b/library/tzdata/America/Pangnirtung
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Pangnirtung) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-1546300800 -14400 0 AST}
{-880221600 -10800 1 AWT}
{-769395600 -10800 1 APT}
diff --git a/library/tzdata/America/Rankin_Inlet b/library/tzdata/America/Rankin_Inlet
index 770ec5d..9ce9f8d 100644
--- a/library/tzdata/America/Rankin_Inlet
+++ b/library/tzdata/America/Rankin_Inlet
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Rankin_Inlet) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-410227200 -21600 0 CST}
{-147895200 -14400 1 CDDT}
{-131565600 -21600 0 CST}
diff --git a/library/tzdata/America/Resolute b/library/tzdata/America/Resolute
index b4c0bab..a9881b4 100644..100755
--- a/library/tzdata/America/Resolute
+++ b/library/tzdata/America/Resolute
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Resolute) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-704937600 -21600 0 CST}
{-147895200 -14400 1 CDDT}
{-131565600 -21600 0 CST}
diff --git a/library/tzdata/America/Yellowknife b/library/tzdata/America/Yellowknife
index 44ca658..c6c4ed5 100644
--- a/library/tzdata/America/Yellowknife
+++ b/library/tzdata/America/Yellowknife
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:America/Yellowknife) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-1104537600 -25200 0 MST}
{-880210800 -21600 1 MWT}
{-769395600 -21600 1 MPT}
diff --git a/library/tzdata/Antarctica/Casey b/library/tzdata/Antarctica/Casey
index 56d5df7..2573dac 100644
--- a/library/tzdata/Antarctica/Casey
+++ b/library/tzdata/Antarctica/Casey
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Casey) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-31536000 28800 0 AWST}
{1255802400 39600 0 CAST}
{1267714800 28800 0 AWST}
diff --git a/library/tzdata/Antarctica/Davis b/library/tzdata/Antarctica/Davis
index 2762d2f..c98be2f 100644
--- a/library/tzdata/Antarctica/Davis
+++ b/library/tzdata/Antarctica/Davis
@@ -1,9 +1,9 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Davis) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-409190400 25200 0 DAVT}
- {-163062000 0 0 zzz}
+ {-163062000 0 0 -00}
{-28857600 25200 0 DAVT}
{1255806000 18000 0 DAVT}
{1268251200 25200 0 DAVT}
diff --git a/library/tzdata/Antarctica/DumontDUrville b/library/tzdata/Antarctica/DumontDUrville
index 41dc1e3..8d21d45 100644
--- a/library/tzdata/Antarctica/DumontDUrville
+++ b/library/tzdata/Antarctica/DumontDUrville
@@ -1,8 +1,8 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/DumontDUrville) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-725846400 36000 0 PMT}
- {-566992800 0 0 zzz}
+ {-566992800 0 0 -00}
{-415497600 36000 0 DDUT}
}
diff --git a/library/tzdata/Antarctica/Macquarie b/library/tzdata/Antarctica/Macquarie
index 07ddff6..9ed0630 100644
--- a/library/tzdata/Antarctica/Macquarie
+++ b/library/tzdata/Antarctica/Macquarie
@@ -1,12 +1,12 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Macquarie) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-2214259200 36000 0 AEST}
{-1680508800 39600 1 AEDT}
{-1669892400 39600 0 AEDT}
{-1665392400 36000 0 AEST}
- {-1601719200 0 0 zzz}
+ {-1601719200 0 0 -00}
{-94730400 36000 0 AEST}
{-71136000 39600 1 AEDT}
{-55411200 36000 0 AEST}
diff --git a/library/tzdata/Antarctica/Mawson b/library/tzdata/Antarctica/Mawson
index ba03ba1..e50aa07 100644
--- a/library/tzdata/Antarctica/Mawson
+++ b/library/tzdata/Antarctica/Mawson
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Mawson) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-501206400 21600 0 MAWT}
{1255809600 18000 0 MAWT}
}
diff --git a/library/tzdata/Antarctica/Palmer b/library/tzdata/Antarctica/Palmer
index 5767985..62b17e1 100644
--- a/library/tzdata/Antarctica/Palmer
+++ b/library/tzdata/Antarctica/Palmer
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Palmer) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-157766400 -14400 0 ART}
{-152654400 -14400 0 ART}
{-132955200 -10800 1 ARST}
diff --git a/library/tzdata/Antarctica/Rothera b/library/tzdata/Antarctica/Rothera
index 24d7f3e..3a219c7 100644
--- a/library/tzdata/Antarctica/Rothera
+++ b/library/tzdata/Antarctica/Rothera
@@ -1,6 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Rothera) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{218246400 -10800 0 ROTT}
}
diff --git a/library/tzdata/Antarctica/Syowa b/library/tzdata/Antarctica/Syowa
index 4d046b5..1fe030a 100644
--- a/library/tzdata/Antarctica/Syowa
+++ b/library/tzdata/Antarctica/Syowa
@@ -1,6 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Syowa) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-407808000 10800 0 SYOT}
}
diff --git a/library/tzdata/Antarctica/Troll b/library/tzdata/Antarctica/Troll
index 7d2b042..09727a8 100644
--- a/library/tzdata/Antarctica/Troll
+++ b/library/tzdata/Antarctica/Troll
@@ -1,7 +1,7 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Troll) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{1108166400 0 0 UTC}
{1111885200 7200 1 CEST}
{1130634000 0 0 UTC}
diff --git a/library/tzdata/Antarctica/Vostok b/library/tzdata/Antarctica/Vostok
index f846f65..a59868b 100644
--- a/library/tzdata/Antarctica/Vostok
+++ b/library/tzdata/Antarctica/Vostok
@@ -1,6 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Antarctica/Vostok) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-380073600 21600 0 VOST}
}
diff --git a/library/tzdata/Asia/Baku b/library/tzdata/Asia/Baku
index bc0701a..e9ee835 100644
--- a/library/tzdata/Asia/Baku
+++ b/library/tzdata/Asia/Baku
@@ -28,7 +28,7 @@ set TZData(:Asia/Baku) {
{683496000 14400 0 AZST}
{686098800 10800 0 AZT}
{701823600 14400 1 AZST}
- {717537600 14400 0 AZT}
+ {717548400 14400 0 AZT}
{820440000 14400 0 AZT}
{828234000 18000 1 AZST}
{846378000 14400 0 AZT}
diff --git a/library/tzdata/Asia/Novokuznetsk b/library/tzdata/Asia/Novokuznetsk
index f079faa..a43a984 100644
--- a/library/tzdata/Asia/Novokuznetsk
+++ b/library/tzdata/Asia/Novokuznetsk
@@ -2,71 +2,70 @@
set TZData(:Asia/Novokuznetsk) {
{-9223372036854775808 20928 0 LMT}
- {-1441259328 21600 0 KRAT}
- {-1247551200 25200 0 KRAMMTT}
- {354906000 28800 1 KRAST}
- {370713600 25200 0 KRAT}
- {386442000 28800 1 KRAST}
- {402249600 25200 0 KRAT}
- {417978000 28800 1 KRAST}
- {433785600 25200 0 KRAT}
- {449600400 28800 1 KRAST}
- {465332400 25200 0 KRAT}
- {481057200 28800 1 KRAST}
- {496782000 25200 0 KRAT}
- {512506800 28800 1 KRAST}
- {528231600 25200 0 KRAT}
- {543956400 28800 1 KRAST}
- {559681200 25200 0 KRAT}
- {575406000 28800 1 KRAST}
- {591130800 25200 0 KRAT}
- {606855600 28800 1 KRAST}
- {622580400 25200 0 KRAT}
- {638305200 28800 1 KRAST}
- {654634800 25200 0 KRAT}
- {670359600 21600 0 KRAMMTT}
- {670363200 25200 1 KRAST}
- {686088000 21600 0 KRAT}
- {695764800 25200 0 KRAMMTT}
- {701809200 28800 1 KRAST}
- {717534000 25200 0 KRAT}
- {733258800 28800 1 KRAST}
- {748983600 25200 0 KRAT}
- {764708400 28800 1 KRAST}
- {780433200 25200 0 KRAT}
- {796158000 28800 1 KRAST}
- {811882800 25200 0 KRAT}
- {828212400 28800 1 KRAST}
- {846356400 25200 0 KRAT}
- {859662000 28800 1 KRAST}
- {877806000 25200 0 KRAT}
- {891111600 28800 1 KRAST}
- {909255600 25200 0 KRAT}
- {922561200 28800 1 KRAST}
- {941310000 25200 0 KRAT}
- {954010800 28800 1 KRAST}
- {972759600 25200 0 KRAT}
- {985460400 28800 1 KRAST}
- {1004209200 25200 0 KRAT}
- {1017514800 28800 1 KRAST}
- {1035658800 25200 0 KRAT}
- {1048964400 28800 1 KRAST}
- {1067108400 25200 0 KRAT}
- {1080414000 28800 1 KRAST}
- {1099162800 25200 0 KRAT}
- {1111863600 28800 1 KRAST}
- {1130612400 25200 0 KRAT}
- {1143313200 28800 1 KRAST}
- {1162062000 25200 0 KRAT}
- {1174762800 28800 1 KRAST}
- {1193511600 25200 0 KRAT}
- {1206817200 28800 1 KRAST}
- {1224961200 25200 0 KRAT}
- {1238266800 28800 1 KRAST}
- {1256410800 25200 0 KRAT}
- {1269716400 21600 0 NOVMMTT}
- {1269720000 25200 1 NOVST}
- {1288468800 21600 0 NOVT}
- {1301169600 25200 0 NOVT}
- {1414263600 25200 0 KRAT}
+ {-1441259328 21600 0 +06}
+ {-1247551200 25200 0 +08}
+ {354906000 28800 1 +08}
+ {370713600 25200 0 +07}
+ {386442000 28800 1 +08}
+ {402249600 25200 0 +07}
+ {417978000 28800 1 +08}
+ {433785600 25200 0 +07}
+ {449600400 28800 1 +08}
+ {465332400 25200 0 +07}
+ {481057200 28800 1 +08}
+ {496782000 25200 0 +07}
+ {512506800 28800 1 +08}
+ {528231600 25200 0 +07}
+ {543956400 28800 1 +08}
+ {559681200 25200 0 +07}
+ {575406000 28800 1 +08}
+ {591130800 25200 0 +07}
+ {606855600 28800 1 +08}
+ {622580400 25200 0 +07}
+ {638305200 28800 1 +08}
+ {654634800 25200 0 +07}
+ {670359600 21600 0 +07}
+ {670363200 25200 1 +07}
+ {686088000 21600 0 +06}
+ {695764800 25200 0 +08}
+ {701809200 28800 1 +08}
+ {717534000 25200 0 +07}
+ {733258800 28800 1 +08}
+ {748983600 25200 0 +07}
+ {764708400 28800 1 +08}
+ {780433200 25200 0 +07}
+ {796158000 28800 1 +08}
+ {811882800 25200 0 +07}
+ {828212400 28800 1 +08}
+ {846356400 25200 0 +07}
+ {859662000 28800 1 +08}
+ {877806000 25200 0 +07}
+ {891111600 28800 1 +08}
+ {909255600 25200 0 +07}
+ {922561200 28800 1 +08}
+ {941310000 25200 0 +07}
+ {954010800 28800 1 +08}
+ {972759600 25200 0 +07}
+ {985460400 28800 1 +08}
+ {1004209200 25200 0 +07}
+ {1017514800 28800 1 +08}
+ {1035658800 25200 0 +07}
+ {1048964400 28800 1 +08}
+ {1067108400 25200 0 +07}
+ {1080414000 28800 1 +08}
+ {1099162800 25200 0 +07}
+ {1111863600 28800 1 +08}
+ {1130612400 25200 0 +07}
+ {1143313200 28800 1 +08}
+ {1162062000 25200 0 +07}
+ {1174762800 28800 1 +08}
+ {1193511600 25200 0 +07}
+ {1206817200 28800 1 +08}
+ {1224961200 25200 0 +07}
+ {1238266800 28800 1 +08}
+ {1256410800 25200 0 +07}
+ {1269716400 21600 0 +07}
+ {1269720000 25200 1 +07}
+ {1288468800 21600 0 +06}
+ {1301169600 25200 0 +07}
}
diff --git a/library/tzdata/Asia/Novosibirsk b/library/tzdata/Asia/Novosibirsk
index 54c83fa..21f5c00 100644
--- a/library/tzdata/Asia/Novosibirsk
+++ b/library/tzdata/Asia/Novosibirsk
@@ -2,71 +2,72 @@
set TZData(:Asia/Novosibirsk) {
{-9223372036854775808 19900 0 LMT}
- {-1579476700 21600 0 NOVT}
- {-1247551200 25200 0 NOVMMTT}
- {354906000 28800 1 NOVST}
- {370713600 25200 0 NOVT}
- {386442000 28800 1 NOVST}
- {402249600 25200 0 NOVT}
- {417978000 28800 1 NOVST}
- {433785600 25200 0 NOVT}
- {449600400 28800 1 NOVST}
- {465332400 25200 0 NOVT}
- {481057200 28800 1 NOVST}
- {496782000 25200 0 NOVT}
- {512506800 28800 1 NOVST}
- {528231600 25200 0 NOVT}
- {543956400 28800 1 NOVST}
- {559681200 25200 0 NOVT}
- {575406000 28800 1 NOVST}
- {591130800 25200 0 NOVT}
- {606855600 28800 1 NOVST}
- {622580400 25200 0 NOVT}
- {638305200 28800 1 NOVST}
- {654634800 25200 0 NOVT}
- {670359600 21600 0 NOVMMTT}
- {670363200 25200 1 NOVST}
- {686088000 21600 0 NOVT}
- {695764800 25200 0 NOVMMTT}
- {701809200 28800 1 NOVST}
- {717534000 25200 0 NOVT}
- {733258800 28800 1 NOVST}
- {738090000 25200 0 NOVST}
- {748987200 21600 0 NOVT}
- {764712000 25200 1 NOVST}
- {780436800 21600 0 NOVT}
- {796161600 25200 1 NOVST}
- {811886400 21600 0 NOVT}
- {828216000 25200 1 NOVST}
- {846360000 21600 0 NOVT}
- {859665600 25200 1 NOVST}
- {877809600 21600 0 NOVT}
- {891115200 25200 1 NOVST}
- {909259200 21600 0 NOVT}
- {922564800 25200 1 NOVST}
- {941313600 21600 0 NOVT}
- {954014400 25200 1 NOVST}
- {972763200 21600 0 NOVT}
- {985464000 25200 1 NOVST}
- {1004212800 21600 0 NOVT}
- {1017518400 25200 1 NOVST}
- {1035662400 21600 0 NOVT}
- {1048968000 25200 1 NOVST}
- {1067112000 21600 0 NOVT}
- {1080417600 25200 1 NOVST}
- {1099166400 21600 0 NOVT}
- {1111867200 25200 1 NOVST}
- {1130616000 21600 0 NOVT}
- {1143316800 25200 1 NOVST}
- {1162065600 21600 0 NOVT}
- {1174766400 25200 1 NOVST}
- {1193515200 21600 0 NOVT}
- {1206820800 25200 1 NOVST}
- {1224964800 21600 0 NOVT}
- {1238270400 25200 1 NOVST}
- {1256414400 21600 0 NOVT}
- {1269720000 25200 1 NOVST}
- {1288468800 21600 0 NOVT}
- {1301169600 25200 0 NOVT}
- {1414263600 21600 0 NOVT}
+ {-1579476700 21600 0 +06}
+ {-1247551200 25200 0 +08}
+ {354906000 28800 1 +08}
+ {370713600 25200 0 +07}
+ {386442000 28800 1 +08}
+ {402249600 25200 0 +07}
+ {417978000 28800 1 +08}
+ {433785600 25200 0 +07}
+ {449600400 28800 1 +08}
+ {465332400 25200 0 +07}
+ {481057200 28800 1 +08}
+ {496782000 25200 0 +07}
+ {512506800 28800 1 +08}
+ {528231600 25200 0 +07}
+ {543956400 28800 1 +08}
+ {559681200 25200 0 +07}
+ {575406000 28800 1 +08}
+ {591130800 25200 0 +07}
+ {606855600 28800 1 +08}
+ {622580400 25200 0 +07}
+ {638305200 28800 1 +08}
+ {654634800 25200 0 +07}
+ {670359600 21600 0 +07}
+ {670363200 25200 1 +07}
+ {686088000 21600 0 +06}
+ {695764800 25200 0 +08}
+ {701809200 28800 1 +08}
+ {717534000 25200 0 +07}
+ {733258800 28800 1 +08}
+ {738090000 25200 0 +07}
+ {748987200 21600 0 +06}
+ {764712000 25200 1 +07}
+ {780436800 21600 0 +06}
+ {796161600 25200 1 +07}
+ {811886400 21600 0 +06}
+ {828216000 25200 1 +07}
+ {846360000 21600 0 +06}
+ {859665600 25200 1 +07}
+ {877809600 21600 0 +06}
+ {891115200 25200 1 +07}
+ {909259200 21600 0 +06}
+ {922564800 25200 1 +07}
+ {941313600 21600 0 +06}
+ {954014400 25200 1 +07}
+ {972763200 21600 0 +06}
+ {985464000 25200 1 +07}
+ {1004212800 21600 0 +06}
+ {1017518400 25200 1 +07}
+ {1035662400 21600 0 +06}
+ {1048968000 25200 1 +07}
+ {1067112000 21600 0 +06}
+ {1080417600 25200 1 +07}
+ {1099166400 21600 0 +06}
+ {1111867200 25200 1 +07}
+ {1130616000 21600 0 +06}
+ {1143316800 25200 1 +07}
+ {1162065600 21600 0 +06}
+ {1174766400 25200 1 +07}
+ {1193515200 21600 0 +06}
+ {1206820800 25200 1 +07}
+ {1224964800 21600 0 +06}
+ {1238270400 25200 1 +07}
+ {1256414400 21600 0 +06}
+ {1269720000 25200 1 +07}
+ {1288468800 21600 0 +06}
+ {1301169600 25200 0 +07}
+ {1414263600 21600 0 +06}
+ {1469304000 25200 0 +07}
}
diff --git a/library/tzdata/Atlantic/Faroe b/library/tzdata/Atlantic/Faroe
index d2c314a..d2c314a 100644..100755
--- a/library/tzdata/Atlantic/Faroe
+++ b/library/tzdata/Atlantic/Faroe
diff --git a/library/tzdata/Australia/Eucla b/library/tzdata/Australia/Eucla
index 08a1948..08a1948 100644..100755
--- a/library/tzdata/Australia/Eucla
+++ b/library/tzdata/Australia/Eucla
diff --git a/library/tzdata/Europe/Guernsey b/library/tzdata/Europe/Guernsey
index 4372c64..4372c64 100644..100755
--- a/library/tzdata/Europe/Guernsey
+++ b/library/tzdata/Europe/Guernsey
diff --git a/library/tzdata/Europe/Isle_of_Man b/library/tzdata/Europe/Isle_of_Man
index 870ac45..870ac45 100644..100755
--- a/library/tzdata/Europe/Isle_of_Man
+++ b/library/tzdata/Europe/Isle_of_Man
diff --git a/library/tzdata/Europe/Jersey b/library/tzdata/Europe/Jersey
index e4da512..e4da512 100644..100755
--- a/library/tzdata/Europe/Jersey
+++ b/library/tzdata/Europe/Jersey
diff --git a/library/tzdata/Europe/Minsk b/library/tzdata/Europe/Minsk
index 5e47063..2857e5b 100644
--- a/library/tzdata/Europe/Minsk
+++ b/library/tzdata/Europe/Minsk
@@ -30,10 +30,10 @@ set TZData(:Europe/Minsk) {
{606870000 14400 1 MSD}
{622594800 10800 0 MSK}
{631141200 10800 0 MSK}
- {670374000 10800 1 EEST}
+ {670374000 7200 0 EEMMTT}
+ {670377600 10800 1 EEST}
{686102400 7200 0 EET}
- {701820000 10800 1 EEST}
- {717544800 10800 0 EEST}
+ {701827200 10800 1 EEST}
{717552000 7200 0 EET}
{733276800 10800 1 EEST}
{749001600 7200 0 EET}
diff --git a/library/tzdata/Europe/Podgorica b/library/tzdata/Europe/Podgorica
index f4f9066..f4f9066 100644..100755
--- a/library/tzdata/Europe/Podgorica
+++ b/library/tzdata/Europe/Podgorica
diff --git a/library/tzdata/Indian/Kerguelen b/library/tzdata/Indian/Kerguelen
index b41b85a..8820010 100644
--- a/library/tzdata/Indian/Kerguelen
+++ b/library/tzdata/Indian/Kerguelen
@@ -1,6 +1,6 @@
# created by tools/tclZIC.tcl - do not edit
set TZData(:Indian/Kerguelen) {
- {-9223372036854775808 0 0 zzz}
+ {-9223372036854775808 0 0 -00}
{-631152000 18000 0 TFT}
}
diff --git a/macosx/GNUmakefile b/macosx/GNUmakefile
index 1d26a7a..54eea8e 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.ac)
+VERSION := $(shell awk -F= '/^TCL_VERSION/ {print $$2; nextfile}' ${UNIX_DIR}/configure.in)
TCLSH := tclsh${VERSION}
BUILD_TARGET := all tcltest
diff --git a/macosx/Tcl.xcode/project.pbxproj b/macosx/Tcl.xcode/project.pbxproj
index a99afc5..a28b8db 100644
--- a/macosx/Tcl.xcode/project.pbxproj
+++ b/macosx/Tcl.xcode/project.pbxproj
@@ -769,7 +769,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.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
+ F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; 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 +792,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.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
+ F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
@@ -836,7 +836,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.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
+ F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
F96D447608F272BA004A47F5 /* makefile.bc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.bc; sourceTree = "<group>"; };
F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
@@ -1666,7 +1666,7 @@
children = (
F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
F96D43D208F272B8004A47F5 /* configure */,
- F96D43D308F272B8004A47F5 /* configure.ac */,
+ F96D43D308F272B8004A47F5 /* configure.in */,
F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
F96D442508F272B8004A47F5 /* genStubs.tcl */,
F96D442708F272B8004A47F5 /* index.tcl */,
@@ -1697,7 +1697,7 @@
children = (
F96D444008F272B9004A47F5 /* aclocal.m4 */,
F96D444108F272B9004A47F5 /* configure */,
- F96D444208F272B9004A47F5 /* configure.ac */,
+ F96D444208F272B9004A47F5 /* configure.in */,
F96D444308F272B9004A47F5 /* dltest */,
F96D444D08F272B9004A47F5 /* install-sh */,
F96D444E08F272B9004A47F5 /* installManPage */,
@@ -1758,7 +1758,7 @@
F96D447208F272BA004A47F5 /* cat.c */,
F96D447308F272BA004A47F5 /* coffbase.txt */,
F96D447408F272BA004A47F5 /* configure */,
- F96D447508F272BA004A47F5 /* configure.ac */,
+ F96D447508F272BA004A47F5 /* configure.in */,
F96D447608F272BA004A47F5 /* makefile.bc */,
F96D447708F272BA004A47F5 /* Makefile.in */,
F96D447808F272BA004A47F5 /* makefile.vc */,
@@ -1946,7 +1946,7 @@
);
inputPaths = (
"$(TCL_SRCROOT)/macosx/configure.ac",
- "$(TCL_SRCROOT)/unix/configure.ac",
+ "$(TCL_SRCROOT)/unix/configure.in",
"$(TCL_SRCROOT)/unix/tcl.m4",
"$(TCL_SRCROOT)/unix/aclocal.m4",
"$(TCL_SRCROOT)/unix/tclConfig.sh.in",
@@ -1959,7 +1959,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.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";
+ shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
showEnvVarsInLog = 0;
};
/* End PBXShellScriptBuildPhase section */
diff --git a/macosx/Tcl.xcodeproj/project.pbxproj b/macosx/Tcl.xcodeproj/project.pbxproj
index 393fd31..7c0d083 100644
--- a/macosx/Tcl.xcodeproj/project.pbxproj
+++ b/macosx/Tcl.xcodeproj/project.pbxproj
@@ -769,7 +769,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.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
+ F96D43D308F272B8004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; 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 +792,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.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
+ F96D444208F272B9004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
F96D444408F272B9004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D444508F272B9004A47F5 /* pkga.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkga.c; sourceTree = "<group>"; };
F96D444608F272B9004A47F5 /* pkgb.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = pkgb.c; sourceTree = "<group>"; };
@@ -836,7 +836,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.ac */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.ac; sourceTree = "<group>"; };
+ F96D447508F272BA004A47F5 /* configure.in */ = {isa = PBXFileReference; explicitFileType = text.script.sh; fileEncoding = 4; path = configure.in; sourceTree = "<group>"; };
F96D447608F272BA004A47F5 /* makefile.bc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.bc; sourceTree = "<group>"; };
F96D447708F272BA004A47F5 /* Makefile.in */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = Makefile.in; sourceTree = "<group>"; };
F96D447808F272BA004A47F5 /* makefile.vc */ = {isa = PBXFileReference; explicitFileType = sourcecode.make; fileEncoding = 4; path = makefile.vc; sourceTree = "<group>"; };
@@ -1666,7 +1666,7 @@
children = (
F96D43D108F272B8004A47F5 /* checkLibraryDoc.tcl */,
F96D43D208F272B8004A47F5 /* configure */,
- F96D43D308F272B8004A47F5 /* configure.ac */,
+ F96D43D308F272B8004A47F5 /* configure.in */,
F96D442408F272B8004A47F5 /* fix_tommath_h.tcl */,
F96D442508F272B8004A47F5 /* genStubs.tcl */,
F96D442708F272B8004A47F5 /* index.tcl */,
@@ -1697,7 +1697,7 @@
children = (
F96D444008F272B9004A47F5 /* aclocal.m4 */,
F96D444108F272B9004A47F5 /* configure */,
- F96D444208F272B9004A47F5 /* configure.ac */,
+ F96D444208F272B9004A47F5 /* configure.in */,
F96D444308F272B9004A47F5 /* dltest */,
F96D444D08F272B9004A47F5 /* install-sh */,
F96D444E08F272B9004A47F5 /* installManPage */,
@@ -1758,7 +1758,7 @@
F96D447208F272BA004A47F5 /* cat.c */,
F96D447308F272BA004A47F5 /* coffbase.txt */,
F96D447408F272BA004A47F5 /* configure */,
- F96D447508F272BA004A47F5 /* configure.ac */,
+ F96D447508F272BA004A47F5 /* configure.in */,
F96D447608F272BA004A47F5 /* makefile.bc */,
F96D447708F272BA004A47F5 /* Makefile.in */,
F96D447808F272BA004A47F5 /* makefile.vc */,
@@ -1946,7 +1946,7 @@
);
inputPaths = (
"$(TCL_SRCROOT)/macosx/configure.ac",
- "$(TCL_SRCROOT)/unix/configure.ac",
+ "$(TCL_SRCROOT)/unix/configure.in",
"$(TCL_SRCROOT)/unix/tcl.m4",
"$(TCL_SRCROOT)/unix/aclocal.m4",
"$(TCL_SRCROOT)/unix/tclConfig.sh.in",
@@ -1959,7 +1959,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.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";
+ shellScript = "## tcl configure shell script phase\n\ncd \"${TCL_SRCROOT}\"/macosx &&\nif [ configure.ac -nt configure -o ../unix/configure.in -nt configure -o ../unix/tcl.m4 -nt configure -o ../unix/aclocal.m4 -nt configure ]; then\n echo \"Running autoconf & autoheader in tcl/macosx\"\n rm -rf autom4te.cache\n ${AUTOCONF:-${DEVELOPER_DIR}/usr/bin/autoconf} && ${AUTOHEADER:-${DEVELOPER_DIR}/usr/bin/autoheader} || exit $?\n rm -rf autom4te.cache\nfi\n\ncd \"${DERIVED_FILE_DIR}\" && mkdir -p tcl && cd tcl &&\nif [ \"${TCL_SRCROOT}\"/macosx/configure -nt config.status ]; then\n echo \"Configuring Tcl\"\n CC=$(xcrun -find ${GCC} || echo ${GCC})\n \"${TCL_SRCROOT}\"/macosx/configure --cache-file=../config.cache --prefix=${PREFIX} --bindir=${BINDIR} --libdir=${LIBDIR} --mandir=${MANDIR} --includedir=${INCLUDEDIR} --disable-shared CC=${CC} LD=${CC} ${CONFIGURE_ARGS}\nelse\n ./config.status\nfi\n";
showEnvVarsInLog = 0;
};
/* End PBXShellScriptBuildPhase section */
diff --git a/macosx/configure.ac b/macosx/configure.ac
index 6b1e3ac..f7a8bb3 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.ac)
+m4_include(../unix/configure.in)
diff --git a/tests/chanio.test b/tests/chanio.test
index 3017e81..9a27233 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -37,7 +37,7 @@ namespace eval ::tcl::test::io {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-
+
testConstraint testchannel [llength [info commands testchannel]]
testConstraint exec [llength [info commands exec]]
testConstraint openpipe 1
@@ -130,10 +130,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} {
@@ -248,7 +248,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
@@ -259,7 +259,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
@@ -288,7 +288,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
@@ -353,7 +353,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
@@ -441,7 +441,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
@@ -750,7 +750,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"
@@ -860,7 +860,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]
@@ -871,14 +871,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]
@@ -957,7 +957,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"
@@ -1183,7 +1183,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"
@@ -1423,7 +1423,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"
@@ -1435,7 +1435,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"
@@ -1447,7 +1447,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"
@@ -1515,7 +1515,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"
@@ -3901,7 +3901,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
}
@@ -4160,12 +4160,20 @@ test chan-io-33.4 {Tcl_Gets with long line} -setup {
} -cleanup {
chan close $f
} -result {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
-test chan-io-33.5 {Tcl_Gets with long line} {
+test chan-io-33.5 {Tcl_Gets with long line} -setup {
+ set f [open $path(test3) w]
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ close $f
+} -body {
set f [open $path(test3)]
set x [chan gets $f y]
chan close $f
list $x $y
-} {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+} -result {260 abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
test chan-io-33.6 {Tcl_Gets and end of file} -setup {
file delete $path(test3)
set x {}
@@ -5155,7 +5163,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]
@@ -5300,7 +5308,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] \
@@ -5453,7 +5461,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
@@ -6765,7 +6773,12 @@ test chan-io-52.10 {TclCopyChannel & encodings} {fcopy} {
chan close $out
file size $path(utf8-fcopy.txt)
} 5
-test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
+test chan-io-52.11 {TclCopyChannel & encodings} -setup {
+ set f [open $path(utf8-fcopy.txt) w]
+ fconfigure $f -encoding utf-8
+ puts $f "\u0410\u0410"
+ close $f
+} -constraints {fcopy} -body {
# binary to encoding => the input has to be in utf-8 to make sense to the
# encoder
set in [open $path(utf8-fcopy.txt) r]
@@ -6777,7 +6790,7 @@ test chan-io-52.11 {TclCopyChannel & encodings} {fcopy} {
chan close $in
chan close $out
file size $path(kyrillic.txt)
-} 3
+} -result 3
test chan-io-53.1 {CopyData} -setup {
file delete $path(test1)
diff --git a/tests/clock.test b/tests/clock.test
index 08036ca..615f3a8 100644
--- a/tests/clock.test
+++ b/tests/clock.test
@@ -35,9 +35,9 @@ testConstraint y2038 \
# TEST PLAN
# clock-1:
-# [clock format] - tests of bad and empty arguments
+# [clock format] - tests of bad and empty arguments
#
-# clock-2
+# clock-2
# formatting of year, month and day of month
#
# clock-3
@@ -195,7 +195,7 @@ namespace eval ::tcl::clock {
l li lii liii liv lv lvi lvii lviii lix
lx lxi lxii lxiii lxiv lxv lxvi lxvii lxviii lxix
lxx lxxi lxxii lxxiii lxxiv lxxv lxxvi lxxvii lxxviii lxxix
- lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
+ lxxx lxxxi lxxxii lxxxiii lxxxiv lxxxv lxxxvi lxxxvii lxxxviii
lxxxix
xc xci xcii xciii xciv xcv xcvi xcvii xcviii xcix
c
@@ -271,7 +271,7 @@ test clock-1.3 "clock format - empty val" {
test clock-1.4 "clock format - bad flag" {*}{
-body {
list [catch {clock format 0 -oops badflag} msg] $msg $::errorCode
- }
+ }
-match glob
-result {1 {bad option "-oops": must be -format, -gmt, -locale, or -timezone} {CLOCK badOption -oops}}
}
@@ -34992,10 +34992,6 @@ test clock-29.1800 {time parsing} {
} 86399
# END testcases29
-
-# BEGIN testcases30
-
-# Test [clock add]
test clock-30.1 {clock add years} {
set t [clock scan 2000-01-01 -format %Y-%m-%d -timezone :UTC]
set f [clock add $t 1 year -timezone :UTC]
@@ -35222,61 +35218,10 @@ test clock-30.25 {clock add seconds at DST conversion} {
set x1 [clock format $f1 -format {%Y-%m-%d %H:%M:%S %z} \
-timezone EST05:00EDT04:00,M4.1.0/02:00,M10.5.0/02:00]
} {2004-10-31 01:00:00 -0500}
-test clock-30.26 {clock add weekdays} {
- set t [clock scan {2013-11-20}] ;# Wednesday
- set f1 [clock add $t 3 weekdays]
- set x1 [clock format $f1 -format {%Y-%m-%d}]
-} {2013-11-25}
-test clock-30.27 {clock add weekdays starting on Saturday} {
- set t [clock scan {2013-11-23}] ;# Saturday
- set f1 [clock add $t 1 weekday]
- set x1 [clock format $f1 -format {%Y-%m-%d}]
-} {2013-11-25}
-test clock-30.28 {clock add weekdays starting on Sunday} {
- set t [clock scan {2013-11-24}] ;# Sunday
- set f1 [clock add $t 1 weekday]
- set x1 [clock format $f1 -format {%Y-%m-%d}]
-} {2013-11-25}
-test clock-30.29 {clock add 0 weekdays starting on a weekend} {
- set t [clock scan {2016-02-27}] ;# Saturday
- set f1 [clock add $t 0 weekdays]
- set x1 [clock format $f1 -format {%Y-%m-%d}]
-} {2016-02-27}
-test clock-30.30 {clock add weekdays and back} -body {
- set n [clock seconds]
- # we start on each day of the week
- for {set i 0} {$i < 7} {incr i} {
- set start [clock add $n $i days]
- set startu [clock format $start -format %u]
- # add 0 - 100 weekdays
- for {set j 0} {$j < 100} {incr j} {
- set forth [clock add $start $j weekdays]
- set back [clock add $forth -$j weekdays]
- # If $s was a weekday or $j was 0, $b must be the same day.
- # Otherwise, $b must be the immediately preceeding Friday
- set fail 0
- if {$j == 0 || $startu < 6} {
- if {$start != $back} { set fail 1}
- } else {
- set friday [clock add $start -[expr {$startu % 5}] days]
- if {$friday != $back} { set fail 1 }
- }
- if {$fail} {
- set sdate [clock format $start -format {%Y-%m-%d}]
- set bdate [clock format $back -format {%Y-%m-%d}]
- return "$sdate + $j - $j := $bdate"
- }
- }
- }
- return "OK"
-} -result {OK}
-
-# END testcases30
-
test clock-31.1 {system locale} \
-constraints win \
- -setup {
+ -setup {
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
@@ -35299,7 +35244,7 @@ test clock-31.1 {system locale} \
test clock-31.2 {system locale} \
-constraints win \
- -setup {
+ -setup {
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
@@ -35322,7 +35267,7 @@ test clock-31.2 {system locale} \
test clock-31.3 {system locale} \
-constraints win \
- -setup {
+ -setup {
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
@@ -35345,7 +35290,7 @@ test clock-31.3 {system locale} \
test clock-31.4 {system locale} \
-constraints win \
- -setup {
+ -setup {
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
@@ -35382,7 +35327,7 @@ test clock-31.4 {system locale} \
test clock-31.5 {system locale} \
-constraints win \
- -setup {
+ -setup {
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
@@ -35419,7 +35364,7 @@ test clock-31.5 {system locale} \
test clock-31.6 {system locale} \
-constraints win \
- -setup {
+ -setup {
namespace eval ::tcl::clock {
namespace import -force ::testClock::registry
}
@@ -35489,7 +35434,7 @@ test clock-32.1 {scan/format across the Gregorian change} {
}
set problems
} {}
-
+
# Legacy tests
# clock clicks
@@ -35523,7 +35468,7 @@ test clock-33.5 {clock clicks tests, millisecond timing test} {
# 60 msecs seems to be the max time slice under Windows 95/98
expr {
($end > $start) && (($end - $start) <= 60) ?
- "ok" :
+ "ok" :
"test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.5a {clock tests, millisecond timing test} {
@@ -35535,7 +35480,7 @@ test clock-33.5a {clock tests, millisecond timing test} {
# 60 msecs seems to be the max time slice under Windows 95/98
expr {
($end > $start) && (($end - $start) <= 60) ?
- "ok" :
+ "ok" :
"test should have taken 0-60 ms, actually took [expr $end - $start]"}
} {ok}
test clock-33.6 {clock clicks, milli with too much abbreviation} {
@@ -35859,31 +35804,31 @@ test clock-34.47 {ago with multiple relative units} {
} 180000
test clock-34.48 {more than one ToD} {*}{
- -body {clock scan {10:00 11:00}}
+ -body {clock scan {10:00 11:00}}
-returnCodes error
-result {unable to convert date-time string "10:00 11:00": more than one time of day in string}
}
test clock-34.49 {more than one date} {*}{
- -body {clock scan {1/1/2001 2/2/2002}}
+ -body {clock scan {1/1/2001 2/2/2002}}
-returnCodes error
-result {unable to convert date-time string "1/1/2001 2/2/2002": more than one date in string}
}
test clock-34.50 {more than one time zone} {*}{
- -body {clock scan {10:00 EST CST}}
+ -body {clock scan {10:00 EST CST}}
-returnCodes error
-result {unable to convert date-time string "10:00 EST CST": more than one time zone in string}
}
test clock-34.51 {more than one weekday} {*}{
- -body {clock scan {Monday Tuesday}}
+ -body {clock scan {Monday Tuesday}}
-returnCodes error
-result {unable to convert date-time string "Monday Tuesday": more than one weekday in string}
}
test clock-34.52 {more than one ordinal month} {*}{
- -body {clock scan {next January next March}}
+ -body {clock scan {next January next March}}
-returnCodes error
-result {unable to convert date-time string "next January next March": more than one ordinal month in string}
}
@@ -35979,7 +35924,7 @@ test clock-38.2 {make sure TZ is not cached after unset} \
}
} \
-result 1
-
+
test clock-39.1 {regression - synonym timezones} {
clock format 0 -format {%H:%M:%S} -timezone :US/Eastern
@@ -36051,7 +35996,7 @@ test clock-44.1 {regression test - time zone name containing hyphen } \
}
} \
-result {12:34:56-0500}
-
+
test clock-45.1 {regression test - time zone containing only two digits} \
-body {
clock scan 1985-04-12T10:15:30+04 -format %Y-%m-%dT%H:%M:%S%Z
@@ -36096,7 +36041,7 @@ test clock-48.1 {Bug 1185933: 'i' destroyed by clock init} -setup {
test clock-49.1 {regression test - localtime with negative arg (Bug 1237907)} \
-body {
- list [catch {
+ list [catch {
clock format -86400 -timezone :localtime -format %Y
} result] $result
} \
@@ -36335,7 +36280,7 @@ test clock-56.1 {use of zoneinfo, version 1} {*}{
}
-result {2004-01-01 00:00:00 MST}
}
-
+
test clock-56.2 {use of zoneinfo, version 2} {*}{
-setup {
clock format [clock seconds]
@@ -36385,7 +36330,7 @@ test clock-56.2 {use of zoneinfo, version 2} {*}{
removeFile PhoenixTwo $tzdir2
removeDirectory Test $tzdir
removeDirectory zoneinfo
- }
+ }
-body {
clock format 1072940400 -timezone :Test/PhoenixTwo \
-format {%Y-%m-%d %H:%M:%S %Z}
@@ -36595,7 +36540,7 @@ test clock-56.3 {use of zoneinfo, version 2, Y2038 compliance} {*}{
removeFile TijuanaTwo $tzdir2
removeDirectory Test $tzdir
removeDirectory zoneinfo
- }
+ }
-body {
clock format 2224738800 -timezone :Test/TijuanaTwo \
-format {%Y-%m-%d %H:%M:%S %Z}
@@ -36747,7 +36692,7 @@ test clock-56.4 {Bug 3470928} {*}{
removeFile Windhoek $tzdir2
removeDirectory Test $tzdir
removeDirectory zoneinfo
- }
+ }
-result {Sun Jan 08 22:30:06 WAST 2012}
}
@@ -36758,7 +36703,7 @@ test clock-57.1 {clock scan - abbreviated options} {
test clock-58.1 {clock l10n - Japanese localisation} {*}{
-setup {
proc backslashify { string } {
-
+
set retval {}
foreach char [split $string {}] {
scan $char %c ccode
@@ -36864,52 +36809,52 @@ test clock-59.1 {military time zones} {
test clock-60.1 {case insensitive weekday names} {
clock scan "2000-W01 monday" -gmt true -format "%G-W%V %a"
-} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
test clock-60.2 {case insensitive weekday names} {
clock scan "2000-W01 Monday" -gmt true -format "%G-W%V %a"
-} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
test clock-60.3 {case insensitive weekday names} {
clock scan "2000-W01 MONDAY" -gmt true -format "%G-W%V %a"
-} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
+} [clock scan "2000-W01-1" -gmt true -format "%G-W%V-%u"]
test clock-60.4 {case insensitive weekday names} {
clock scan "2000-W01 friday" -gmt true -format "%G-W%V %a"
-} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
test clock-60.5 {case insensitive weekday names} {
clock scan "2000-W01 Friday" -gmt true -format "%G-W%V %a"
-} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
test clock-60.6 {case insensitive weekday names} {
clock scan "2000-W01 FRIDAY" -gmt true -format "%G-W%V %a"
-} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
+} [clock scan "2000-W01-5" -gmt true -format "%G-W%V-%u"]
test clock-60.7 {case insensitive month names} {
clock scan "1 january 2000" -gmt true -format "%d %b %Y"
-} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
test clock-60.8 {case insensitive month names} {
clock scan "1 January 2000" -gmt true -format "%d %b %Y"
-} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
test clock-60.9 {case insensitive month names} {
clock scan "1 JANUARY 2000" -gmt true -format "%d %b %Y"
-} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
+} [clock scan "2000-01-01" -gmt true -format "%Y-%m-%d"]
test clock-60.10 {case insensitive month names} {
clock scan "1 december 2000" -gmt true -format "%d %b %Y"
-} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
test clock-60.11 {case insensitive month names} {
clock scan "1 December 2000" -gmt true -format "%d %b %Y"
-} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
test clock-60.12 {case insensitive month names} {
clock scan "1 DECEMBER 2000" -gmt true -format "%d %b %Y"
-} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
+} [clock scan "2000-12-01" -gmt true -format "%Y-%m-%d"]
test clock-61.1 {overflow of a wide integer on output} {*}{
-body {
clock format 0x8000000000000000 -format %s -gmt true
- }
+ }
-result {integer value too large to represent}
-returnCodes error
}
test clock-61.2 {overflow of a wide integer on output} {*}{
-body {
clock format -0x8000000000000001 -format %s -gmt true
- }
+ }
-result {integer value too large to represent}
-returnCodes error
}
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index 64cfeba..b4ef605 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -141,9 +141,13 @@ test cmdAH-2.6.2 {cd} -constraints {unix nonPortable} -setup {
} -cleanup {
cd $dir
} -result {/}
-test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -returnCodes error -body {
+test cmdAH-2.6.3 {Tcl_CdObjCmd, bug #3118489} -setup {
+ set dir [pwd]
+} -returnCodes error -body {
cd .\0
-} -result "couldn't change working directory to \".\0\": no such file or directory"
+} -cleanup {
+ cd $dir
+} -match glob -result "couldn't change working directory to \".\0\": *"
test cmdAH-2.7 {Tcl_ConcatObjCmd} {
concat
} {}
@@ -878,20 +882,20 @@ test cmdAH-18.3 {Tcl_FileObjCmd: executable} {unix testchmod} {
} 1
test cmdAH-18.5 {Tcl_FileObjCmd: executable} -constraints {win} -body {
# On pc, must be a .exe, .com, etc.
- set x [file exe $gorpfile]
- set gorpexe [makeFile foo gorp.exe]
- lappend x [file exe $gorpexe]
-} -cleanup {
- removeFile $gorpexe
-} -result {0 1}
-test cmdAH-18.5.1 {Tcl_FileObjCmd: executable} -constraints {win} -body {
- # On pc, must be a .exe, .com, etc.
- set x [file exe $gorpfile]
- set gorpexe [makeFile foo gorp.exe]
- lappend x [file exe [string toupper $gorpexe]]
+ set x {}
+ set gorpexes {}
+ foreach ext {exe com cmd bat} {
+ lappend x [file exe nosuchfile.$ext]
+ set gorpexe [makeFile foo gorp.$ext]
+ lappend gorpexes $gorpexe
+ lappend x [file exe $gorpexe] [file exe [string toupper $gorpexe]]
+ }
+ set x
} -cleanup {
- removeFile $gorpexe
-} -result {0 1}
+ foreach gorpexe $gorpexes {
+ removeFile $gorpexe
+ }
+} -result {0 1 1 0 1 1 0 1 1 0 1 1}
test cmdAH-18.6 {Tcl_FileObjCmd: executable} {} {
# Directories are always executable.
file exe $dirfile
@@ -1027,6 +1031,16 @@ test cmdAH-20.6 {Tcl_FileObjCmd: atime touch} -setup {
set modatime [file atime $file $newatime]
expr {$newatime == $modatime ? 1 : "$newatime != $modatime"}
} -result 1
+test cmdAH-20.7 {
+ Tcl_FileObjCmd: atime (built-in Windows names)
+} -constraints {win} -body {
+ file atime con
+} -result "could not get access time for file \"con\"" -returnCodes error
+test cmdAH-20.7.1 {
+ Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+ file atime [file join [temporaryDirectory] CON.txt]
+} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
if {[testConstraint unix] && [file exists /tmp]} {
removeFile touch.me /tmp
@@ -1258,6 +1272,16 @@ test cmdAH-24.13 {Tcl_FileObjCmd: directory mtime} -setup {
} -cleanup {
file delete -force $dirname
} -result {0 1}
+test cmdAH-24.14 {
+ Tcl_FileObjCmd: mtime (built-in Windows names)
+} -constraints {win} -body {
+ file mtime con
+} -result "could not get modification time for file \"con\"" -returnCodes error
+test cmdAH-24.14.1 {
+ Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+ file mtime [file join [temporaryDirectory] CON.txt]
+} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
# owned
test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
@@ -1277,6 +1301,12 @@ test cmdAH-25.2.1 {Tcl_FileObjCmd: owned} -constraints unix -setup {
test cmdAH-25.3 {Tcl_FileObjCmd: owned} {unix notRoot} {
file owned /
} 0
+test cmdAH-25.3.1 {Tcl_FileObjCmd: owned} -constraints win -body {
+ file owned $env(windir)
+} -result 0
+test cmdAH-25.4 {Tcl_FileObjCmd: owned} -body {
+ file owned nosuchfile
+} -result 0
# readlink
test cmdAH-26.1 {Tcl_FileObjCmd: readlink} -returnCodes error -body {
@@ -1307,6 +1337,16 @@ test cmdAH-27.2 {Tcl_FileObjCmd: size} {
test cmdAH-27.3 {Tcl_FileObjCmd: size} {
list [catch {file size _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-27.4 {
+ Tcl_FileObjCmd: size (built-in Windows names)
+} -constraints {win} -body {
+ file size con
+} -result 0
+test cmdAH-27.4.1 {
+ Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
+} -constraints {win} -body {
+ file size [file join [temporaryDirectory] con.txt]
+} -result 0
catch {testsetplatform $platform}
removeFile $gorpfile
@@ -1398,12 +1438,24 @@ test cmdAH-28.12 {Tcl_FileObjCmd: stat} -setup {
} -cleanup {
removeFile $filename
} -result 1
+test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
+ unset -nocomplain stat
+} -body {
+ file stat con stat
+ lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
+} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
+test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
+ unset -nocomplain stat
+} -body {
+ file stat [file join [temporaryDirectory] CON.txt] stat
+ lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
+} -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
unset -nocomplain stat
# type
test cmdAH-29.1 {Tcl_FileObjCmd: type} -returnCodes error -body {
- file size a b
-} -result {wrong # args: should be "file size name"}
+ file type a b
+} -result {wrong # args: should be "file type name"}
test cmdAH-29.2 {Tcl_FileObjCmd: type} {
file type $dirfile
} directory
@@ -1438,6 +1490,16 @@ test cmdAH-29.4.1 {Tcl_FileObjCmd: type} -constraints {linkDirectory} -setup {
test cmdAH-29.5 {Tcl_FileObjCmd: type} {
list [catch {file type _bogus_} msg] [string tolower $msg] $errorCode
} {1 {could not read "_bogus_": no such file or directory} {POSIX ENOENT {no such file or directory}}}
+test cmdAH-29.6 {
+ Tcl_FileObjCmd: type (built-in Windows names)
+} -constraints {win} -body {
+ file type con
+} -result "characterSpecial"
+test cmdAH-29.6.1 {
+ Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
+} -constraints {win} -body {
+ file type [file join [temporaryDirectory] CON.txt]
+} -result "characterSpecial"
# Error conditions
test cmdAH-30.1 {Tcl_FileObjCmd: error conditions} -returnCodes error -body {
diff --git a/tests/compile.test b/tests/compile.test
index 6aa7fd1..f021cf2 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 {$}]
@@ -678,7 +678,7 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
# change without warning.
set disassemblables [linsert [join {
- lambda method objmethod proc script
+ constructor destructor lambda method objmethod proc script
} ", "] end-1 or]
test compile-18.1 {disassembler - basics} -returnCodes error -body {
tcl::unsupported::disassemble
@@ -872,6 +872,103 @@ test compile-18.39 {disassembler - basics} -setup {
} -cleanup {
foo destroy
} -result "$bytecodekeys initiallinenumber sourcefile"
+test compile-18.40 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble constructor
+} -match glob -result {wrong # args: should be "* constructor className"}
+test compile-18.41 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble constructor nosuchclass
+} -result {nosuchclass does not refer to an object}
+test compile-18.42 {disassembler - basics} -returnCodes error -setup {
+ oo::object create justanobject
+} -body {
+ tcl::unsupported::disassemble constructor justanobject
+} -cleanup {
+ justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.43 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::disassemble constructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined constructor}
+test compile-18.44 {disassembler - basics} -setup {
+ oo::class create foo {constructor {} {set x 1}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble constructor foo
+} -cleanup {
+ foo destroy
+} -match glob -result *
+test compile-18.45 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode constructor
+} -match glob -result {wrong # args: should be "* constructor className"}
+test compile-18.46 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode constructor nosuchobject
+} -result {nosuchobject does not refer to an object}
+test compile-18.47 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::getbytecode constructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined constructor}
+test compile-18.48 {disassembler - basics} -setup {
+ oo::class create foo {constructor {} {set x 1}}
+} -body {
+ dict keys [tcl::unsupported::getbytecode constructor foo]
+} -cleanup {
+ foo destroy
+} -result "$bytecodekeys"
+# There is no compile-18.49
+test compile-18.50 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble destructor
+} -match glob -result {wrong # args: should be "* destructor className"}
+test compile-18.51 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::disassemble destructor nosuchclass
+} -result {nosuchclass does not refer to an object}
+test compile-18.52 {disassembler - basics} -returnCodes error -setup {
+ oo::object create justanobject
+} -body {
+ tcl::unsupported::disassemble destructor justanobject
+} -cleanup {
+ justanobject destroy
+} -result {"justanobject" is not a class}
+test compile-18.53 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::disassemble destructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined destructor}
+test compile-18.54 {disassembler - basics} -setup {
+ oo::class create foo {destructor {set x 1}}
+} -body {
+ # Allow any string: the result format is not defined anywhere!
+ tcl::unsupported::disassemble destructor foo
+} -cleanup {
+ foo destroy
+} -match glob -result *
+test compile-18.55 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode destructor
+} -match glob -result {wrong # args: should be "* destructor className"}
+test compile-18.56 {disassembler - basics} -returnCodes error -body {
+ tcl::unsupported::getbytecode destructor nosuchobject
+} -result {nosuchobject does not refer to an object}
+test compile-18.57 {disassembler - basics} -returnCodes error -setup {
+ oo::class create constructorless
+} -body {
+ tcl::unsupported::getbytecode destructor constructorless
+} -cleanup {
+ constructorless destroy
+} -result {"constructorless" has no defined destructor}
+test compile-18.58 {disassembler - basics} -setup {
+ oo::class create foo {destructor {set x 1}}
+} -body {
+ dict keys [tcl::unsupported::getbytecode destructor foo]
+} -cleanup {
+ foo destroy
+} -result "$bytecodekeys"
test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
# This will panic in a --enable-symbols=compile build, unless bug is fixed.
diff --git a/tests/env.test b/tests/env.test
index 9f59fbc..0dd4f98 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
# Some tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
-
+
#
# These tests will run on any platform (and indeed crashed on the Mac). So put
# them before you test for the existance of exec.
@@ -147,6 +147,7 @@ test env-2.2 {adding environment variables} -setup {
} -result {NAME1=test string}
test env-2.3 {adding environment variables} -setup {
encoding system iso8859-1
+ set env(NAME1) "test string"
} -constraints {exec} -body {
set env(NAME2) "more"
getenv
@@ -156,6 +157,8 @@ test env-2.3 {adding environment variables} -setup {
NAME2=more}
test env-2.4 {adding environment variables} -setup {
encoding system iso8859-1
+ set env(NAME1) "test string"
+ set env(NAME2) "more"
} -constraints {exec} -body {
set env(XYZZY) "garbage"
getenv
@@ -165,7 +168,9 @@ test env-2.4 {adding environment variables} -setup {
NAME2=more
XYZZY=garbage}
+set env(NAME1) "test string"
set env(NAME2) "new value"
+set env(XYZZY) "garbage"
test env-3.1 {changing environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
@@ -177,6 +182,7 @@ test env-3.1 {changing environment variables} -setup {
} -result {NAME1=test string
NAME2=new value
XYZZY=garbage}
+unset -nocomplain env(NAME2)
test env-4.1 {unsetting environment variables: default} -setup {
encoding system iso8859-1
@@ -195,6 +201,7 @@ test env-4.2 {unsetting environment variables} -setup {
unset env(XYZZY)
encoding system $sysenc
} -result {XYZZY=garbage}
+unset -nocomplain env(NAME1) env(XYZZY)
test env-4.3 {setting international environment variables} -setup {
encoding system iso8859-1
} -constraints {exec} -body {
@@ -213,6 +220,7 @@ test env-4.4 {changing international environment variables} -setup {
} -result {\u00a7=\u00a7}
test env-4.5 {unsetting international environment variables} -setup {
encoding system iso8859-1
+ set env(\ua7) \ua7
} -body {
set env(\ub6) \ua7
unset env(\ua7)
@@ -323,7 +331,7 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
return [info exists ::env(test7_3)]
}}
} -result 1
-
+
# Restore the environment variables at the end of the test.
foreach name [array names env] {
diff --git a/tests/exec.test b/tests/exec.test
index 16a8320..38927d3 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -682,6 +682,22 @@ test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
} -cleanup {
removeFile $tmpfile
} -result 14
+
+# Tests to ensure batch files and .CMD (Bug 9ece99d58b)
+# can be executed on Windows
+test exec-20.0 {exec .bat file} -constraints {win} -body {
+ set log [makeFile {} exec20.log]
+ exec [makeFile "echo %1> $log" exec20.bat] "Testing exec-20.0"
+ viewFile $log
+} -result "\"Testing exec-20.0\""
+test exec-20.1 {exec .CMD file} -constraints {win} -body {
+ set log [makeFile {} exec201.log]
+ exec [makeFile "echo %1> $log" exec201.CMD] "Testing exec-20.1"
+ viewFile $log
+} -result "\"Testing exec-20.1\""
+
+
+
# ----------------------------------------------------------------------
# cleanup
diff --git a/tests/fileName.test b/tests/fileName.test
index 51f00d1..387d844 100644
--- a/tests/fileName.test
+++ b/tests/fileName.test
@@ -1468,14 +1468,16 @@ if {[testConstraint testsetplatform]} {
}
test filename-17.2 {windows specific glob with executable} -body {
makeDirectory execglob
- makeFile contents execglob/abc.exe
- makeFile contents execglob/abc.notexecutable
- glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *
+ foreach ext {exe com cmd bat notexecutable} {
+ makeFile contents execglob/abc.$ext
+ }
+ lsort [glob -nocomplain -dir [temporaryDirectory]/execglob -tails -types x *]
} -constraints {win} -cleanup {
- removeFile execglob/abc.exe
- removeFile execglob/abc.notexecutable
+ foreach ext {exe com cmd bat ps1 notexecutable} {
+ removeFile execglob/abc.$ext
+ }
removeDirectory execglob
-} -result {abc.exe}
+} -result {abc.bat abc.cmd abc.com abc.exe}
test filename-17.3 {Bug 2571597} win {
set p /a
file pathtype $p
diff --git a/tests/history.test b/tests/history.test
index 1a255a4..7549beb 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 {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest
namespace import -force ::tcltest::*
@@ -233,6 +233,7 @@ if {[testConstraint history]} {
test history-8.1 {clear option} history {catch {history clear junk}} 1
test history-8.2 {clear option} history {history clear} {}
if {[testConstraint history]} {
+ history clear
history add "Testing"
}
test history-8.3 {clear option} history {history} { 1 Testing}
@@ -248,3 +249,7 @@ test history-9.2 {miscellaneous} history {
# cleanup
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/info.test b/tests/info.test
index a6a5919..42f5a96 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -1841,7 +1841,7 @@ test info-30.48 {Bug 2850901} testevalex {
# -------------------------------------------------------------------------
# literal sharing 2, bug 2933089
-test info-39.1 {location information not confused by literal sharing, bug 2933089} -setup {
+test info-40.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 {
@@ -2398,7 +2398,7 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body {
# -------------------------------------------------------------------------
unset -nocomplain res
-test info-39.0 {Bug 4b61afd660} -setup {
+test info-39.1 {Bug 4b61afd660} -setup {
proc probe {} {
return [dict get [info frame -1] line]
}
diff --git a/tests/interp.test b/tests/interp.test
index 6c9fb56..f9c1aec 100644
--- a/tests/interp.test
+++ b/tests/interp.test
@@ -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,10 +70,12 @@ test interp-2.2 {basic interpreter creation} {
} 0
test interp-2.3 {basic interpreter creation} {
catch {interp create -safe}
-} 0
-test interp-2.4 {basic interpreter creation} {
- list [catch {interp create a} msg] $msg
-} {1 {interpreter named "a" already exists, cannot create}}
+} 0
+test interp-2.4 {basic interpreter creation} -setup {
+ catch {interp create a}
+} -returnCodes error -body {
+ interp create a
+} -result {interpreter named "a" already exists, cannot create}
test interp-2.5 {basic interpreter creation} {
interp create b -safe
} b
@@ -89,11 +91,13 @@ test interp-2.8 {basic interpreter creation} {
test interp-2.9 {basic interpreter creation} {
interp create -safe -- -froboz1
} -froboz1
-test interp-2.10 {basic interpreter creation} {
+test interp-2.10 {basic interpreter creation} -setup {
+ catch {interp create a}
+} -body {
interp create {a x1}
interp create {a x2}
interp create {a x3} -safe
-} {a x3}
+} -result {a x3}
test interp-2.11 {anonymous interps vs existing procs} {
set x [interp create]
regexp "interp(\[0-9]+)" $x dummy thenum
@@ -102,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
@@ -140,19 +144,26 @@ test interp-3.5 {testing interp exists and interp slaves} -body {
test interp-3.6 {testing interp exists and interp slaves} {
interp exists
} 1
-test interp-3.7 {testing interp exists and interp slaves} {
+test interp-3.7 {testing interp exists and interp slaves} -setup {
+ catch {interp create a}
+} -body {
interp slaves
-} a
+} -result a
test interp-3.8 {testing interp exists and interp slaves} -body {
interp slaves a b c
} -returnCodes error -result {wrong # args: should be "interp slaves ?path?"}
-test interp-3.9 {testing interp exists and interp slaves} {
+test interp-3.9 {testing interp exists and interp slaves} -setup {
+ catch {interp create a}
+} -body {
interp create {a a2} -safe
expr {"a2" in [interp slaves a]}
-} 1
-test interp-3.10 {testing interp exists and interp slaves} {
+} -result 1
+test interp-3.10 {testing interp exists and interp slaves} -setup {
+ catch {interp create a}
+ catch {interp create {a a2}}
+} -body {
interp exists {a a2}
-} 1
+} -result 1
# Part 3: Testing "interp delete"
test interp-3.11 {testing interp delete} {
@@ -222,6 +233,7 @@ test interp-6.3 {testing eval} {
a eval {proc foo {} {expr 3 + 5}}
a eval foo
} 8
+catch {a eval {proc foo {} {expr 3 + 5}}}
test interp-6.4 {testing eval} {
interp eval a foo
} 8
@@ -230,6 +242,7 @@ test interp-6.5 {testing eval} {
interp eval {a x2} {proc frob {} {expr 4 * 9}}
interp eval {a x2} frob
} 36
+catch {interp create {a x2}}
test interp-6.6 {testing eval} -returnCodes error -body {
interp eval {a x2} foo
} -result {invalid command name "foo"}
@@ -243,9 +256,11 @@ proc in_master {args} {
test interp-7.1 {testing basic alias creation} {
a alias foo in_master
} foo
+catch {a alias foo in_master}
test interp-7.2 {testing basic alias creation} {
a alias bar in_master a1 a2 a3
} bar
+catch {a alias bar in_master a1 a2 a3}
# Test 6.3 has been deleted.
test interp-7.3 {testing basic alias creation} {
a alias foo
@@ -476,9 +491,13 @@ test interp-13.4 {testing issafe arg checking} {
} {1 {wrong # args: should be "a issafe"}}
# part 14: testing interp aliases
-test interp-14.1 {testing interp aliases} {
- interp aliases
-} ""
+test interp-14.1 {testing interp aliases} -setup {
+ interp create abc
+} -body {
+ interp eval abc {interp aliases}
+} -cleanup {
+ interp delete abc
+} -result ""
test interp-14.2 {testing interp aliases} {
catch {interp delete a}
interp create a
@@ -844,12 +863,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
@@ -939,7 +958,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]
@@ -1160,7 +1179,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
@@ -1169,7 +1188,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
@@ -1178,7 +1197,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
@@ -1188,7 +1207,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
@@ -1207,7 +1226,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
@@ -1218,9 +1237,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
@@ -1229,7 +1248,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
@@ -1240,9 +1259,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
@@ -1252,9 +1271,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
@@ -1264,7 +1283,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
@@ -1644,7 +1663,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 ""
@@ -2168,7 +2187,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]
}
@@ -2182,7 +2201,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]
}
@@ -2196,7 +2215,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]
}
@@ -2212,7 +2231,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]
}
@@ -3289,7 +3308,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]
@@ -3523,7 +3542,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 46856b6..2084991 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -44,6 +44,7 @@ testConstraint testfevent [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]
testConstraint testmainthread [llength [info commands testmainthread]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+testConstraint testobj [llength [info commands testobj]]
# You need a *very* special environment to do some tests. In
# particular, many file systems do not support large-files...
@@ -4285,6 +4286,13 @@ test io-33.4 {Tcl_Gets with long line} {
close $f
set x
} {abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ}
+set f [open $path(test3) w]
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts -nonewline $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+puts $f "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+close $f
test io-33.5 {Tcl_Gets with long line} {
set f [open $path(test3)]
set x [gets $f y]
@@ -7141,7 +7149,12 @@ test io-52.10 {TclCopyChannel & encodings} {fcopy} {
file size $path(utf8-fcopy.txt)
} 5
-test io-52.11 {TclCopyChannel & encodings} {fcopy} {
+test io-52.11 {TclCopyChannel & encodings} -setup {
+ set out [open $path(utf8-fcopy.txt) w]
+ fconfigure $out -encoding utf-8 -translation lf
+ puts $out "\u0410\u0410"
+ close $out
+} -constraints {fcopy} -body {
# binary to encoding => the input has to be
# in utf-8 to make sense to the encoder
@@ -7157,7 +7170,7 @@ test io-52.11 {TclCopyChannel & encodings} {fcopy} {
close $out
file size $path(kyrillic.txt)
-} 3
+} -result 3
test io-52.12 {coverage of -translation auto} {
file delete $path(test1) $path(test2)
@@ -8626,6 +8639,24 @@ test io-73.5 {effect of eof on encoding end flags} -setup {
removeFile io-73.5
} -result [list 1 1 more\u00a0data 1]
+test io-74.1 {[104f2885bb] improper cache validity check} -setup {
+ set fn [makeFile {} io-74.1]
+ set rfd [open $fn r]
+ testobj freeallvars
+ interp create slave
+} -constraints testobj -body {
+ teststringobj set 1 [string range $rfd 0 end]
+ read [teststringobj get 1]
+ testobj duplicate 1 2
+ interp transfer {} $rfd slave
+ catch {read [teststringobj get 1]}
+ read [teststringobj get 2]
+} -cleanup {
+ interp delete slave
+ testobj freeallvars
+ removeFile io-74.1
+} -returnCodes error -match glob -result {can not find channel named "*"}
+
# ### ### ### ######### ######### #########
# cleanup
diff --git a/tests/load.test b/tests/load.test
index 9536271..7c4b47f 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -124,9 +124,11 @@ test load-3.2 {error in _Init procedure, slave interpreter} \
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
-test load-4.2 {reloading package into same interpreter} [list $dll $loaded] {
- list [catch {load [file join $testDir pkga$ext] pkgb} msg] $msg
-} [list 1 "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""]
+test load-4.2 {reloading package into same interpreter} -setup {
+ catch {load [file join $testDir pkga$ext] pkga}
+} -constraints [list $dll $loaded] -returnCodes error -body {
+ load [file join $testDir pkga$ext] pkgb
+} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
test load-5.1 {file name not specified and no static package: pick default} \
[list $dll $loaded] {
@@ -169,26 +171,40 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
load {} More
set x
} {not loaded}
-test load-7.4 {Tcl_StaticPackage procedure, redundant calls} \
- [list teststaticpkg $dll $loaded] {
- teststaticpkg Double 0 1
- teststaticpkg Double 0 1
- info loaded
- } [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
+catch {load [file join $testDir pkga$ext] pkga}
+catch {load [file join $testDir pkgb$ext] pkgb}
+catch {load [file join $testDir pkge$ext] pkge}
+set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
+test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
+ teststaticpkg Test 1 0
+ teststaticpkg Another 0 0
+ teststaticpkg More 0 1
+} -constraints [list teststaticpkg $dll $loaded] -body {
+ teststaticpkg Double 0 1
+ teststaticpkg Double 0 1
+ info loaded
+} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
+teststaticpkg Test 1 1
+teststaticpkg Another 0 1
+teststaticpkg More 0 1
+teststaticpkg Double 0 1
test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
- info loaded
-} [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]] $alreadyTotalLoaded]
-test load-8.2 {TclGetLoadedPackages procedure} [list teststaticpkg] {
- list [catch {info loaded gorp} msg] $msg
-} {1 {could not find interpreter "gorp"}}
-test load-8.3 {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
- list [info loaded {}] [info loaded child]
-} [list [concat [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
+ lsort -index 1 [info loaded]
+} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
+test load-8.2 {TclGetLoadedPackages procedure} -body {
+ info loaded gorp
+} -returnCodes error -result {could not find interpreter "gorp"}
+test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+ lsort -index 1 [info loaded {}]
+} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
+test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg $dll $loaded] {
+ lsort -index 1 [info loaded child]
+} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list $dll $loaded teststaticpkg] {
load [file join $testDir pkgb$ext] pkgb
- list [info loaded {}] [lsort [info commands pkgb_*]]
-} [list [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded] {pkgb_demo pkgb_sub pkgb_unsafe}]
+ list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
+} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child
test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} \
diff --git a/tests/msgcat.test b/tests/msgcat.test
index f50ebfb..e69220e 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -68,6 +68,7 @@ namespace eval ::msgcat::test {
set result c
}
}
+
test msgcat-0.$count [list \
locale initialization from environment variables $setVars \
] -setup {
@@ -974,6 +975,9 @@ namespace eval ::msgcat::test {
set bgerrorsaved [interp bgerror {}]
interp bgerror {} [namespace code callbackproc]
+ variable locale
+ if {![info exist locale]} { set locale [mclocale] }
+
test msgcat-14.1 {invokation loadcmd} -setup {
mcforgetpackage
mclocale $locale
@@ -1068,7 +1072,7 @@ namespace eval ::msgcat::test {
mc k1
} -returnCodes 1\
-result {fail}
-
+
interp bgerror {} $bgerrorsaved
cleanupTests
@@ -1076,3 +1080,6 @@ namespace eval ::msgcat::test {
namespace delete ::msgcat::test
return
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 1d8ba31..1d6a805 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -57,6 +57,12 @@ test namespace-old-1.9 {add elements to a namespace} {
}
}
} {}
+namespace eval test_ns_simple {
+ variable test_ns_x 0
+ proc test {test_ns_x} {
+ return "test: $test_ns_x"
+ }
+}
test namespace-old-1.10 {commands in a namespace} {
namespace eval test_ns_simple { info commands [namespace current]::*}
} {::test_ns_simple::test}
@@ -74,6 +80,12 @@ test namespace-old-1.13 {add to an existing namespace} {
}
}
} ""
+namespace eval test_ns_simple {
+ variable test_ns_y 123
+ proc _backdoor {cmd} {
+ eval $cmd
+ }
+}
test namespace-old-1.14 {commands in a namespace} {
lsort [namespace eval test_ns_simple {info commands [namespace current]::*}]
} {::test_ns_simple::_backdoor ::test_ns_simple::test}
@@ -128,6 +140,8 @@ test namespace-old-1.26 {namespace qualifiers are okay after $'s} {
test namespace-old-1.27 {can create commands with null names} {
proc test_ns_simple:: {args} {return $args}
} {}
+# Redeclare; later tests depend on it
+proc test_ns_simple:: {args} {return $args}
# -----------------------------------------------------------------------
# TEST: using "info" in namespace contexts
@@ -212,6 +226,11 @@ test namespace-old-4.3 {command "namespace delete" doesn't support patterns} {
}
list [catch $cmd msg] $msg
} {1 {unknown namespace "ns*" in namespace delete command}}
+namespace eval test_ns_delete {
+ namespace eval ns1 {}
+ namespace eval ns2 {}
+ namespace eval another {}
+}
test namespace-old-4.4 {command "namespace delete" handles multiple args} {
set cmd {
namespace eval test_ns_delete {
@@ -256,6 +275,24 @@ test namespace-old-5.3 {namespace qualifiers work in namespace command} {
[namespace eval test_ns_hier1::test_ns_hier2 {namespace current}] \
[namespace eval ::test_ns_hier1::test_ns_hier2 {namespace current}]
} {::test_ns_hier1 ::test_ns_hier1::test_ns_hier2 ::test_ns_hier1::test_ns_hier2}
+set ::test_ns_var_global "var in ::"
+proc test_ns_cmd_global {} {return "cmd in ::"}
+namespace eval test_ns_hier1 {
+ variable test_ns_var_hier1 "particular to hier1"
+ proc test_ns_cmd_hier1 {} {return "particular to hier1"}
+ variable test_ns_level 1
+ proc test_ns_show {} {return "[namespace current]: 1"}
+ namespace eval test_ns_hier2 {
+ variable test_ns_var_hier2 "particular to hier2"
+ proc test_ns_cmd_hier2 {} {return "particular to hier2"}
+ variable test_ns_level 2
+ proc test_ns_show {} {return "[namespace current]: 2"}
+ namespace eval test_ns_hier3a {}
+ namespace eval test_ns_hier3b {}
+ }
+ namespace eval test_ns_hier2a {}
+ namespace eval test_ns_hier2b {}
+}
test namespace-old-5.4 {nested namespaces can access global namespace} {
list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
[namespace eval test_ns_hier1 {test_ns_cmd_global}] \
@@ -331,16 +368,12 @@ test namespace-old-5.21 {querying namespace parent for explicit namespace} {
# -----------------------------------------------------------------------
# TEST: name resolution and caching
# -----------------------------------------------------------------------
+set trigger {namespace eval test_ns_cache2 {namespace current}}
+set trigger2 {namespace eval test_ns_cache2::test_ns_cache3 {namespace current}}
test namespace-old-6.1 {relative ns names only looked up in current ns} {
namespace eval test_ns_cache1 {}
namespace eval test_ns_cache2 {}
namespace eval test_ns_cache2::test_ns_cache3 {}
- set trigger {
- namespace eval test_ns_cache2 {namespace current}
- }
- set trigger2 {
- namespace eval test_ns_cache2::test_ns_cache3 {namespace current}
- }
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
@@ -354,20 +387,19 @@ test namespace-old-6.3 {relative ns names only looked up in current ns} {
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+namespace eval test_ns_cache1::test_ns_cache2 {}
test namespace-old-6.4 {relative ns names only looked up in current ns} {
namespace delete test_ns_cache1::test_ns_cache2
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 $trigger2]
} {::test_ns_cache1::test_ns_cache2 ::test_ns_cache1::test_ns_cache2::test_ns_cache3}
+namespace eval test_ns_cache1 {
+ proc trigger {} {test_ns_cache_cmd}
+}
test namespace-old-6.5 {define test commands} {
proc test_ns_cache_cmd {} {
return "global version"
}
- namespace eval test_ns_cache1 {
- proc trigger {} {
- test_ns_cache_cmd
- }
- }
test_ns_cache1::trigger
} {global version}
test namespace-old-6.6 {one-level check for command shadowing} {
@@ -376,24 +408,36 @@ test namespace-old-6.6 {one-level check for command shadowing} {
}
test_ns_cache1::trigger
} {cache1 version}
-test namespace-old-6.7 {renaming commands changes command epoch} {
- namespace eval test_ns_cache1 {
- rename test_ns_cache_cmd test_ns_new
+proc test_ns_cache_cmd {} {
+ return "global version"
+}
+test namespace-old-6.7 {renaming commands changes command epoch} -setup {
+ proc test_ns_cache1::test_ns_cache_cmd {} {
+ return "cache1 version"
}
- test_ns_cache1::trigger
-} {global version}
-test namespace-old-6.8 {renaming back handles shadowing} {
- namespace eval test_ns_cache1 {
- rename test_ns_new test_ns_cache_cmd
+} -body {
+ list [test_ns_cache1::trigger] \
+ [namespace eval test_ns_cache1 {rename test_ns_cache_cmd test_ns_new}]\
+ [test_ns_cache1::trigger]
+} -result {{cache1 version} {} {global version}}
+test namespace-old-6.8 {renaming back handles shadowing} -setup {
+ proc test_ns_cache1::test_ns_new {} {
+ return "cache1 version"
}
- test_ns_cache1::trigger
-} {cache1 version}
-test namespace-old-6.9 {deleting commands changes command epoch} {
- namespace eval test_ns_cache1 {
- rename test_ns_cache_cmd ""
+} -body {
+ list [test_ns_cache1::trigger] \
+ [namespace eval test_ns_cache1 {rename test_ns_new test_ns_cache_cmd}]\
+ [test_ns_cache1::trigger]
+} -result {{global version} {} {cache1 version}}
+test namespace-old-6.9 {deleting commands changes command epoch} -setup {
+ proc test_ns_cache1::test_ns_cache_cmd {} {
+ return "cache1 version"
}
- test_ns_cache1::trigger
-} {global version}
+} -body {
+ list [test_ns_cache1::trigger] \
+ [namespace eval test_ns_cache1 {rename test_ns_cache_cmd ""}] \
+ [test_ns_cache1::trigger]
+} -result {{cache1 version} {} {global version}}
test namespace-old-6.10 {define test namespaces} {
namespace eval test_ns_cache2 {
proc test_ns_cache_cmd {} {
@@ -412,6 +456,12 @@ test namespace-old-6.10 {define test namespaces} {
}
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{global cache2 version} {global version}}
+namespace eval test_ns_cache1 {
+ proc trigger {} { test_ns_cache2::test_ns_cache_cmd }
+ namespace eval test_ns_cache2 {
+ proc trigger {} { test_ns_cache_cmd }
+ }
+}
test namespace-old-6.11 {commands affect all parent namespaces} {
proc test_ns_cache1::test_ns_cache2::test_ns_cache_cmd {} {
return "cache2 version"
@@ -423,18 +473,22 @@ test namespace-old-6.12 {define test variables} {
set trigger {set test_ns_cache_var}
namespace eval test_ns_cache1 $trigger
} {global version}
+ set trigger {set test_ns_cache_var}
test namespace-old-6.13 {one-level check for variable shadowing} {
namespace eval test_ns_cache1 {
variable test_ns_cache_var "cache1 version"
}
namespace eval test_ns_cache1 $trigger
} {cache1 version}
+variable ::test_ns_cache_var "global version"
test namespace-old-6.14 {deleting variables changes variable epoch} {
namespace eval test_ns_cache1 {
- unset test_ns_cache_var
+ variable test_ns_cache_var "cache1 version"
}
- namespace eval test_ns_cache1 $trigger
-} {global version}
+ list [namespace eval test_ns_cache1 $trigger] \
+ [namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
+ [namespace eval test_ns_cache1 $trigger]
+} {{cache1 version} {} {global version}}
test namespace-old-6.15 {define test namespaces} {
namespace eval test_ns_cache2 {
variable test_ns_cache_var "global cache2 version"
@@ -443,6 +497,7 @@ test namespace-old-6.15 {define test namespaces} {
list [namespace eval test_ns_cache1 $trigger2] \
[namespace eval test_ns_cache1::test_ns_cache2 $trigger]
} {{global cache2 version} {global version}}
+set trigger2 {set test_ns_cache2::test_ns_cache_var}
test namespace-old-6.16 {public variables affect all parent namespaces} {
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
list [namespace eval test_ns_cache1 $trigger2] \
@@ -467,6 +522,7 @@ test namespace-old-6.19 {querying: namespace which -command} {
test namespace-old-6.20 {command "namespace which" may not find commands} {
namespace eval test_ns_cache1 {namespace which -command xyzzy}
} {}
+variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
test namespace-old-6.21 {querying: namespace which -variable} {
namespace eval test_ns_cache1::test_ns_cache2 {
namespace which -variable test_ns_cache_var
@@ -493,6 +549,18 @@ test namespace-old-7.1 {define test namespace} {
}
}
} {}
+namespace eval test_ns_uplevel {
+ variable x 0
+ variable y 1
+ proc show_vars {num} {
+ return [uplevel $num {info vars}]
+ }
+ proc test_uplevel {num} {
+ set a 0
+ set b 1
+ namespace eval ::test_ns_uplevel " return \[show_vars $num\] "
+ }
+}
test namespace-old-7.2 {uplevel can access namespace call frame} {
list [expr {"x" in [test_ns_uplevel::test_uplevel 1]}] \
[expr {"y" in [test_ns_uplevel::test_uplevel 1]}]
@@ -526,6 +594,17 @@ test namespace-old-7.8 {namespaces are included in the call stack} {
}
}
} {}
+namespace eval test_ns_upvar {
+ variable scope "test_ns_upvar"
+ proc show_val {var num} {
+ upvar $num $var x
+ return $x
+ }
+ proc test_upvar {num} {
+ set scope "test_ns_upvar::test_upvar"
+ namespace eval ::test_ns_upvar " return \[show_val scope $num\] "
+ }
+}
test namespace-old-7.9 {upvar can access namespace call frame} {
test_ns_upvar::test_upvar 1
} {test_ns_upvar}
@@ -581,6 +660,15 @@ test namespace-old-9.3 {define test namespaces for import} {
}
lsort [info commands test_ns_export::*]
} {::test_ns_export::cmd1 ::test_ns_export::cmd2 ::test_ns_export::cmd3 ::test_ns_export::cmd4 ::test_ns_export::cmd5 ::test_ns_export::cmd6}
+namespace eval test_ns_export {
+ namespace export cmd1 cmd2 cmd3
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ proc cmd3 {args} {return "cmd3: $args"}
+ proc cmd4 {args} {return "cmd4: $args"}
+ proc cmd5 {args} {return "cmd5: $args"}
+ proc cmd6 {args} {return "cmd6: $args"}
+}
test namespace-old-9.4 {check export status} {
set x ""
namespace eval test_ns_import {
@@ -592,6 +680,10 @@ test namespace-old-9.4 {check export status} {
}
set x
} {::test_ns_import::cmd1 ::test_ns_import::cmd2 ::test_ns_import::cmd3}
+namespace eval test_ns_import {
+ namespace export cmd1 cmd2
+ namespace import ::test_ns_export::*
+}
test namespace-old-9.5 {empty import list in "namespace import" command} {
namespace eval test_ns_import_empty {
namespace import ::test_ns_export::*
@@ -615,6 +707,7 @@ test namespace-old-9.8 {only exported commands are imported} {
namespace import test_ns_import::cmd*
set x [lsort [info commands cmd*]]
} {cmd1 cmd2}
+namespace import test_ns_import::cmd*
test namespace-old-9.9 {imported commands work just the same as original} {
list [cmd1 test 1 2 3] [test_ns_import::cmd1 test 4 5 6]
} {{cmd1: test 1 2 3} {cmd1: test 4 5 6}}
@@ -629,10 +722,19 @@ test namespace-old-9.10 {commands can be imported from many namespaces} {
namespace import test_ns_import2::*
lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd1 cmd2 ncmd ncmd1 ncmd2}
+namespace eval test_ns_import2 {
+ namespace export ncmd ncmd1 ncmd2
+ proc ncmd {args} {return "ncmd: $args"}
+ proc ncmd1 {args} {return "ncmd1: $args"}
+ proc ncmd2 {args} {return "ncmd2: $args"}
+ proc ncmd3 {args} {return "ncmd3: $args"}
+}
+namespace import test_ns_import2::*
test namespace-old-9.11 {imported commands can be removed by deleting them} {
rename cmd1 ""
lsort [concat [info commands cmd*] [info commands ncmd*]]
} {cmd2 ncmd ncmd1 ncmd2}
+catch { rename cmd1 "" }
test namespace-old-9.12 {command "namespace forget" checks for valid namespaces} {
list [catch {namespace forget xyzzy::*} msg] $msg
} {1 {unknown namespace in namespace forget pattern "xyzzy::*"}}
@@ -653,6 +755,7 @@ test namespace-old-9.15 {existing commands can't be overwritten} {
[cmd1 3 5]
} {1 {can't import command "cmd1": already exists} 8}
test namespace-old-9.16 {use "-force" option to override existing commands} {
+ proc cmd1 {x y} { return [expr $x+$y] }
list [cmd1 3 5] \
[namespace import -force test_ns_import::cmd?] \
[cmd1 3 5]
@@ -711,10 +814,18 @@ test namespace-old-10.6 {with many args, each "scope" adds new args} {
set sval [namespace eval test_ns_inscope {namespace code {one two}}]
namespace code "$sval three"
} {::namespace inscope ::test_ns_inscope {one two} three}
+namespace eval test_ns_inscope {
+ proc show {args} {
+ return "show: $args"
+ }
+}
test namespace-old-10.7 {scoped commands work with eval} {
set cref [namespace eval test_ns_inscope {namespace code show}]
list [eval $cref "a" "b c" "d e f"]
} {{show: a b c d e f}}
+namespace eval test_ns_inscope {
+ variable x "x-value"
+}
test namespace-old-10.8 {scoped commands execute in namespace context} {
set cref [namespace eval test_ns_inscope {
namespace code {set x "some new value"}
diff --git a/tests/namespace.test b/tests/namespace.test
index 5c5783b..ff3dd4b 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -82,12 +82,14 @@ test namespace-4.2 {Tcl_PushCallFrame with isProcCallFrame=0} {
test namespace-5.1 {Tcl_PopCallFrame, no vars} {
namespace eval test_ns_1::blodge {} ;# pushes then pops frame
} {}
-test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} {
+test namespace-5.2 {Tcl_PopCallFrame, local vars must be deleted} -setup {
+ namespace eval test_ns_1 {}
+} -body {
proc test_ns_1::r {} {
set a 123
}
test_ns_1::r ;# pushes then pop's r's frame
-} {123}
+} -result {123}
test namespace-6.1 {Tcl_CreateNamespace} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -193,8 +195,6 @@ test namespace-7.7 {Bug 1655305} -setup {
} -cleanup {
interp delete slave
} -result {}
-
-
test namespace-8.1 {TclTeardownNamespace, delete global namespace} {
catch {interp delete test_interp}
interp create test_interp
@@ -303,15 +303,24 @@ test namespace-9.4 {Tcl_Import, simple import} {
}
test_ns_import::p
} {cmd1: 123}
-test namespace-9.5 {Tcl_Import, RFE 1230597} {
+test namespace-9.5 {Tcl_Import, RFE 1230597} -setup {
+ namespace eval test_ns_import {}
+ namespace eval test_ns_export {}
+} -body {
list [catch {namespace eval test_ns_import {namespace import ::test_ns_export::*}} msg] $msg
-} {0 {}}
-test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} {
+} -result {0 {}}
+test namespace-9.6 {Tcl_Import, cmd redefinition ok if allowOverwrite!=0} -setup {
+ namespace eval test_ns_import {}
+ namespace eval ::test_ns_export {
+ proc cmd1 {args} {return "cmd1: $args"}
+ namespace export cmd1
+ }
+} -body {
namespace eval test_ns_import {
namespace import -force ::test_ns_export::*
cmd1 555
}
-} {cmd1: 555}
+} -result {cmd1: 555}
test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
namespace eval test_ns_export {
@@ -329,7 +338,6 @@ test namespace-9.7 {Tcl_Import, links are preserved if cmd is redefined} {
[test_ns_import::cmd1 g h i] \
[test_ns_export::cmd1 j k l]
} {{cmd1: a b c} {cmd1: d e f} {} ::test_ns_export::cmd1 ::test_ns_export::cmd1 {new1: g h i} {new1: j k l}}
-
test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
namespace eval one {
namespace export cmd
@@ -354,7 +362,6 @@ test namespace-9.8 {Tcl_Import: Bug 1017299} -setup {
} -cleanup {
namespace delete one two three
} -match glob -result *::one::cmd
-
test namespace-9.9 {Tcl_Import: Bug 1017299} -setup {
namespace eval one {
namespace export cmd
@@ -388,7 +395,13 @@ test namespace-10.2 {Tcl_ForgetImport, ignores patterns that don't match} {
namespace forget ::test_ns_export::wombat
}
} {}
-test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
+test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} -setup {
+ namespace eval test_ns_export {
+ namespace export cmd1
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ }
+} -body {
namespace eval test_ns_import {
namespace import ::test_ns_export::*
proc p {} {return [cmd1 123]}
@@ -398,8 +411,7 @@ test namespace-10.3 {Tcl_ForgetImport, deletes matching imported cmds} {
lappend l [info commands ::test_ns_import::*]
lappend l [catch {cmd1 777} msg] $msg
}
-} [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
-
+} -result [list [lsort {::test_ns_import::p ::test_ns_import::cmd1}] ::test_ns_import::p 1 {invalid command name "cmd1"}]
test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
namespace eval origin {
namespace export cmd
@@ -417,7 +429,6 @@ test namespace-10.4 {Tcl_ForgetImport: Bug 560297} -setup {
} -cleanup {
namespace delete origin unrelated my
}
-
test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
namespace eval origin {
namespace export cmd
@@ -433,7 +444,6 @@ test namespace-10.5 {Tcl_ForgetImport: Bug 560297} -setup {
} -cleanup {
namespace delete origin my
} -returnCodes error -match glob -result *
-
test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
namespace eval origin {
namespace export cmd
@@ -450,7 +460,6 @@ test namespace-10.6 {Tcl_ForgetImport: Bug 560297} -setup {
} -cleanup {
namespace delete origin my your
} -returnCodes error -match glob -result *
-
test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
namespace eval origin {
namespace export cmd
@@ -471,7 +480,6 @@ test namespace-10.7 {Tcl_ForgetImport: Bug 560297} -setup {
} -cleanup {
namespace delete origin link link2 my
} -returnCodes error -match glob -result *
-
test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
namespace eval origin {
namespace export cmd
@@ -492,7 +500,6 @@ test namespace-10.8 {Tcl_ForgetImport: Bug 560297} -setup {
} -cleanup {
namespace delete origin link link2 my
}
-
test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
namespace eval origin {
namespace export cmd
@@ -514,29 +521,47 @@ test namespace-10.9 {Tcl_ForgetImport: Bug 560297} -setup {
namespace delete origin link link2 my
} -returnCodes error -match glob -result *
-test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} {
+test namespace-11.1 {TclGetOriginalCommand, check if not imported cmd} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_export {
namespace export cmd1
proc cmd1 {args} {return "cmd1: $args"}
}
list [namespace origin set] [namespace origin test_ns_export::cmd1]
-} {::set ::test_ns_export::cmd1}
-test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} {
+} -result {::set ::test_ns_export::cmd1}
+test namespace-11.2 {TclGetOriginalCommand, directly imported cmd} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_export {
+ namespace export cmd1
+ proc cmd1 {args} {return "cmd1: $args"}
+ }
+} -body {
namespace eval test_ns_import1 {
namespace import ::test_ns_export::*
namespace export *
proc p {} {namespace origin cmd1}
}
list [test_ns_import1::p] [namespace origin test_ns_import1::cmd1]
-} {::test_ns_export::cmd1 ::test_ns_export::cmd1}
-test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} {
+} -result {::test_ns_export::cmd1 ::test_ns_export::cmd1}
+test namespace-11.3 {TclGetOriginalCommand, indirectly imported cmd} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_export {
+ namespace export cmd1
+ proc cmd1 {args} {return "cmd1: $args"}
+ }
+ namespace eval test_ns_import1 {
+ namespace import ::test_ns_export::*
+ namespace export *
+ proc p {} {namespace origin cmd1}
+ }
+} -body {
namespace eval test_ns_import2 {
namespace import ::test_ns_import1::*
proc q {} {return [cmd1 123]}
}
list [test_ns_import2::q] [namespace origin test_ns_import2::cmd1]
-} {{cmd1: 123} ::test_ns_export::cmd1}
+} -result {{cmd1: 123} ::test_ns_export::cmd1}
test namespace-12.1 {InvokeImportedCmd} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -550,14 +575,23 @@ test namespace-12.1 {InvokeImportedCmd} {
list [test_ns_import::cmd1]
} {::test_ns_export}
-test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
+test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_export {
+ namespace export cmd1
+ proc cmd1 {args} {namespace current}
+ }
+ namespace eval test_ns_import {
+ namespace import ::test_ns_export::*
+ }
+} -body {
namespace eval test_ns_import {
set l {}
lappend l [info commands ::test_ns_import::*]
namespace forget ::test_ns_export::cmd1
lappend l [info commands ::test_ns_import::*]
}
-} {::test_ns_import::cmd1 {}}
+} -result {::test_ns_import::cmd1 {}}
test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
# Will panic if still buggy
namespace eval src {namespace export foo; proc foo {} {}}
@@ -568,7 +602,7 @@ test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
namespace delete src
} {}
-test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
+test namespace-14.1 {TclGetNamespaceForQualName, absolute names} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
variable v 10
namespace eval test_ns_1::test_ns_2 {
@@ -577,22 +611,41 @@ test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
namespace eval test_ns_2 {
variable v 30
}
+} -body {
namespace eval test_ns_1 {
list $::v $::test_ns_2::v $::test_ns_1::test_ns_2::v \
[lsort [namespace children :: test_ns_*]]
}
-} [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
-test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} {
+} -result [list 10 30 20 [lsort {::test_ns_1 ::test_ns_2}]]
+test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ variable v 10
+ namespace eval test_ns_1::test_ns_2 {
+ variable v 20
+ }
+ namespace eval test_ns_2 {
+ variable v 30
+ }
+} -body {
namespace eval test_ns_1 {
list [catch {set ::test_ns_777::v} msg] $msg \
[catch {namespace children test_ns_777} msg] $msg
}
-} {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
-test namespace-14.3 {TclGetNamespaceForQualName, relative names} {
+} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
+test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ variable v 10
+ namespace eval test_ns_1::test_ns_2 {
+ variable v 20
+ }
+ namespace eval test_ns_2 {
+ variable v 30
+ }
+} -body {
namespace eval test_ns_1 {
list $v $test_ns_2::v
}
-} {10 20}
+} -result {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
namespace eval test_ns_1::test_ns_2 {
namespace eval foo {}
@@ -619,57 +672,72 @@ test namespace-14.6 {TclGetNamespaceForQualName, relative ns names looked up onl
[catch {namespace children test_ns_1} msg] $msg
}
} {::test_ns_1::test_ns_2::foo 1 {namespace "test_ns_1" not found in "::test_ns_1"}}
-test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} {
+test namespace-14.7 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
+ namespace eval test_ns_1::test_ns_2::foo {}
+} -body {
namespace children test_ns_1:::
-} {::test_ns_1::test_ns_2}
-test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-14.8 {TclGetNamespaceForQualName, ignore extra :s if ns} -setup {
+ namespace eval test_ns_1::test_ns_2::foo {}
+} -body {
namespace children :::test_ns_1:::::test_ns_2:::
-} {::test_ns_1::test_ns_2::foo}
+} -result {::test_ns_1::test_ns_2::foo}
test namespace-14.9 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
set l {}
lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
namespace eval test_ns_1::test_ns_2 {variable {} 2525}
lappend l [set test_ns_1::test_ns_2::]
} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 2525}
-test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
- catch {unset test_ns_1::test_ns_2::}
+test namespace-14.10 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
+ namespace eval test_ns_1::test_ns_2::foo {}
+ unset -nocomplain test_ns_1::test_ns_2::
set l {}
+} -body {
lappend l [catch {set test_ns_1::test_ns_2::} msg] $msg
set test_ns_1::test_ns_2:: 314159
lappend l [set test_ns_1::test_ns_2::]
-} {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
-test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} {
+} -result {1 {can't read "test_ns_1::test_ns_2::": no such variable} 314159}
+test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for commands} -setup {
+ namespace eval test_ns_1::test_ns_2::foo {}
catch {rename test_ns_1::test_ns_2:: {}}
set l {}
+} -body {
lappend l [catch {test_ns_1::test_ns_2:: hello} msg] $msg
proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
lappend l [test_ns_1::test_ns_2:: hello]
-} {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
-test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} {
+} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
+test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
variable {}
set test_ns_1::(x) y
}
set test_ns_1::(x)
-} y
-test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} {
+} -result y
+test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
- list [catch {namespace eval test_ns_1 {proc {} {} {}; namespace eval {} {}; {}}} msg] $msg
-} {1 {can't create namespace "": only global namespace can have empty name}}
+} -returnCodes error -body {
+ namespace eval test_ns_1 {
+ proc {} {} {}
+ namespace eval {} {}
+ {}
+ }
+} -result {can't create namespace "": only global namespace can have empty name}
-test namespace-15.1 {Tcl_FindNamespace, absolute name found} {
+test namespace-15.1 {Tcl_FindNamespace, absolute name found} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_delete {
namespace eval test_ns_delete2 {}
proc cmd {args} {namespace current}
}
list [namespace delete ::test_ns_delete::test_ns_delete2] \
[namespace children ::test_ns_delete]
-} {{} {}}
-test namespace-15.2 {Tcl_FindNamespace, absolute name not found} {
- list [catch {namespace delete ::test_ns_delete::test_ns_delete2} msg] $msg
-} {1 {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}}
+} -result {{} {}}
+test namespace-15.2 {Tcl_FindNamespace, absolute name not found} -body {
+ namespace delete ::test_ns_delete::test_ns_delete2
+} -returnCodes error -result {unknown namespace "::test_ns_delete::test_ns_delete2" in namespace delete command}
test namespace-15.3 {Tcl_FindNamespace, relative name found} {
namespace eval test_ns_delete {
namespace eval test_ns_delete2 {}
@@ -685,17 +753,24 @@ test namespace-15.4 {Tcl_FindNamespace, relative name not found} {
}
} {1 {unknown namespace "test_ns_delete2" in namespace delete command}}
-test namespace-16.1 {Tcl_FindCommand, absolute name found} {
+test namespace-16.1 {Tcl_FindCommand, absolute name found} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
proc cmd {args} {return "[namespace current]::cmd: $args"}
variable v "::test_ns_1::cmd"
eval $v one
}
-} {::test_ns_1::cmd: one}
-test namespace-16.2 {Tcl_FindCommand, absolute name found} {
+} -result {::test_ns_1::cmd: one}
+test namespace-16.2 {Tcl_FindCommand, absolute name found} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1 {
+ proc cmd {args} {return "[namespace current]::cmd: $args"}
+ variable v "::test_ns_1::cmd"
+ }
+} -body {
eval $test_ns_1::v two
-} {::test_ns_1::cmd: two}
+} -result {::test_ns_1::cmd: two}
test namespace-16.3 {Tcl_FindCommand, absolute name not found} {
namespace eval test_ns_1 {
variable v2 "::test_ns_1::ladidah"
@@ -724,11 +799,16 @@ test namespace-16.7 {Tcl_FindCommand, relative name and TCL_GLOBAL_ONLY} {
catch {rename unknown {}}
catch {rename unknown.old unknown}
-test namespace-16.8 {Tcl_FindCommand, relative name found} {
+test namespace-16.8 {Tcl_FindCommand, relative name found} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1 {
+ proc cmd {args} {return "[namespace current]::cmd: $args"}
+ }
+} -body {
namespace eval test_ns_1 {
cmd a b c
}
-} {::test_ns_1::cmd: a b c}
+} -result {::test_ns_1::cmd: a b c}
test namespace-16.9 {Tcl_FindCommand, relative name found} -body {
proc cmd2 {args} {return "[namespace current]::cmd2: $args"}
namespace eval test_ns_1 {
@@ -750,20 +830,22 @@ test namespace-16.10 {Tcl_FindCommand, relative name found, only look in current
} -cleanup {
catch {rename cmd2 {}}
} -result {::::cmd2: a b c}
-test namespace-16.11 {Tcl_FindCommand, relative name not found} {
+test namespace-16.11 {Tcl_FindCommand, relative name not found} -body {
namespace eval test_ns_1 {
- list [catch {cmd3 a b c} msg] $msg
+ cmd3 a b c
}
-} {1 {invalid command name "cmd3"}}
+} -returnCodes error -result {invalid command name "cmd3"}
-catch {unset x}
-test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} {
+unset -nocomplain x
+test namespace-17.1 {Tcl_FindNamespaceVar, absolute name found} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
set x 314159
namespace eval test_ns_1 {
set ::x
}
-} {314159}
+} -result {314159}
+variable ::x 314159
test namespace-17.2 {Tcl_FindNamespaceVar, absolute name found} {
namespace eval test_ns_1 {
variable x 777
@@ -778,46 +860,54 @@ test namespace-17.3 {Tcl_FindNamespaceVar, absolute name found} {
set ::test_ns_1::test_ns_2::x
}
} {1111}
-test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} {
+test namespace-17.4 {Tcl_FindNamespaceVar, absolute name not found} -body {
namespace eval test_ns_1 {
namespace eval test_ns_2 {
variable x 1111
}
- list [catch {set ::test_ns_1::test_ns_2::y} msg] $msg
+ set ::test_ns_1::test_ns_2::y
}
-} {1 {can't read "::test_ns_1::test_ns_2::y": no such variable}}
-test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} {
+} -returnCodes error -result {can't read "::test_ns_1::test_ns_2::y": no such variable}
+test namespace-17.5 {Tcl_FindNamespaceVar, absolute name and TCL_GLOBAL_ONLY} -setup {
+ namespace eval ::test_ns_1::test_ns_2 {}
+} -body {
namespace eval test_ns_1 {
namespace eval test_ns_3 {
variable ::test_ns_1::test_ns_2::x 2222
}
}
set ::test_ns_1::test_ns_2::x
-} {2222}
-test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} {
+} -result {2222}
+test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
+ namespace eval test_ns_1 {
+ variable x 777
+ }
+} -body {
namespace eval test_ns_1 {
set x
}
-} {777}
+} -result {777}
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
namespace eval test_ns_1 {
+ variable x 777
unset x
set x ;# must be global x now
}
} {314159}
-test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} {
+test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
namespace eval test_ns_1 {
- list [catch {set wuzzat} msg] $msg
+ set wuzzat
}
-} {1 {can't read "wuzzat": no such variable}}
+} -returnCodes error -result {can't read "wuzzat": no such variable}
test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
namespace eval test_ns_1 {
variable a hello
}
set test_ns_1::a
} {hello}
-test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
+test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
namespace eval test_ns_1 {}
+} -body {
proc test_ns {} {
set ::test_ns_1::a 0
}
@@ -828,14 +918,15 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} {
namespace eval test_ns_1 set a 1
namespace delete test_ns_1
return $a
-} 1
+} -result 1
catch {unset a}
catch {unset x}
catch {unset l}
catch {rename foo {}}
-test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} {
+test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadowing} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
proc foo {} {return "global foo"}
namespace eval test_ns_1 {
proc trigger {} {
@@ -849,7 +940,7 @@ test namespace-18.1 {TclResetShadowedCmdRefs, one-level check for command shadow
proc foo {} {return "foo in test_ns_1"}
}
lappend l [test_ns_1::trigger]
-} {{global foo} {foo in test_ns_1}}
+} -result {{global foo} {foo in test_ns_1}}
test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shadowing} {
namespace eval test_ns_2 {
proc foo {} {return "foo in ::test_ns_2"}
@@ -873,22 +964,31 @@ test namespace-18.2 {TclResetShadowedCmdRefs, multilevel check for command shado
catch {unset l}
catch {rename foo {}}
-test namespace-19.1 {GetNamespaceFromObj, global name found} {
+test namespace-19.1 {GetNamespaceFromObj, global name found} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1::test_ns_2 {}
namespace children ::test_ns_1
-} {::test_ns_1::test_ns_2}
-test namespace-19.2 {GetNamespaceFromObj, relative name found} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-19.2 {GetNamespaceFromObj, relative name found} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1::test_ns_2 {}
+} -body {
namespace eval test_ns_1 {
namespace children test_ns_2
}
-} {}
-test namespace-19.3 {GetNamespaceFromObj, name not found} -body {
+} -result {}
+test namespace-19.3 {GetNamespaceFromObj, name not found} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
namespace children test_ns_99
}
} -returnCodes error -result {namespace "test_ns_99" not found in "::test_ns_1"}
-test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
+test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1::test_ns_2 {}
+} -body {
namespace eval test_ns_1 {
proc foo {} {
return [namespace children test_ns_2]
@@ -900,7 +1000,7 @@ test namespace-19.4 {GetNamespaceFromObj, invalidation of cached ns refs} {
namespace delete test_ns_1::test_ns_2
namespace eval test_ns_1::test_ns_2::test_ns_3 {}
lappend l [test_ns_1::foo]
-} {{} ::test_ns_1::test_ns_2::test_ns_3}
+} -result {{} ::test_ns_1::test_ns_2::test_ns_3}
test namespace-20.1 {Tcl_NamespaceObjCmd, bad subcommand} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -913,24 +1013,34 @@ test namespace-20.3 {Tcl_NamespaceObjCmd, abbreviations are okay} {
namespace ch :: test_ns_*
} {}
-test namespace-21.1 {NamespaceChildrenCmd, no args} {
+test namespace-21.1 {NamespaceChildrenCmd, no args} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1::test_ns_2 {}
- expr {[string first ::test_ns_1 [namespace children]] != -1}
-} {1}
-test namespace-21.2 {NamespaceChildrenCmd, no args} {
+ expr {"::test_ns_1" in [namespace children]}
+} -result {1}
+test namespace-21.2 {NamespaceChildrenCmd, no args} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1::test_ns_2 {}
+} -body {
namespace eval test_ns_1 {
namespace children
}
-} {::test_ns_1::test_ns_2}
-test namespace-21.3 {NamespaceChildrenCmd, ns name given} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-21.3 {NamespaceChildrenCmd, ns name given} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1::test_ns_2 {}
+} -body {
namespace children ::test_ns_1
-} {::test_ns_1::test_ns_2}
-test namespace-21.4 {NamespaceChildrenCmd, ns name given} {
+} -result {::test_ns_1::test_ns_2}
+test namespace-21.4 {NamespaceChildrenCmd, ns name given} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1::test_ns_2 {}
+} -body {
namespace eval test_ns_1 {
namespace children test_ns_2
}
-} {}
+} -result {}
test namespace-21.5 {NamespaceChildrenCmd, too many args} {
namespace eval test_ns_1 {
list [catch {namespace children test_ns_2 xxx yyy} msg] $msg
@@ -940,10 +1050,13 @@ test namespace-21.6 {NamespaceChildrenCmd, glob-style pattern given} {
namespace eval test_ns_1::test_ns_foo {}
namespace children test_ns_1 *f*
} {::test_ns_1::test_ns_foo}
-test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} {
+test namespace-21.7 {NamespaceChildrenCmd, glob-style pattern given} -setup {
+ catch {namespace delete {*}[namespace children :: test_ns_*]}
+ namespace eval test_ns_1::test_ns_2 {}
+} -body {
namespace eval test_ns_1::test_ns_foo {}
lsort [namespace children test_ns_1 test*]
-} [lsort {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}]
+} -result {::test_ns_1::test_ns_2 ::test_ns_1::test_ns_foo}
test namespace-21.8 {NamespaceChildrenCmd, trivial pattern starting with ::} {
namespace eval test_ns_1 {}
namespace children [namespace current] [fq test_ns_1]
@@ -1038,15 +1151,25 @@ test namespace-25.3 {NamespaceEvalCmd, new namespace} {
}
test_ns_1::p
} {314159}
-test namespace-25.4 {NamespaceEvalCmd, existing namespace} {
+test namespace-25.4 {NamespaceEvalCmd, existing namespace} -setup {
+ namespace eval test_ns_1 {
+ variable v 314159
+ proc p {} {
+ variable v
+ return $v
+ }
+ }
+} -body {
namespace eval test_ns_1 {
proc q {} {return [expr {[p]+1}]}
}
test_ns_1::q
-} {314160}
-test namespace-25.5 {NamespaceEvalCmd, multiple args} {
+} -result {314160}
+test namespace-25.5 {NamespaceEvalCmd, multiple args} -setup {
+ namespace eval test_ns_1 {variable v 314159}
+} -body {
namespace eval test_ns_1 "set" "v"
-} {314159}
+} -result {314159}
test namespace-25.6 {NamespaceEvalCmd, error in eval'd script} {
list [catch {namespace eval test_ns_1 {xxxx}} msg] $msg $::errorInfo
} {1 {invalid command name "xxxx"} {invalid command name "xxxx"
@@ -1097,21 +1220,50 @@ test namespace-26.4 {NamespaceExportCmd, one pattern} {
}
list [info commands test_ns_2::*] [test_ns_2::cmd1 hello]
} {::test_ns_2::cmd1 {cmd1: hello}}
-test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} {
+test namespace-26.5 {NamespaceExportCmd, sequence of patterns, patterns accumulate} -setup {
+ catch {namespace delete {*}[namespace children test_ns_*]}
namespace eval test_ns_1 {
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ proc cmd3 {args} {return "cmd3: $args"}
+ proc cmd4 {args} {return "cmd4: $args"}
namespace export cmd1 cmd3
}
+} -body {
namespace eval test_ns_2 {
namespace import -force ::test_ns_1::*
}
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd3 hello]
-} [list [lsort {::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd3: hello}]
-test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} {
+} -result {{::test_ns_2::cmd1 ::test_ns_2::cmd3} {cmd3: hello}}
+test namespace-26.6 {NamespaceExportCmd, no patterns means return uniq'ed export list} -setup {
+ catch {namespace delete {*}[namespace children test_ns_*]}
+ namespace eval test_ns_1 {
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ proc cmd3 {args} {return "cmd3: $args"}
+ proc cmd4 {args} {return "cmd4: $args"}
+ namespace export cmd1 cmd3
+ }
+} -body {
namespace eval test_ns_1 {
namespace export
}
-} {cmd1 cmd3}
-test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
+} -result {cmd1 cmd3}
+test namespace-26.7 {NamespaceExportCmd, -clear resets export list} -setup {
+ catch {namespace delete {*}[namespace children test_ns_*]}
+ namespace eval test_ns_1 {
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ proc cmd3 {args} {return "cmd3: $args"}
+ proc cmd4 {args} {return "cmd4: $args"}
+ }
+} -body {
+ namespace eval test_ns_1 {
+ namespace export cmd1 cmd3
+ }
+ namespace eval test_ns_2 {
+ namespace import ::test_ns_1::*
+ }
namespace eval test_ns_1 {
namespace export -clear cmd4
}
@@ -1119,7 +1271,7 @@ test namespace-26.7 {NamespaceExportCmd, -clear resets export list} {
namespace import ::test_ns_1::*
}
list [lsort [info commands test_ns_2::*]] [test_ns_2::cmd4 hello]
-} [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
+} -result [list [lsort {::test_ns_2::cmd4 ::test_ns_2::cmd1 ::test_ns_2::cmd3}] {cmd4: hello}]
test namespace-26.8 {NamespaceExportCmd, -clear resets export list} {
catch {namespace delete foo}
namespace eval foo {
@@ -1202,14 +1354,23 @@ test namespace-29.4 {NamespaceInscopeCmd, simple case} {
}
namespace inscope test_ns_1 cmd
} {::test_ns_1::cmd: v=747, args=}
-test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} {
+test namespace-29.5 {NamespaceInscopeCmd, has lappend semantics} -setup {
+ namespace eval test_ns_1 {
+ variable v 747
+ proc cmd {args} {
+ variable v
+ return "[namespace current]::cmd: v=$v, args=$args"
+ }
+ }
+} -body {
list [namespace inscope test_ns_1 cmd x y z] \
[namespace eval test_ns_1 [concat cmd [list x y z]]]
-} {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
-test namespace-29.6 {NamespaceInscopeCmd, 1400572} {
+} -result {{::test_ns_1::cmd: v=747, args=x y z} {::test_ns_1::cmd: v=747, args=x y z}}
+test namespace-29.6 {NamespaceInscopeCmd, 1400572} -setup {
+ namespace eval test_ns_1 {}
+} -body {
namespace inscope test_ns_1 {info level 0}
-} {namespace inscope test_ns_1 {info level 0}}
-
+} -result {namespace inscope test_ns_1 {info level 0}}
test namespace-30.1 {NamespaceOriginCmd, bad args} {
catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -1330,7 +1491,8 @@ test namespace-34.3 {NamespaceWhichCmd, single arg is always command name} {
test namespace-34.4 {NamespaceWhichCmd, bad args} {
list [catch {namespace which a b} msg] $msg
} {1 {wrong # args: should be "namespace which ?-command? ?-variable? name"}}
-test namespace-34.5 {NamespaceWhichCmd, command lookup} {
+test namespace-34.5 {NamespaceWhichCmd, command lookup} -setup {
+ catch {namespace delete {*}[namespace children test_ns_*]}
namespace eval test_ns_1 {
namespace export cmd*
variable v1 111
@@ -1343,6 +1505,7 @@ test namespace-34.5 {NamespaceWhichCmd, command lookup} {
variable v2 222
proc p {} {}
}
+} -body {
namespace eval test_ns_3 {
namespace import ::test_ns_2::*
variable v3 333
@@ -1352,26 +1515,59 @@ test namespace-34.5 {NamespaceWhichCmd, command lookup} {
[namespace which -command ::test_ns_2::cmd2] \
[catch {namespace which -command ::test_ns_2::noSuchCmd} msg] $msg
}
-} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
-test namespace-34.6 {NamespaceWhichCmd, -command is default} {
+} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2 0 {}}
+test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
+ catch {namespace delete {*}[namespace children test_ns_*]}
+ namespace eval test_ns_1 {
+ namespace export cmd*
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ }
+ namespace eval test_ns_2 {
+ namespace export *
+ namespace import ::test_ns_1::*
+ proc p {} {}
+ }
+ namespace eval test_ns_3 {
+ namespace import ::test_ns_2::*
+ }
+} -body {
namespace eval test_ns_3 {
list [namespace which foreach] \
[namespace which p] \
[namespace which cmd1] \
[namespace which ::test_ns_2::cmd2]
}
-} {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
-test namespace-34.7 {NamespaceWhichCmd, variable lookup} {
+} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
+test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
+ catch {namespace delete {*}[namespace children test_ns_*]}
+ namespace eval test_ns_1 {
+ namespace export cmd*
+ proc cmd1 {args} {return "cmd1: $args"}
+ proc cmd2 {args} {return "cmd2: $args"}
+ }
+ namespace eval test_ns_2 {
+ namespace export *
+ namespace import ::test_ns_1::*
+ variable v2 222
+ proc p {} {}
+ }
+ namespace eval test_ns_3 {
+ variable v3 333
+ namespace import ::test_ns_2::*
+ }
+} -body {
namespace eval test_ns_3 {
list [namespace which -variable env] \
[namespace which -variable v3] \
[namespace which -variable ::test_ns_2::v2] \
[catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
}
-} {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
+} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
-test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
+test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
+} -body {
namespace eval test_ns_1 {
proc p {} {
namespace delete [namespace current]
@@ -1379,7 +1575,7 @@ test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} {
}
}
test_ns_1::p
-} {::test_ns_1}
+} -result {::test_ns_1}
test namespace-35.2 {FreeNsNameInternalRep, resulting ref count == 0} {
namespace eval test_ns_1 {
proc q {} {
@@ -2107,6 +2303,68 @@ test namespace-50.4 {chained ensembles affect error messages} -body {
rename a {}
rename c {}
}
+test namespace-50.5 {[4402cfa58c]} -setup {
+ proc bar {ev} {}
+ proc bingo {xx} {}
+ namespace ensemble create -command launch -map {foo bar event bingo}
+ set result {}
+} -body {
+ catch {launch foo} m; lappend result $m
+ catch {launch ev} m; lappend result $m
+ catch {launch foo} m; lappend result $m
+} -cleanup {
+ rename launch {}
+ rename bingo {}
+ rename bar {}
+} -result {{wrong # args: should be "launch foo ev"} {wrong # args: should be "launch event xx"} {wrong # args: should be "launch foo ev"}}
+test namespace-50.6 {[4402cfa58c]} -setup {
+ proc target {x y} {}
+ namespace ensemble create -command e2 -map {s2 target}
+ namespace ensemble create -command e1 -map {s1 e2}
+ set result {}
+} -body {
+ set s s
+ catch {e1 s1 s2 a} m; lappend result $m
+ catch {e1 $s s2 a} m; lappend result $m
+ catch {e1 s1 $s a} m; lappend result $m
+ catch {e1 $s $s a} m; lappend result $m
+} -cleanup {
+ rename e1 {}
+ rename e2 {}
+ rename target {}
+} -result {{wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"} {wrong # args: should be "e1 s1 s2 x y"}}
+test namespace-50.7 {[4402cfa58c]} -setup {
+ proc target {x y} {}
+ namespace ensemble create -command e2 -map {s2 target}
+ namespace ensemble create -command e1 -map {s1 e2} -parameters foo
+ set result {}
+} -body {
+ set s s
+ catch {e1 s2 s1 a} m; lappend result $m
+ catch {e1 $s s1 a} m; lappend result $m
+ catch {e1 s2 $s a} m; lappend result $m
+ catch {e1 $s $s a} m; lappend result $m
+} -cleanup {
+ rename e1 {}
+ rename e2 {}
+ rename target {}
+} -result {{wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"} {wrong # args: should be "e1 s2 s1 x y"}}
+test namespace-50.8 {[f961d7d1dd]} -setup {
+ proc target {} {}
+ namespace ensemble create -command e -map {s target} -parameters {{a b}}
+} -body {
+ e
+} -returnCodes error -result {wrong # args: should be "e {a b} subcommand ?arg ...?"} -cleanup {
+ rename e {}
+ rename target {}
+}
+test namespace-50.9 {[cea0344a51]} -body {
+ namespace eval foo {
+ namespace eval bar {
+ namespace delete foo
+ }
+ }
+} -returnCodes error -result {unknown namespace "foo" in namespace delete command}
test namespace-51.1 {name resolution path control} -body {
namespace eval ::test_ns_1 {
@@ -2928,6 +3186,22 @@ test namespace-53.10 {ensembles: nested rewrite} -setup {
0 {1 v}\
1 {wrong # args: should be "ns v x z2 a2"}\
0 {2 v v2}}
+test namespace-53.11 {ensembles: nested rewrite} -setup {
+ namespace eval ns {
+ namespace export x
+ namespace eval x {
+ proc z2 {a1 a2} {list 2 $a1 $a2}
+ namespace export z*
+ namespace ensemble create -parameter p
+ }
+ namespace ensemble create
+ }
+} -body {
+ list [catch {ns x 1 z2} msg] $msg
+} -cleanup {
+ namespace delete ns
+ unset -nocomplain msg
+} -result {1 {wrong # args: should be "ns x 1 z2 a2"}}
test namespace-54.1 {leak on namespace deletion} -constraints {memory} \
-setup {
diff --git a/tests/notify.test b/tests/notify.test
index d2b9123..d2b9123 100644..100755
--- a/tests/notify.test
+++ b/tests/notify.test
diff --git a/tests/oo.test b/tests/oo.test
index 9491f78..2601c37 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -280,7 +280,7 @@ test oo-1.18.2 {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]
@@ -1989,7 +1989,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
}
@@ -2017,6 +2017,12 @@ test oo-15.10 {variable binding must not bleed through oo::copy} -setup {
test oo-16.1 {OO: object introspection} -body {
info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
+test oo-16.1.1 {OO: object introspection} -body {
+ catch {info object} m o
+ dict get $o -errorinfo
+} -result "wrong \# args: should be \"info object subcommand ?arg ...?\"
+ while executing
+\"info object\""
test oo-16.2 {OO: object introspection} -body {
info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
@@ -2156,6 +2162,12 @@ test oo-16.14 {OO: object introspection: TIP #436} -setup {
test oo-17.1 {OO: class introspection} -body {
info class
} -returnCodes 1 -result "wrong \# args: should be \"info class subcommand ?arg ...?\""
+test oo-17.1.1 {OO: class introspection} -body {
+ catch {info class} m o
+ dict get $o -errorinfo
+} -result "wrong \# args: should be \"info class subcommand ?arg ...?\"
+ while executing
+\"info class\""
test oo-17.2 {OO: class introspection} -body {
info class superclass NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
@@ -2619,7 +2631,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} {
@@ -2634,7 +2646,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
}
}
@@ -3412,6 +3424,38 @@ test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
} -cleanup {
foo destroy
} -result {v t}
+test oo-27.23 {variable resolver leakage: Bug 1493a43044} -setup {
+ oo::class create Super
+ oo::class create Master {
+ superclass Super
+ variable member1 member2
+ constructor {} {
+ set member1 master1
+ set member2 master2
+ }
+ method getChild {} {
+ Child new [self]
+ }
+ }
+ oo::class create Child {
+ superclass Super
+ variable member1 result
+ constructor {m} {
+ set [namespace current]::member1 child1
+ set ns [info object namespace $m]
+ namespace upvar $ns member1 l1 member2 l2
+ upvar 1 member1 l3 member2 l4
+ [format namespace] upvar $ns member1 l5 member2 l6
+ [format upvar] 1 member1 l7 member2 l8
+ set result [list $l1 $l2 $l3 $l4 $l5 $l6 $l7 $l8]
+ }
+ method result {} {return $result}
+ }
+} -body {
+ [[Master new] getChild] result
+} -cleanup {
+ Super destroy
+} -result {master1 master2 master1 master2 master1 master2 master1 master2}
# A feature that's not supported because the mechanism may change without
# warning, but is supposed to work...
diff --git a/tests/package.test b/tests/package.test
index 49346d8..da778f1 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -17,11 +17,6 @@ if {"::tcltest" ni [namespace children]} {
namespace import -force ::tcltest::*
}
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
-
-testConstraint testpreferstable [llength [info commands testpreferstable]]
-
# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
@@ -574,8 +569,7 @@ 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} -constraints testpreferstable -setup {
- testpreferstable
+test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -setup {
package forget t
set x xxx
} -body {
@@ -1239,11 +1233,9 @@ proc prefer {args} {
}
}
-test package-13.0 {package prefer defaults} -constraints testpreferstable -setup {
- testpreferstable
-} -body {
+test package-13.0 {package prefer defaults} {
prefer
-} -result stable
+} stable
test package-13.1 {package prefer defaults} -body {
set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant!
prefer
@@ -1258,25 +1250,15 @@ 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} -constraints testpreferstable -setup {
- testpreferstable
-} -body {package prefer stable} -result stable
-test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
- testpreferstable
-} -body {prefer stable} -result {stable stable}
-test package-15.2 {set latest, change} -constraints testpreferstable -setup {
- testpreferstable
-} -body {prefer latest} -result {stable latest}
-test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
- testpreferstable
-} -body {
+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
-} -result {stable latest latest}
-test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
- testpreferstable
-} -body {
+} {stable latest latest}
+test package-15.4 {set stable, rejected} {
prefer latest stable
-} -result {stable latest latest}
+} {stable latest latest}
rename prefer {}
diff --git a/tests/parseOld.test b/tests/parseOld.test
index a6e07a2b..504d063 100644
--- a/tests/parseOld.test
+++ b/tests/parseOld.test
@@ -13,7 +13,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-package require tcltest
+package require tcltest 2
namespace import ::tcltest::*
::tcltest::loadTestedCommands
@@ -37,7 +37,7 @@ proc getArgs args {
global argv
set argv $args
}
-
+
# Basic argument parsing.
test parseOld-1.1 {basic argument parsing} {
@@ -296,6 +296,7 @@ test parseOld-8.4 {semi-colons} {
# The following checks are to ensure that the interpreter's result
# gets re-initialized by Tcl_Eval in all the right places.
+set a 22
test parseOld-9.1 {result initialization} {concat abc} abc
test parseOld-9.2 {result initialization} {concat abc; proc foo {} {}} {}
test parseOld-9.3 {result initialization} {concat abc; proc foo {} $a} {}
@@ -408,6 +409,8 @@ test parseOld-11.7 {long values} {
set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]
llength $b
} 43
+# Duplicate action of previous test
+llength [set b [concat 1111 2222 3333 4444 5555 6666 7777 8888 9999 aaaa bbbb cccc dddd eeee ffff gggg hhhh iiii jjjj kkkk llll mmmm nnnn oooo pppp qqqq rrrr ssss tttt uuuu vvvv wwww xxxx yyyy zzzz AAAA BBBB CCCC DDDD EEEE FFFF GGGG HHHH]]
test parseOld-11.8 {long values} {
set b
} $a
@@ -538,8 +541,12 @@ test parseOld-15.4 {TclScriptEnd procedure} {
test parseOld-15.5 {TclScriptEnd procedure} {
info complete "xyz \[abc"
} {0}
-
+
# cleanup
set argv $savedArgv
::tcltest::cleanupTests
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/resolver.test b/tests/resolver.test
index e73ea50..f3d22e5 100644
--- a/tests/resolver.test
+++ b/tests/resolver.test
@@ -135,6 +135,9 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s
z
}
}
+ namespace eval :: {
+ variable r2 ""
+ }
} -constraints testinterpresolver -body {
set r0 [namespace eval ::ns2 {x}]
set r1 [namespace eval ::ns2 {z}]
diff --git a/tests/safe.test b/tests/safe.test
index 94c1755..6c9c6c9 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -211,8 +211,8 @@ test safe-7.3 {check that safe subinterpreters work} {
} {ok {} 0}
# test source control on file name
+set i "a"
test safe-8.1 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
@@ -221,7 +221,6 @@ test safe-8.1 {safe source control on file} -setup {
safe::interpDelete $i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.2 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
} -body {
safe::interpCreate $i
@@ -230,7 +229,6 @@ test safe-8.2 {safe source control on file} -setup {
safe::interpDelete $i
} -result {wrong # args: should be "source ?-encoding E? fileName"}
test safe-8.3 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {lappend ::log $str}
@@ -245,7 +243,6 @@ test safe-8.3 {safe source control on file} -setup {
safe::interpDelete $i
} -result {1 {permission denied} {{ERROR for slave a : ".": is a directory}}}
test safe-8.4 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -260,7 +257,6 @@ test safe-8.4 {safe source control on file} -setup {
safe::interpDelete $i
} -result {1 {permission denied} {{ERROR for slave a : "/abc/def": not in access_path}}}
test safe-8.5 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -279,7 +275,6 @@ test safe-8.5 {safe source control on file} -setup {
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah]:no such file or directory"]]
test safe-8.6 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -296,7 +291,6 @@ test safe-8.6 {safe source control on file} -setup {
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] blah.tcl]:no such file or directory"]]
test safe-8.7 {safe source control on file} -setup {
- set i "a"
catch {safe::interpDelete $i}
set log {}
proc safe-test-log {str} {global log; lappend log $str}
@@ -315,7 +309,6 @@ test safe-8.7 {safe source control on file} -setup {
safe::interpDelete $i
} -result [list 1 {no such file or directory} [list "ERROR for slave a : [file join [info library] xxxxxxxxxxx.tcl]:no such file or directory"]]
test safe-8.8 {safe source forbids -rsrc} -setup {
- set i "a"
catch {safe::interpDelete $i}
safe::interpCreate $i
} -body {
@@ -349,8 +342,8 @@ test safe-8.10 {safe source and return} -setup {
removeFile $returnScript
} -result ok
+set i "a"
test safe-9.1 {safe interps' deleteHook} -setup {
- set i "a"
catch {safe::interpDelete $i}
set res {}
} -body {
@@ -365,7 +358,6 @@ test safe-9.1 {safe interps' deleteHook} -setup {
list [interp eval $i exit] $res
} -result {{} {arg1 arg2 a}}
test safe-9.2 {safe interps' error in deleteHook} -setup {
- set i "a"
catch {safe::interpDelete $i}
set res {}
set log {}
@@ -531,14 +523,14 @@ test safe-11.7.1 {testing safe encoding} -setup {
} -body {
catch {interp eval $i encoding convertfrom} m o
dict get $o -errorinfo
-} -returnCodes ok -cleanup {
+} -returnCodes ok -match glob -cleanup {
unset -nocomplain m o
safe::interpDelete $i
} -result {wrong # args: should be "encoding convertfrom ?encoding? data"
while executing
"encoding convertfrom"
invoked from within
-"::interp invokehidden interp1 encoding convertfrom"
+"::interp invokehidden interp* encoding convertfrom"
invoked from within
"encoding convertfrom"
invoked from within
@@ -555,14 +547,14 @@ test safe-11.8.1 {testing safe encoding} -setup {
} -body {
catch {interp eval $i encoding convertto} m o
dict get $o -errorinfo
-} -returnCodes ok -cleanup {
+} -returnCodes ok -match glob -cleanup {
unset -nocomplain m o
safe::interpDelete $i
} -result {wrong # args: should be "encoding convertto ?encoding? data"
while executing
"encoding convertto"
invoked from within
-"::interp invokehidden interp1 encoding convertto"
+"::interp invokehidden interp* encoding convertto"
invoked from within
"encoding convertto"
invoked from within
diff --git a/tests/set-old.test b/tests/set-old.test
index 0e9ca63..1c68f91 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -14,7 +14,7 @@
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
if {[lsearch [namespace children] ::tcltest] == -1} {
- package require tcltest
+ package require tcltest 2
namespace import -force ::tcltest::*
}
@@ -865,6 +865,8 @@ test set-old-10.13 {array enumeration errors} {
list [catch {array done a b c} msg] $msg
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
test set-old-10.14 {array enumeration errors} {
+ catch {unset a}
+ set a(a) a
list [catch {array done a b} msg] $msg
} {1 {illegal search identifier "b"}}
test set-old-10.15 {array enumeration errors} {
@@ -931,7 +933,7 @@ catch {rename foo {}}
# cleanup
::tcltest::cleanupTests
-return
+return
# Local Variables:
# mode: tcl
diff --git a/tests/set.test b/tests/set.test
index 7e4b864..f5cfe66 100644
--- a/tests/set.test
+++ b/tests/set.test
@@ -22,7 +22,7 @@ testConstraint testset2 [llength [info commands testset2]]
catch {unset x}
catch {unset i}
-
+
test set-1.1 {TclCompileSetCmd: missing variable name} {
list [catch {set} msg] $msg
} {1 {wrong # args: should be "set varName ?newValue?"}}
@@ -39,16 +39,18 @@ test set-1.4 {TclCompileSetCmd: simple variable name in quotes} {
set i 17
list [set "i"] $i
} {17 17}
-test set-1.5 {TclCompileSetCmd: simple variable name in braces} {
+test set-1.5 {TclCompileSetCmd: simple variable name in braces} -setup {
catch {unset {a simple var}}
+} -body {
set {a simple var} 27
list [set {a simple var}] ${a simple var}
-} {27 27}
-test set-1.6 {TclCompileSetCmd: simple array variable name} {
+} -result {27 27}
+test set-1.6 {TclCompileSetCmd: simple array variable name} -setup {
catch {unset a}
+} -body {
set a(foo) 37
list [set a(foo)] $a(foo)
-} {37 37}
+} -result {37 37}
test set-1.7 {TclCompileSetCmd: non-simple (computed) variable name} {
set x "i"
set i 77
@@ -149,22 +151,24 @@ test set-1.14 {TclCompileSetCmd: simple local name, >255 locals} {
}
260locals
} {1234}
-test set-1.15 {TclCompileSetCmd: variable is array} {
+test set-1.15 {TclCompileSetCmd: variable is array} -setup {
catch {unset a}
+} -body {
set x 27
set x [set a(foo) 11]
catch {unset a}
set x
-} 11
-test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} {
+} -result 11
+test set-1.16 {TclCompileSetCmd: variable is array, elem substitutions} -setup {
catch {unset a}
+} -body {
set i 5
set x 789
set a(foo5) 27
set x [set a(foo$i)]
catch {unset a}
set x
-} 27
+} -result 27
test set-1.17 {TclCompileSetCmd: doing assignment, simple int} {
set i 5
@@ -211,7 +215,7 @@ test set-1.25 {TclCompileSetCmd: var is array, braced (no subs)} {
test set-1.26 {TclCompileSetCmd: various array constructs} {
# Test all kinds of array constructs that TclCompileSetCmd
# may feel inclined to tamper with.
- proc p {} {
+ apply {{} {
set a x
set be(hej) 1 ; # hej
set be($a) 1 ; # x
@@ -230,28 +234,33 @@ test set-1.26 {TclCompileSetCmd: various array constructs} {
set [string range bet 0 1](foo) 1 ; # foo
set be([set be(a:$a)][set b\e($a)]) 1 ; # 51
return [lsort [array names be]]
- }
- p
+ }}
} [lsort {hej x $a x,hej x,x c(x ww a:x hej,1,hej hug {a a} {x ,ugg,hej} x,h"ej
{b c} foo 51}]; # " just a matching end quote
-test set-2.1 {set command: runtime error, bad variable name} {
+test set-2.1 {set command: runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
list [catch {set {"foo}} msg] $msg $::errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
while executing
"set {"foo}"}}
-test set-2.2 {set command: runtime error, not array variable} {
- catch {unset b}
+# Stop my editor highlighter " from being confused
+test set-2.2 {set command: runtime error, not array variable} -setup {
+ unset -nocomplain b
+} -body {
set b 44
list [catch {set b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-2.3 {set command: runtime error, errors in reading variables} {
- catch {unset a}
+} -result {1 {can't read "b(123)": variable isn't array}}
+test set-2.3 {set command: runtime error, errors in reading variables} -setup {
+ unset -nocomplain a
+} -body {
set a(6) 44
list [catch {set a(18)} msg] $msg
-} {1 {can't read "a(18)": no such element in array}}
-test set-2.4 {set command: runtime error, readonly variable} -body {
+} -result {1 {can't read "a(18)": no such element in array}}
+test set-2.4 {set command: runtime error, readonly variable} -setup {
+ unset -nocomplain x
+} -body {
proc readonly args {error "variable is read-only"}
set x 123
trace var x w readonly
@@ -260,12 +269,18 @@ test set-2.4 {set command: runtime error, readonly variable} -body {
while executing
*
"set x 1"}}
-test set-2.5 {set command: runtime error, basic array operations} {
+test set-2.5 {set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+} -body {
+ array set a {}
list [catch {set a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-2.6 {set command: runtime error, basic array operations} {
+} -result {1 {can't read "a(other)": no such element in array}}
+test set-2.6 {set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+} -body {
+ array set a {}
list [catch {set a} msg] $msg
-} {1 {can't read "a": variable is array}}
+} -result {1 {can't read "a": variable is array}}
# Test the uncompiled version of set
@@ -479,25 +494,29 @@ test set-3.24 {uncompiled set command: too many arguments} {
$z msg
} {wrong # args: should be "set varName ?newValue?"}
-test set-4.1 {uncompiled set command: runtime error, bad variable name} {
+test set-4.1 {uncompiled set command: runtime error, bad variable name} -setup {
unset -nocomplain {"foo}
+} -body {
set z set
list [catch {$z {"foo}} msg] $msg $::errorInfo
-} {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
+} -result {1 {can't read ""foo": no such variable} {can't read ""foo": no such variable
while executing
"$z {"foo}"}}
-test set-4.2 {uncompiled set command: runtime error, not array variable} {
- set z set
+# Stop my editor highlighter " from being confused
+test set-4.2 {uncompiled set command: runtime error, not array variable} -setup {
catch {unset b}
+} -body {
+ set z set
$z b 44
list [catch {$z b(123)} msg] $msg
-} {1 {can't read "b(123)": variable isn't array}}
-test set-4.3 {uncompiled set command: runtime error, errors in reading variables} {
- set z set
- catch {unset a}
+} -result {1 {can't read "b(123)": variable isn't array}}
+test set-4.3 {uncompiled set command: runtime error, errors in reading variables} -setup {
+ catch {unset a}
+} -body {
+ set z set
$z a(6) 44
list [catch {$z a(18)} msg] $msg
-} {1 {can't read "a(18)": no such element in array}}
+} -result {1 {can't read "a(18)": no such element in array}}
test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
set z set
proc readonly args {error "variable is read-only"}
@@ -508,27 +527,33 @@ test set-4.4 {uncompiled set command: runtime error, readonly variable} -body {
while executing
*
"$z x 1"}}
-test set-4.5 {uncompiled set command: runtime error, basic array operations} {
+test set-4.5 {uncompiled set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+ array set a {}
+} -body {
set z set
list [catch {$z a(other)} msg] $msg
-} {1 {can't read "a(other)": no such element in array}}
-test set-4.6 {set command: runtime error, basic array operations} {
+} -result {1 {can't read "a(other)": no such element in array}}
+test set-4.6 {set command: runtime error, basic array operations} -setup {
+ unset -nocomplain a
+ array set a {}
+} -body {
set z set
list [catch {$z a} msg] $msg
-} {1 {can't read "a": variable is array}}
+} -result {1 {can't read "a": variable is array}}
-test set-5.1 {error on malformed array name} testset2 {
+test set-5.1 {error on malformed array name} -constraints testset2 -setup {
unset -nocomplain z
+} -body {
catch {testset2 z(a) b} msg
catch {testset2 z(b) a} msg1
list $msg $msg1
-} {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
-
+} -result {{can't read "z(a)(b)": variable isn't array} {can't read "z(b)(a)": variable isn't array}}
# In a mem-debug build, this test will crash unless Bug 3602706 is fixed.
test set-5.2 {Bug 3602706} -body {
testset2 ::tcl_platform not-in-there
} -returnCodes error -result * -match glob
-
+
# cleanup
catch {unset a}
catch {unset b}
@@ -536,4 +561,12 @@ catch {unset i}
catch {unset x}
catch {unset z}
::tcltest::cleanupTests
-return
+return
+
+# Local Variables:
+# mode: tcl
+# End:
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/socket.test b/tests/socket.test
index 8473602..d43c41c 100644
--- a/tests/socket.test
+++ b/tests/socket.test
@@ -1782,7 +1782,6 @@ test socket_$af-13.1 {Testing use of shared socket between two threads} -body {
set i 0
vwait x
close $f
- thread::wait
}]]
set port [thread::send $serverthread {set listen}]
set s [socket $localhost $port]
diff --git a/tests/tcltest.test b/tests/tcltest.test
index e66678b..728a018 100644..100755
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -46,6 +46,7 @@ makeFile {
cd [temporaryDirectory]
testConstraint exec [llength [info commands exec]]
+
# test -help
# Child processes because -help [exit]s.
test tcltest-1.1 {tcltest -help} {exec} {
@@ -1824,9 +1825,13 @@ test tcltest-26.2 {Bug/RFE 1017151} -setup {
---- errorInfo: body error
*
---- errorInfo(cleanup): cleanup error*}
-
+
cleanupTests
}
namespace delete ::tcltest::test
return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tests/unload.test b/tests/unload.test
index 5a374c4..73f1091 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -45,6 +45,14 @@ testConstraint teststaticpkg [llength [info commands teststaticpkg]]
testConstraint testsimplefilesystem \
[llength [info commands testsimplefilesystem]]
+proc loadIfNotPresent {pkg args} {
+ global testDir ext
+ set loaded [lmap x [info loaded {*}$args] {lindex $x 1}]
+ if {[string totitle $pkg] ni $loaded} {
+ load [file join $testDir $pkg$ext]
+ }
+}
+
# Basic tests: parameter testing...
test unload-1.1 {basic errors} -returnCodes error -body {
unload
@@ -73,7 +81,7 @@ set pkgua_detached {}
set pkgua_unloaded {}
# Tests for loading/unloading in trusted (non-safe) interpreters...
test unload-2.1 {basic loading of non-unloadable package, with guess for package name} [list $dll $loaded] {
- load [file join $testDir pkga$ext]
+ loadIfNotPresent pkga
list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
test unload-2.2 {basic loading of unloadable package, with guess for package name} [list $dll $loaded] {
@@ -82,28 +90,43 @@ test unload-2.2 {basic loading of unloadable package, with guess for package nam
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
} {{} {} {} {} 0 {pkgua_eq pkgua_quote} . {} {}}
-test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} [list $dll $loaded] {
- list [catch {unload [file join $testDir pkga$ext]} msg] \
- [string map [list [file join $testDir pkga$ext] file] $msg]
-} {1 {file "file" cannot be unloaded under a trusted interpreter}}
-test unload-2.4 {basic unloading of unloadable package, with guess for package name} [list $dll $loaded] {
+test unload-2.3 {basic unloading of non-unloadable package, with guess for package name} -setup {
+ loadIfNotPresent pkga
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+ unload [file join $testDir pkga$ext]
+} -result {file "*" cannot be unloaded under a trusted interpreter}
+test unload-2.4 {basic unloading of unloadable package, with guess for package name} -setup {
+ loadIfNotPresent pkgua
+} -constraints [list $dll $loaded] -body {
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
[unload [file join $testDir pkgua$ext]] \
[info commands pkgua_*] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {. {} {} {} {} . . .}
-test unload-2.5 {reloading of unloaded package, with guess for package name} [list $dll $loaded] {
+} -result {. {} {} {} {} . . .}
+test unload-2.5 {reloading of unloaded package, with guess for package name} -setup {
+ if {$pkgua_loaded eq ""} {
+ loadIfNotPresent pkgua
+ unload [file join $testDir pkgua$ext]
+ }
+} -constraints [list $dll $loaded] -body {
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
[load [file join $testDir pkgua$ext]] \
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
-test unload-2.6 {basic unloading of re-loaded package, with guess for package name} [list $dll $loaded] {
+} -result {. . . {} 0 {pkgua_eq pkgua_quote} .. . .}
+test unload-2.6 {basic unloading of re-loaded package, with guess for package name} -setup {
+ # Establish expected state
+ if {$pkgua_loaded eq ""} {
+ loadIfNotPresent pkgua
+ unload [file join $testDir pkgua$ext]
+ load [file join $testDir pkgua$ext]
+ }
+} -constraints [list $dll $loaded] -body {
list $pkgua_loaded $pkgua_detached $pkgua_unloaded \
[unload [file join $testDir pkgua$ext]] \
[info commands pkgua_*] \
$pkgua_loaded $pkgua_detached $pkgua_unloaded
-} {.. . . {} {} .. .. ..}
+} -result {.. . . {} {} .. .. ..}
# Tests for loading/unloading in safe interpreters...
interp create -safe child
@@ -127,38 +150,52 @@ test unload-3.2 {basic loading of unloadable package in a safe interpreter, with
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
-test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} \
- [list $dll $loaded] {
- list [catch {unload [file join $testDir pkga$ext] {} child} msg] \
- [string map [list [file join $testDir pkga$ext] file] $msg]
-} {1 {file "file" has never been loaded in this interpreter}}
-test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
- list [catch {unload [file join $testDir pkgb$ext] {} child} msg] \
- [string map [list [file join $testDir pkgb$ext] file] $msg]
-} {1 {file "file" cannot be unloaded under a safe interpreter}}
-test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
+ loadIfNotPresent pkga
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+ unload [file join $testDir pkga$ext] {} child
+} -result {file "*" has never been loaded in this interpreter}
+test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {[lsearch -index 1 [info loaded child] Pkgb] == -1} {
+ load [file join $testDir pkgb$ext] pKgB child
+ }
+} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
+ unload [file join $testDir pkgb$ext] {} child
+} -result {file "*" cannot be unloaded under a safe interpreter}
+test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {[lsearch -index 1 [info loaded child] Pkgua] == -1} {
+ load [file join $testDir pkgua$ext] pkgua child
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] {} child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. {} {}} {} {} {. . .}}
-test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+} -result {{. {} {}} {} {} {. . .}}
+test unload-3.6 {reloading of unloaded package in a safe interpreter, with guess for package name} -setup {
+ if {[child eval set pkgua_loaded] eq ""} {
+ load [file join $testDir pkgua$ext] {} child
+ unload [file join $testDir pkgua$ext] {} child
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] {} child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
-test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} \
- [list $dll $loaded] {
+} -result {{. . .} {} 0 {pkgua_eq pkgua_quote} {.. . .}}
+test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, with package name conversion} -setup {
+ if {[child eval set pkgua_loaded] eq ""} {
+ load [file join $testDir pkgua$ext] {} child
+ unload [file join $testDir pkgua$ext] {} child
+ load [file join $testDir pkgua$ext] {} child
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] pKgUa child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{.. . .} {} {} {.. .. ..}}
+} -result {{.. . .} {} {} {.. .. ..}}
# Tests for loading/unloading of a package among multiple interpreters...
interp create child-trusted
@@ -167,56 +204,89 @@ child-trusted eval {
set pkgua_detached {}
set pkgua_unloaded {}
}
+array set load {M 0 C 0 T 0}
## Load package in main trusted interpreter...
-test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.1 {loading of unloadable package in trusted interpreter, with guess for package name} -setup {
+ set pkgua_loaded ""
+ set pkgua_detached ""
+ set pkgua_unloaded ""
+ incr load(M)
+} -constraints [list $dll $loaded] -body {
list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
[load [file join $testDir pkgua$ext]] \
[pkgua_eq abc def] [lsort [info commands pkgua_*]] \
[list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
-} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-safe interpreter...
-test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
- [list $dll $loaded] {
+test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup {
+ child eval {
+ set pkgua_loaded ""
+ set pkgua_detached ""
+ set pkgua_unloaded ""
+ }
+ incr load(C)
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pKgUA child] \
[child eval pkgua_eq abc def] \
[lsort [child eval info commands pkgua_*]] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{.. .. ..} {} 0 {pkgua_eq pkgua_quote} {... .. ..}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-trusted interpreter...
-test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} \
- [list $dll $loaded] {
+test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup {
+ incr load(T)
+} -constraints [list $dll $loaded] -body {
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[load [file join $testDir pkgua$ext] pkguA child-trusted] \
[child-trusted eval pkgua_eq abc def] \
[lsort [child-trusted eval info commands pkgua_*]] \
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
+} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Unload the package from the main trusted interpreter...
-test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup {
+ if {!$load(M)} {
+ load [file join $testDir pkgua$ext]
+ }
+ if {!$load(C)} {
+ load [file join $testDir pkgua$ext] {} child
+ incr load(C)
+ }
+ if {!$load(T)} {
+ load [file join $testDir pkgua$ext] {} child-trusted
+ incr load(T)
+ }
+} -constraints [list $dll $loaded] -body {
list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
[unload [file join $testDir pkgua$ext]] \
[info commands pkgua_*] \
[list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
-} {{... .. ..} {} {} {... ... ..}}
+} -result {{. {} {}} {} {} {. . {}}}
## Unload the package from the child safe interpreter...
-test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.5 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {!$load(C)} {
+ load [file join $testDir pkgua$ext] {} child
+ }
+ if {!$load(T)} {
+ load [file join $testDir pkgua$ext] {} child-trusted
+ incr load(T)
+ }
+} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] {} child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{... .. ..} {} {} {... ... ..}}
+} -result {{. {} {}} {} {} {. . {}}}
## Unload the package from the child trusted interpreter...
-test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} \
- [list $dll $loaded] {
+test unload-4.6 {basic unloading of unloadable package from a safe interpreter, with guess for package name} -setup {
+ if {!$load(T)} {
+ load [file join $testDir pkgua$ext] {} child-trusted
+ }
+} -constraints [list $dll $loaded] -body {
list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
[unload [file join $testDir pkgua$ext] {} child-trusted] \
[child-trusted eval info commands pkgua_*] \
[child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
-} {{. {} {}} {} {} {. . .}}
+} -result {{. {} {}} {} {} {. . .}}
test unload-5.1 {unload a module loaded from vfs} \
-constraints [list $dll $loaded testsimplefilesystem] \
@@ -230,9 +300,7 @@ test unload-5.1 {unload a module loaded from vfs} \
list [catch {unload simplefs:/pkgua$ext} msg] $msg
} \
-result {0 {}}
-
-
-
+
# cleanup
interp delete child
interp delete child-trusted
diff --git a/tests/var.test b/tests/var.test
index 6f90664..297034a 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -39,15 +39,17 @@ 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)
} -result {11 11 38 38}
+set ::x "global value"
+namespace eval test_ns_var {
+ variable x "namespace value"
+}
test var-1.2 {TclLookupVar, TCL_GLOBAL_ONLY implies global namespace var} {
- set x "global value"
namespace eval test_ns_var {
- variable x "namespace value"
proc p {} {
global x ;# specifies TCL_GLOBAL_ONLY to get global x
return $x
@@ -167,7 +169,9 @@ test var-1.17 {TclLookupVar, resurrect array element via upvar to deleted array:
set result
}
} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
-test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} {
+test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array: uncompiled code path} -setup {
+ unset -nocomplain test_ns_var::x
+} -body {
namespace eval test_ns_var {
variable result {}
variable x
@@ -179,7 +183,7 @@ test var-1.18 {TclLookupVar, resurrect array element via upvar to deleted array:
namespace delete [namespace current]
set result
}
-} {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
+} -result {0 2 1 {can't set "foo": upvar refers to element in deleted array}}
test var-1.19 {TclLookupVar, right error message when parsing variable name} -body {
[format set] thisvar(doesntexist)
} -returnCodes error -result {can't read "thisvar(doesntexist)": no such variable}
@@ -216,7 +220,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}
@@ -228,7 +232,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
}
@@ -261,6 +265,7 @@ test var-3.7 {MakeUpvar, my var has ::s} -setup {
}
} -result {789789}
test var-3.8 {MakeUpvar, my var already exists in global ns} -setup {
+ upvar #0 aaaaa xxxxx
catch {unset aaaaa}
catch {unset xxxxx}
} -body {
@@ -274,6 +279,8 @@ test var-3.9 {MakeUpvar, my var has invalid ns name} -setup {
} -returnCodes error -body {
set aaaaa 789789
upvar #0 aaaaa test_ns_fred::lnk
+} -cleanup {
+ unset ::aaaaa
} -result {can't create "test_ns_fred::lnk": parent namespace doesn't exist}
test var-3.10 {MakeUpvar, between namespaces} -body {
namespace eval {} {
@@ -282,8 +289,6 @@ test var-3.10 {MakeUpvar, between namespaces} -body {
set foo::bar 1
list $bar $foo::bar
}
-} -cleanup {
- unset ::aaaaa
} -result {1 1}
test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
catch {unset aaaaa}
@@ -322,9 +327,11 @@ test var-5.2 {Tcl_GetVariableFullName, namespace variable} {
namespace which -variable martha
}
} {::test_ns_var::martha}
-test var-5.3 {Tcl_GetVariableFullName, namespace variable} {
+test var-5.3 {Tcl_GetVariableFullName, namespace variable} -setup {
+ namespace eval test_ns_var {variable martha}
+} -body {
namespace which -variable test_ns_var::martha
-} {::test_ns_var::martha}
+} -result {::test_ns_var::martha}
test var-6.1 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
namespace eval test_ns_var {
@@ -348,6 +355,7 @@ test var-6.2 {Tcl_GlobalObjCmd, variable is qualified by a namespace name} {
test_ns_var::p
} {java}
test var-6.3 {Tcl_GlobalObjCmd, variable named {} qualified by a namespace name} {
+ namespace eval ::test_ns_var::test_ns_nested {}
set ::test_ns_var::test_ns_nested:: 24
apply {{} {
global ::test_ns_var::test_ns_nested::
@@ -389,20 +397,26 @@ test var-7.2 {Tcl_VariableObjCmd, if new and no value, leave undefined} {
}
list [info exists test_ns_var::two] [catch {set test_ns_var::two} msg] $msg
} {0 1 {can't read "test_ns_var::two": no such variable}}
-test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} {
+test var-7.3 {Tcl_VariableObjCmd, "define" var already created above} -setup {
+ catch {namespace delete test_ns_var}
+ namespace eval test_ns_var {variable one 1}
+} -body {
namespace eval test_ns_var {
variable two 2
}
list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {set two}]
-} [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
-test var-7.4 {Tcl_VariableObjCmd, list of vars} {
+} -result [list [lsort {::test_ns_var::two ::test_ns_var::one}] 2]
+test var-7.4 {Tcl_VariableObjCmd, list of vars} -setup {
+ catch {namespace delete test_ns_var}
+ namespace eval test_ns_var {variable one 1; variable two 2}
+} -body {
namespace eval test_ns_var {
variable three 3 four 4
}
list [lsort [info vars test_ns_var::*]] \
[namespace eval test_ns_var {expr $three+$four}]
-} [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
+} -result [list [lsort {::test_ns_var::four ::test_ns_var::three ::test_ns_var::two ::test_ns_var::one}] 7]
test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
catch {unset a}
catch {unset five}
@@ -476,7 +490,9 @@ test var-7.9 {Tcl_VariableObjCmd, mark as namespace var so var persists until na
[lsort {::test_ns_var2::x ::test_ns_var2::z}] 0 0\
{1 {can't unset "test_ns_var2::z": no such variable}}\
{}]
-test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+ namespace eval test_ns_var { variable eight 8 }
+} -body {
namespace eval test_ns_var {
proc p {} {
variable eight
@@ -484,14 +500,16 @@ test var-7.10 {Tcl_VariableObjCmd, variable cmd inside proc creates local link v
}
p
}
-} {8 eight}
-test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
+} -result {8 eight}
+test var-7.11 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} -setup {
+ namespace eval test_ns_var { variable eight 8 }
+} -body {
proc p {} { ;# note this proc is at global :: scope
variable test_ns_var::eight
list [set eight] [info vars]
}
p
-} {8 eight}
+} -result {8 eight}
test var-7.12 {Tcl_VariableObjCmd, variable cmd inside proc creates local link var} {
namespace eval test_ns_var {
variable {} {My name is empty}
@@ -516,11 +534,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
@@ -742,7 +760,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.
#
@@ -774,7 +792,7 @@ test var-17.1 {TclArraySet [Bug 1669489]} -setup {
test var-18.1 {array unset and unset traces: Bug 2939073} -setup {
set already 0
- unset x
+ unset -nocomplain x
} -body {
array set x {e 1 i 1}
trace add variable x unset {apply {args {
diff --git a/tests/zlib.test b/tests/zlib.test
index 968469d..8a040d8 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -251,9 +251,10 @@ test zlib-8.8 {transformation and fconfigure} -setup {
} -constraints zlib -body {
zlib push compress $outSide -dictionary $spdyDict
fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 0 -translation binary
+ fconfigure $inSide -blocking 1 -translation binary
puts -nonewline $outSide $spdyHeaders
chan pop $outSide
+ chan close $outSide
set compressed [read $inSide]
catch {zlib decompress $compressed} err opt
list [string length [zlib compress $spdyHeaders]] \
@@ -269,10 +270,11 @@ test zlib-8.9 {transformation and fconfigure} -setup {
} -constraints zlib -body {
zlib push compress $outSide -dictionary $spdyDict
fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 0 -translation binary
+ fconfigure $inSide -blocking 1 -translation binary
puts -nonewline $outSide $spdyHeaders
set result [fconfigure $outSide -checksum]
chan pop $outSide
+ chan close $outSide
$strm put -dictionary $spdyDict [read $inSide]
lappend result [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
@@ -285,9 +287,10 @@ test zlib-8.10 {transformation and fconfigure} -setup {
} -constraints {zlib recentZlib} -body {
zlib push deflate $outSide -dictionary $spdyDict
fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 0 -translation binary
+ fconfigure $inSide -blocking 1 -translation binary
puts -nonewline $outSide $spdyHeaders
chan pop $outSide
+ chan close $outSide
set compressed [read $inSide]
catch {
zlib inflate $compressed
@@ -306,9 +309,10 @@ test zlib-8.11 {transformation and fconfigure} -setup {
} -constraints zlib -body {
zlib push deflate $outSide -dictionary $spdyDict
fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 0 -translation binary
+ fconfigure $inSide -blocking 1 -translation binary
puts -nonewline $outSide $spdyHeaders
chan pop $outSide
+ chan close $outSide
$strm put -dictionary $spdyDict [read $inSide]
list [string length $spdyHeaders] [string length [$strm get]]
} -cleanup {
@@ -401,6 +405,26 @@ test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
} -cleanup {
removeFile $file
} -result 57647
+test zlib-8.17 {Bug dd260aaf: fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+ zlib push inflate $inSide
+ zlib push deflate $outSide
+ list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
+} -cleanup {
+ catch {close $inSide}
+ catch {close $outSide}
+} -result {{} {}}
+test zlib-8.18 {Bug dd260aaf: fconfigure} -setup {
+ lassign [chan pipe] inSide outSide
+} -constraints zlib -body {
+ zlib push inflate $inSide -dictionary "one two"
+ zlib push deflate $outSide -dictionary "one two"
+ list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
+} -cleanup {
+ catch {close $inSide}
+ catch {close $outSide}
+} -result {{one two} {one two}}
test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
set sfile [makeFile {} testsrc.gz]
diff --git a/unix/configure b/unix/configure
index ba45591..835988e 100755
--- a/unix/configure
+++ b/unix/configure
@@ -1911,7 +1911,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".5"
+TCL_PATCH_LEVEL=".6"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
diff --git a/unix/configure.in b/unix/configure.in
index 821b2a9..52d4a0d 100644
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -25,7 +25,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".5"
+TCL_PATCH_LEVEL=".6"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
diff --git a/unix/installManPage b/unix/installManPage
index 4d615bf..1f1cbde 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -106,7 +106,7 @@ for Target in $Names; do
First=$Target
sed -e "/man\.macros/r $SrcDir/man.macros" -e "/man\.macros/d" \
$ManPage > $Dir/$First
- chmod 444 $Dir/$First
+ chmod 644 $Dir/$First
$Gzip $Dir/$First
else
ln $SymOrLoc$First$Gz $Dir/$Target$Gz
diff --git a/unix/tcl.spec b/unix/tcl.spec
index 3044311..8bf77f3 100644
--- a/unix/tcl.spec
+++ b/unix/tcl.spec
@@ -4,7 +4,7 @@
Name: tcl
Summary: Tcl scripting language development environment
-Version: 8.6.5
+Version: 8.6.6
Release: 2
License: BSD
Group: Development/Languages
diff --git a/unix/tclUnixNotfy.c b/unix/tclUnixNotfy.c
index 3422089..21706bf 100644
--- a/unix/tclUnixNotfy.c
+++ b/unix/tclUnixNotfy.c
@@ -252,7 +252,7 @@ extern unsigned char __stdcall TranslateMessage(const MSG *);
* Threaded-cygwin specific constants and functions in this file:
*/
-static const WCHAR className[] = L"TclNotifier";
+static const WCHAR NotfyClassName[] = L"TclNotifier";
static DWORD __stdcall NotifierProc(void *hwnd, unsigned int message,
void *wParam, void *lParam);
#endif /* TCL_THREADS && __CYGWIN__ */
@@ -341,7 +341,7 @@ Tcl_InitNotifier(void)
class.hInstance = TclWinGetTclInstance();
class.hbrBackground = NULL;
class.lpszMenuName = NULL;
- class.lpszClassName = className;
+ class.lpszClassName = NotfyClassName;
class.lpfnWndProc = NotifierProc;
class.hIcon = NULL;
class.hCursor = NULL;
@@ -1399,8 +1399,8 @@ AtForkChild(void)
*/
#ifdef __CYGWIN__
DestroyWindow(tsdPtr->hwnd);
- tsdPtr->hwnd = CreateWindowExW(NULL, className,
- className, 0, 0, 0, 0, 0, NULL, NULL,
+ tsdPtr->hwnd = CreateWindowExW(NULL, NotfyClassName,
+ NotfyClassName, 0, 0, 0, 0, 0, NULL, NULL,
TclWinGetTclInstance(), NULL);
ResetEvent(tsdPtr->event);
#else
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index 554a2dc..9074a3a 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -44,6 +44,13 @@ static pthread_mutex_t initLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t allocLock = PTHREAD_MUTEX_INITIALIZER;
static pthread_mutex_t *allocLockPtr = &allocLock;
+/*
+ * These are for the critical sections inside this file.
+ */
+
+#define MASTER_LOCK pthread_mutex_lock(&masterLock)
+#define MASTER_UNLOCK pthread_mutex_unlock(&masterLock)
+
#endif /* TCL_THREADS */
/*
@@ -414,7 +421,7 @@ Tcl_MutexLock(
pthread_mutex_t *pmutexPtr;
if (*mutexPtr == NULL) {
- pthread_mutex_lock(&masterLock);
+ MASTER_LOCK;
if (*mutexPtr == NULL) {
/*
* Double inside master lock check to avoid a race condition.
@@ -425,7 +432,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex)pmutexPtr;
TclRememberMutex(mutexPtr);
}
- pthread_mutex_unlock(&masterLock);
+ MASTER_UNLOCK;
}
pmutexPtr = *((pthread_mutex_t **)mutexPtr);
pthread_mutex_lock(pmutexPtr);
@@ -522,7 +529,7 @@ Tcl_ConditionWait(
struct timespec ptime;
if (*condPtr == NULL) {
- pthread_mutex_lock(&masterLock);
+ MASTER_LOCK;
/*
* Double check inside mutex to avoid race, then initialize condition
@@ -535,7 +542,7 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) pcondPtr;
TclRememberCondition(condPtr);
}
- pthread_mutex_unlock(&masterLock);
+ MASTER_UNLOCK;
}
pmutexPtr = *((pthread_mutex_t **)mutexPtr);
pcondPtr = *((pthread_cond_t **)condPtr);
diff --git a/win/configure b/win/configure
index 747c932..2710c79 100755
--- a/win/configure
+++ b/win/configure
@@ -1312,7 +1312,7 @@ SHELL=/bin/sh
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".5"
+TCL_PATCH_LEVEL=".6"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
diff --git a/win/configure.in b/win/configure.in
index adfc765..b914037 100644
--- a/win/configure.in
+++ b/win/configure.in
@@ -14,7 +14,7 @@ SHELL=/bin/sh
TCL_VERSION=8.6
TCL_MAJOR_VERSION=8
TCL_MINOR_VERSION=6
-TCL_PATCH_LEVEL=".5"
+TCL_PATCH_LEVEL=".6"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 846cb35..94df281 100755
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -16,8 +16,9 @@
#include "tclFileSystem.h"
#include <winioctl.h>
#include <shlobj.h>
-#include <lm.h> /* For TclpGetUserHome(). */
+#include <lm.h> /* For TclpGetUserHome(). */
#include <userenv.h> /* For TclpGetUserHome(). */
+#include <aclapi.h> /* For GetNamedSecurityInfo */
#ifdef _MSC_VER
# pragma comment(lib, "userenv.lib")
@@ -1769,7 +1770,7 @@ NativeAccess(
* NativeIsExec --
*
* Determines if a path is executable. On windows this is simply defined
- * by whether the path ends in any of ".exe", ".com", or ".bat"
+ * by whether the path ends in a standard executable extension.
*
* Results:
* 1 = executable, 0 = not.
@@ -1793,6 +1794,7 @@ NativeIsExec(
if ((_tcsicmp(path+len-3, TEXT("exe")) == 0)
|| (_tcsicmp(path+len-3, TEXT("com")) == 0)
+ || (_tcsicmp(path+len-3, TEXT("cmd")) == 0)
|| (_tcsicmp(path+len-3, TEXT("bat")) == 0)) {
return 1;
}
@@ -1951,6 +1953,7 @@ NativeStat(
unsigned short mode;
unsigned int inode = 0;
HANDLE fileHandle;
+ DWORD fileType = FILE_TYPE_UNKNOWN;
/*
* If we can use 'createFile' on this, then we can use the resulting
@@ -1958,6 +1961,14 @@ NativeStat(
* other attributes reading APIs. If not, then we try to fall back on the
* 'getFileAttributesExProc', and if that isn't available, then on even
* simpler routines.
+ *
+ * Special consideration must be given to Windows hardcoded names
+ * like CON, NULL, COM1, LPT1 etc. For these, we still need to
+ * do the CreateFile as some may not exist (e.g. there is no CON
+ * in wish by default). However the subsequent GetFileInformationByHandle
+ * will fail. We do a WinIsReserved to see if it is one of the special
+ * names, and if successful, mock up a BY_HANDLE_FILE_INFORMATION
+ * structure.
*/
fileHandle = CreateFile(nativePath, GENERIC_READ,
@@ -1968,19 +1979,26 @@ NativeStat(
BY_HANDLE_FILE_INFORMATION data;
if (GetFileInformationByHandle(fileHandle,&data) != TRUE) {
- CloseHandle(fileHandle);
- Tcl_SetErrno(ENOENT);
- return -1;
- }
- CloseHandle(fileHandle);
-
+ fileType = GetFileType(fileHandle);
+ CloseHandle(fileHandle);
+ if (fileType != FILE_TYPE_CHAR && fileType != FILE_TYPE_DISK) {
+ Tcl_SetErrno(ENOENT);
+ return -1;
+ }
+ /* Mock up the expected structure */
+ memset(&data, 0, sizeof(data));
+ statPtr->st_atime = 0;
+ statPtr->st_mtime = 0;
+ statPtr->st_ctime = 0;
+ } else {
+ CloseHandle(fileHandle);
+ statPtr->st_atime = ToCTime(data.ftLastAccessTime);
+ statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
+ statPtr->st_ctime = ToCTime(data.ftCreationTime);
+ }
attr = data.dwFileAttributes;
-
statPtr->st_size = ((Tcl_WideInt) data.nFileSizeLow) |
(((Tcl_WideInt) data.nFileSizeHigh) << 32);
- statPtr->st_atime = ToCTime(data.ftLastAccessTime);
- statPtr->st_mtime = ToCTime(data.ftLastWriteTime);
- statPtr->st_ctime = ToCTime(data.ftCreationTime);
/*
* On Unix, for directories, nlink apparently depends on the number of
@@ -2036,6 +2054,13 @@ NativeStat(
dev = NativeDev(nativePath);
mode = NativeStatMode(attr, checkLinks, NativeIsExec(nativePath));
+ if (fileType == FILE_TYPE_CHAR) {
+ mode &= ~S_IFMT;
+ mode |= S_IFCHR;
+ } else if (fileType == FILE_TYPE_DISK) {
+ mode &= ~S_IFMT;
+ mode |= S_IFBLK;
+ }
statPtr->st_dev = (dev_t) dev;
statPtr->st_ino = inode;
@@ -3109,6 +3134,68 @@ TclpUtime(
}
/*
+ *---------------------------------------------------------------------------
+ *
+ * TclWinFileOwned --
+ *
+ * Returns 1 if the specified file exists and is owned by the current
+ * user and 0 otherwise. Like the Unix case, the check is made using
+ * the real process SID, not the effective (impersonation) one.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+TclWinFileOwned(
+ Tcl_Obj *pathPtr) /* File whose ownership is to be checked */
+{
+ const TCHAR *native;
+ PSID ownerSid = NULL;
+ PSECURITY_DESCRIPTOR secd = NULL;
+ HANDLE token;
+ LPBYTE buf = NULL;
+ DWORD bufsz;
+ int owned = 0;
+
+ native = Tcl_FSGetNativePath(pathPtr);
+
+ if (GetNamedSecurityInfo((LPTSTR) native, SE_FILE_OBJECT,
+ OWNER_SECURITY_INFORMATION, &ownerSid,
+ NULL, NULL, NULL, &secd) != ERROR_SUCCESS) {
+ /* Either not a file, or we do not have access to it in which
+ case we are in all likelihood not the owner */
+ return 0;
+ }
+
+ /*
+ * Getting the current process SID is a multi-step process.
+ * We make the assumption that if a call fails, this process is
+ * so underprivileged it could not possibly own anything. Normally
+ * a process can *always* look up its own token.
+ */
+ if (OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, &token)) {
+ /* Find out how big the buffer needs to be */
+ bufsz = 0;
+ GetTokenInformation(token, TokenUser, NULL, 0, &bufsz);
+ if (bufsz) {
+ buf = ckalloc(bufsz);
+ if (GetTokenInformation(token, TokenUser, buf, bufsz, &bufsz)) {
+ owned = EqualSid(ownerSid, ((PTOKEN_USER) buf)->User.Sid);
+ }
+ }
+ CloseHandle(token);
+ }
+
+ /* Free allocations and be done */
+ if (secd)
+ LocalFree(secd); /* Also frees ownerSid */
+ if (buf)
+ ckfree(buf);
+
+ return (owned != 0); /* Convert non-0 to 1 */
+}
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index 3eb9814..a583a65 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -448,14 +448,14 @@ ToUtf(
/* Low surrogate */
dst[3] = (char) ((ch | 0x80) & 0xBF);
dst[2] |= (char) (((ch >> 6) | 0x80) & 0x8F);
- dst += 4;
+ dst += 4;
} else {
/* High surrogate */
ch += 0x40;
dst[2] = (char) (((ch << 4) | 0x80) & 0xB0);
dst[1] = (char) (((ch >> 2) | 0x80) & 0xBF);
dst[0] = (char) (((ch >> 8) | 0xF0) & 0xF7);
- /* dst not incremented! */
+ /* dst not incremented! */
}
} else {
dst += Tcl_UniCharToUtf(ch, dst);
diff --git a/win/tclWinInt.h b/win/tclWinInt.h
index 9df424f..6b098f8 100644
--- a/win/tclWinInt.h
+++ b/win/tclWinInt.h
@@ -72,6 +72,7 @@ MODULE_SCOPE int TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
const TCHAR *LinkCopy);
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 *);
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index ea4035b..4543b02 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -50,7 +50,7 @@ static Tcl_ThreadDataKey dataKey;
*/
static int notifierCount = 0;
-static const TCHAR className[] = TEXT("TclNotifier");
+static const TCHAR classname[] = TEXT("TclNotifier");
TCL_DECLARE_MUTEX(notifierMutex)
/*
@@ -98,7 +98,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;
@@ -186,7 +186,7 @@ Tcl_FinalizeNotifier(
Tcl_MutexLock(&notifierMutex);
notifierCount--;
if (notifierCount == 0) {
- UnregisterClass(className, TclWinGetTclInstance());
+ UnregisterClass(classname, TclWinGetTclInstance());
}
Tcl_MutexUnlock(&notifierMutex);
}
@@ -350,7 +350,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/tclWinPipe.c b/win/tclWinPipe.c
index aff8836..382addd 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -897,7 +897,7 @@ TclpGetPid(
*
* The complete Windows search path is searched to find the specified
* executable. If an executable by the given name is not found,
- * automatically tries appending ".com", ".exe", and ".bat" to the
+ * automatically tries appending standard extensions to the
* executable name.
*
* Results:
@@ -1292,7 +1292,7 @@ ApplicationType(
Tcl_DString nameBuf, ds;
const TCHAR *nativeName;
TCHAR nativeFullPath[MAX_PATH];
- static const char extensions[][5] = {"", ".com", ".exe", ".bat"};
+ static const char extensions[][5] = {"", ".com", ".exe", ".bat", ".cmd"};
/*
* Look for the program as an external program. First try the name as it
@@ -1337,7 +1337,8 @@ ApplicationType(
Tcl_DStringFree(&ds);
ext = strrchr(fullName, '.');
- if ((ext != NULL) && (strcasecmp(ext, ".bat") == 0)) {
+ if ((ext != NULL) &&
+ (strcasecmp(ext, ".cmd") == 0 || strcasecmp(ext, ".bat") == 0)) {
applType = APPL_DOS;
break;
}
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index ca6b2bf..b486466 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -360,6 +360,20 @@ typedef DWORD_PTR * PDWORD_PTR;
# define S_IFLNK 0120000 /* Symbolic Link */
#endif
+/*
+ * Windows compilers do not define S_IFBLK. However, Tcl uses it in
+ * GetTypeFromMode to identify blockSpecial devices based on the
+ * value in the statsbuf st_mode field. We have no other way to pass this
+ * from NativeStat on Windows so are forced to define it here.
+ * The definition here is essentially what is seen on Linux and MingW.
+ * XXX - the root problem is Tcl using Unix definitions instead of
+ * abstracting the structure into a platform independent one. Sigh - perhaps
+ * Tcl 9
+ */
+#ifndef S_IFBLK
+# define S_IFBLK (S_IFDIR | S_IFCHR)
+#endif
+
#ifndef S_ISREG
# ifdef S_IFREG
# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG)
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index cc77afe..da2e60a 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -62,6 +62,15 @@
#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.
@@ -81,7 +90,7 @@
*/
static int initialized = 0;
-static const TCHAR className[] = TEXT("TclSocket");
+static const TCHAR classname[] = TEXT("TclSocket");
TCL_DECLARE_MUTEX(socketMutex)
/*
@@ -2327,7 +2336,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;
@@ -2457,7 +2466,7 @@ SocketExitHandler(
*/
TclpFinalizeSockets();
- UnregisterClass(className, TclWinGetTclInstance());
+ UnregisterClass(classname, TclWinGetTclInstance());
initialized = 0;
Tcl_MutexUnlock(&socketMutex);
}
@@ -2983,7 +2992,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);
/*
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 3394ec2..ffa6a1c 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -29,7 +29,10 @@ _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask
*/
static CRITICAL_SECTION masterLock;
-static int initialized = 0;
+static int init = 0;
+#define MASTER_LOCK TclpMasterLock()
+#define MASTER_UNLOCK TclpMasterUnlock()
+
/*
* This is the master lock used to serialize initialization and finalization
@@ -354,7 +357,7 @@ Tcl_GetCurrentThread(void)
void
TclpInitLock(void)
{
- if (!initialized) {
+ if (!init) {
/*
* There is a fundamental race here that is solved by creating the
* first Tcl interpreter in a single threaded environment. Once the
@@ -362,7 +365,7 @@ TclpInitLock(void)
* that create interpreters in parallel.
*/
- initialized = 1;
+ init = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
@@ -416,7 +419,7 @@ TclpInitUnlock(void)
void
TclpMasterLock(void)
{
- if (!initialized) {
+ if (!init) {
/*
* There is a fundamental race here that is solved by creating the
* first Tcl interpreter in a single threaded environment. Once the
@@ -424,7 +427,7 @@ TclpMasterLock(void)
* that create interpreters in parallel.
*/
- initialized = 1;
+ init = 1;
InitializeCriticalSection(&joinLock);
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
@@ -509,7 +512,7 @@ Tcl_GetAllocMutex(void)
void
TclFinalizeLock(void)
{
- TclpMasterLock();
+ MASTER_LOCK;
DeleteCriticalSection(&joinLock);
/*
@@ -517,7 +520,7 @@ TclFinalizeLock(void)
*/
DeleteCriticalSection(&masterLock);
- initialized = 0;
+ init = 0;
#ifdef TCL_THREADS
if (allocOnce) {
@@ -564,7 +567,7 @@ Tcl_MutexLock(
CRITICAL_SECTION *csPtr;
if (*mutexPtr == NULL) {
- TclpMasterLock();
+ MASTER_LOCK;
/*
* Double inside master lock check to avoid a race.
@@ -576,7 +579,7 @@ Tcl_MutexLock(
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
}
- TclpMasterUnlock();
+ MASTER_UNLOCK;
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
EnterCriticalSection(csPtr);
@@ -678,7 +681,7 @@ Tcl_ConditionWait(
*/
if (tsdPtr->flags == WIN_THREAD_UNINIT) {
- TclpMasterLock();
+ MASTER_LOCK;
/*
* Create the per-thread event and queue pointers.
@@ -692,7 +695,7 @@ Tcl_ConditionWait(
tsdPtr->flags = WIN_THREAD_RUNNING;
doExit = 1;
}
- TclpMasterUnlock();
+ MASTER_UNLOCK;
if (doExit) {
/*
@@ -707,7 +710,7 @@ Tcl_ConditionWait(
}
if (*condPtr == NULL) {
- TclpMasterLock();
+ MASTER_LOCK;
/*
* Initialize the per-condition queue pointers and Mutex.
@@ -721,7 +724,7 @@ Tcl_ConditionWait(
*condPtr = (Tcl_Condition) winCondPtr;
TclRememberCondition(condPtr);
}
- TclpMasterUnlock();
+ MASTER_UNLOCK;
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
winCondPtr = *((WinCondition **)condPtr);