From 2db2dfd35e31ce264948ce805c95046062ff5ccd Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 13:23:21 +0000 Subject: Start RC branch for Tcl 8.6.6 --- README | 2 +- generic/tcl.h | 4 ++-- library/init.tcl | 2 +- unix/configure | 2 +- unix/configure.in | 2 +- unix/tcl.spec | 2 +- win/configure | 2 +- win/configure.in | 2 +- 8 files changed, 9 insertions(+), 9 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/generic/tcl.h b/generic/tcl.h index 3490049..3037ceb 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" /* *---------------------------------------------------------------------------- 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/unix/configure b/unix/configure index 2e774f7..38c3f9a 100755 --- a/unix/configure +++ b/unix/configure @@ -1335,7 +1335,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=8.6 TCL_MAJOR_VERSION=8 TCL_MINOR_VERSION=6 -TCL_PATCH_LEVEL=".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 5d4cfbe..1d86213 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/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/win/configure b/win/configure index 2336111..e8e4b87 100755 --- a/win/configure +++ b/win/configure @@ -1311,7 +1311,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 a72b993..8bb9c48 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 -- cgit v0.12 From 2707284613f1df3c587790ac8a2757dc8592db63 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 16:24:35 +0000 Subject: Dup test name. Bump to TclOO 1.0.5. --- generic/tclOO.h | 2 +- tests/info.test | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) 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/tests/info.test b/tests/info.test index e0fddb3..c4fd379 100644 --- a/tests/info.test +++ b/tests/info.test @@ -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] } -- cgit v0.12 From 5fce2d6fcdbb4dcfaf883bece8154b866450c010 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 12 Jul 2016 16:46:08 +0000 Subject: tzdata2016f --- library/tzdata/America/Cambridge_Bay | 2 +- library/tzdata/America/Inuvik | 2 +- library/tzdata/America/Iqaluit | 2 +- library/tzdata/America/Pangnirtung | 2 +- library/tzdata/America/Rankin_Inlet | 2 +- library/tzdata/America/Resolute | 2 +- library/tzdata/America/Yellowknife | 2 +- library/tzdata/Antarctica/Casey | 2 +- library/tzdata/Antarctica/Davis | 4 +- library/tzdata/Antarctica/DumontDUrville | 4 +- library/tzdata/Antarctica/Macquarie | 4 +- library/tzdata/Antarctica/Mawson | 2 +- library/tzdata/Antarctica/Palmer | 2 +- library/tzdata/Antarctica/Rothera | 2 +- library/tzdata/Antarctica/Syowa | 2 +- library/tzdata/Antarctica/Troll | 2 +- library/tzdata/Antarctica/Vostok | 2 +- library/tzdata/Asia/Baku | 2 +- library/tzdata/Asia/Novokuznetsk | 133 +++++++++++++++--------------- library/tzdata/Asia/Novosibirsk | 135 ++++++++++++++++--------------- library/tzdata/Europe/Minsk | 6 +- library/tzdata/Indian/Kerguelen | 2 +- 22 files changed, 159 insertions(+), 159 deletions(-) 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/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/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 --- 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/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/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} } -- cgit v0.12 From fa9c51579645df87feccb20a43ac952d79e2e0c9 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 21 Jul 2016 16:20:38 +0000 Subject: Update changes file. --- changes | 74 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 74 insertions(+) diff --git a/changes b/changes index 1e24269..2ba6d42 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, August ?, 2016 --- http://core.tcl.tk/tcl/ for details -- cgit v0.12 From 6239155e85e232727ff14b9f2a6992158ca5a781 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 22 Jul 2016 14:00:01 +0000 Subject: Set release date --- changes | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/changes b/changes index 2ba6d42..034380b 100644 --- a/changes +++ b/changes @@ -8697,4 +8697,4 @@ improvements to regexp engine from Postgres (lane,porter,fellows,seltenreich) 2016-07-20 tzdata updated to Olson's tzdata2016f (venkat) ---- Released 8.6.6, August ?, 2016 --- http://core.tcl.tk/tcl/ for details +--- Released 8.6.6, July 27, 2016 --- http://core.tcl.tk/tcl/ for details -- cgit v0.12 From 7b960b4cdbdb05dd87c12eff280e839eace1cd54 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 22 Jul 2016 15:28:50 +0000 Subject: test repairs --- tests/chanio.test | 2 -- tests/info.test | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/tests/chanio.test b/tests/chanio.test index 29f42c3..9a27233 100644 --- a/tests/chanio.test +++ b/tests/chanio.test @@ -6790,8 +6790,6 @@ test chan-io-52.11 {TclCopyChannel & encodings} -setup { chan close $in chan close $out file size $path(kyrillic.txt) -} -cleanup { - file delete $path(utf8-fcopy.txt) } -result 3 test chan-io-53.1 {CopyData} -setup { diff --git a/tests/info.test b/tests/info.test index c4fd379..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 {} {} -- cgit v0.12 From a6063330c474dde9b388bfeda1b1bb746aebf23a Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 26 Aug 2016 13:46:37 +0000 Subject: Merge dup-removal into search loop so we avoid pre-processing efforts on data that are never used. Contributed patch from Brian Griffin. --- library/auto.tcl | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/library/auto.tcl b/library/auto.tcl index 02edcc4..97ea8af 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -122,11 +122,9 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { # uniquify $dirs in order array set seen {} foreach i $dirs { - # Take note that the [file normalize] below has been noted to cause - # difficulties for the freewrap utility. See Bug 1072136. Until - # freewrap resolves the matter, one might work around the problem by - # disabling that branch. + # Make sure $i is unique under normalization. Avoid repeated [source]. if {[interp issafe]} { + # Safe interps have no [file normalize]. set norm $i } else { set norm [file normalize $i] @@ -135,10 +133,7 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} { continue } set seen($norm) {} - lappend uniqdirs $i - } - set dirs $uniqdirs - foreach i $dirs { + set the_library $i set file [file join $i $initScript] -- cgit v0.12 From d84492f3906d20d05b547a4fa90286fe0a59bb37 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 30 Aug 2016 13:00:32 +0000 Subject: Don't ever allow UTF-8 sequences of more than 4 characters to be generated or parsed, even when TCL_UTF_MAX>4: According to current Unicode standard, a byte string of >4 characters can never form a single UTF-8 character. And a few minor micro-optimizations related to UTF-8 handling. --- generic/tclUtf.c | 68 ++++++++++++++++++++------------------------------------ 1 file changed, 24 insertions(+), 44 deletions(-) diff --git a/generic/tclUtf.c b/generic/tclUtf.c index b878149..68119a4 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -73,16 +73,7 @@ static const unsigned char totalBytes[256] = { #else 1,1,1,1,1,1,1,1, #endif -#if TCL_UTF_MAX > 4 - 5,5,5,5, -#else - 1,1,1,1, -#endif -#if TCL_UTF_MAX > 5 - 6,6,6,6 -#else - 1,1,1,1 -#endif + 1,1,1,1,1,1,1,1 }; /* @@ -111,14 +102,14 @@ INLINE static int UtfCount( int ch) /* The Tcl_UniChar whose size is returned. */ { - if ((ch > 0) && (ch < UNICODE_SELF)) { + if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) { return 1; } if (ch <= 0x7FF) { return 2; } #if TCL_UTF_MAX > 3 - if ((ch > 0xFFFF) && (ch <= 0x10FFFF)) { + if (((unsigned)(ch - 0x10000) <= 0xfffff)) { return 4; } #endif @@ -152,7 +143,7 @@ Tcl_UniCharToUtf( * large enough to hold the UTF-8 character * (at most TCL_UTF_MAX bytes). */ { - if ((ch > 0) && (ch < UNICODE_SELF)) { + if ((unsigned)(ch - 1) < (UNICODE_SELF - 1)) { buf[0] = (char) ch; return 1; } @@ -180,11 +171,7 @@ Tcl_UniCharToUtf( } } #endif - three: - buf[2] = (char) ((ch | 0x80) & 0xBF); - buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF); - buf[0] = (char) ((ch >> 12) | 0xE0); - return 3; + goto three; } #if TCL_UTF_MAX > 3 @@ -199,7 +186,11 @@ Tcl_UniCharToUtf( } ch = 0xFFFD; - goto three; +three: + buf[2] = (char) ((ch | 0x80) & 0xBF); + buf[1] = (char) (((ch >> 6) | 0x80) & 0xBF); + buf[0] = (char) ((ch >> 12) | 0xE0); + return 3; } /* @@ -314,9 +305,6 @@ Tcl_UtfToUniChar( * A two-byte-character lead-byte not followed by trail-byte * represents itself. */ - - *chPtr = (Tcl_UniChar) byte; - return 1; } else if (byte < 0xF0) { if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80)) { /* @@ -332,31 +320,23 @@ Tcl_UtfToUniChar( * A three-byte-character lead-byte not followed by two trail-bytes * represents itself. */ - - *chPtr = (Tcl_UniChar) byte; - return 1; } #if TCL_UTF_MAX > 3 - { - int ch, total, trail; - - total = totalBytes[byte]; - trail = total - 1; - if (trail > 0) { - ch = byte & (0x3F >> trail); - do { - src++; - if ((*src & 0xC0) != 0x80) { - *chPtr = byte; - return 1; - } - ch <<= 6; - ch |= (*src & 0x3F); - trail--; - } while (trail > 0); - *chPtr = ch; - return total; + else if (byte < 0xF8) { + if (((src[1] & 0xC0) == 0x80) && ((src[2] & 0xC0) == 0x80) && ((src[3] & 0xC0) == 0x80)) { + /* + * Four-byte-character lead byte followed by three trail bytes. + */ + + *chPtr = (Tcl_UniChar) (((byte & 0x0E) << 18) | ((src[1] & 0x3F) << 12) + | ((src[2] & 0x3F) << 6) | (src[3] & 0x3F)); + return 4; } + + /* + * A three-byte-character lead-byte not followed by two trail-bytes + * represents itself. + */ } #endif -- cgit v0.12 From 68caa10ca3562292a830860aaa37289795fe68b7 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 2 Sep 2016 12:11:01 +0000 Subject: Proposed patch for [d4e7780ca1681cd095dbd81fe264feff75c988f7|d4e7780ca1], by Gustaf Neumann --- generic/tclCompExpr.c | 2 +- generic/tclCompile.c | 16 ++++-- generic/tclCompile.h | 5 +- generic/tclEnsemble.c | 9 +++- generic/tclInt.h | 10 ++-- generic/tclLiteral.c | 33 ++++++++---- generic/tclNamesp.c | 3 ++ generic/tclObj.c | 9 +++- generic/tclTest.c | 104 ++++++++++++++++++++++++++++++------- tests/resolver.test | 141 ++++++++++++++++++++++++++++++++++++++++++++++---- 10 files changed, 279 insertions(+), 53 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 4390282..ab5e8af 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2272,7 +2272,7 @@ CompileExprTree( Tcl_DStringAppend(&cmdName, p, length); TclEmitPush(TclRegisterNewCmdLiteral(envPtr, Tcl_DStringValue(&cmdName), - Tcl_DStringLength(&cmdName)), envPtr); + Tcl_DStringLength(&cmdName), 0), envPtr); Tcl_DStringFree(&cmdName); /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index c0203dd..4e4ead6 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1781,10 +1781,20 @@ CompileCmdLiteral( CompileEnv *envPtr) { int numBytes; - const char *bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); - int cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes); - Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + const char *bytes; + Command *cmdPtr; + int cmdLitIdx, extraLiteralFlags = 0; + + cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); + if (cmdPtr != NULL) { + if ((cmdPtr->flags & CMD_VIA_RESOLVER)) { + extraLiteralFlags = LITERAL_UNSHARED; + } + } + bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); + cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes, extraLiteralFlags); + if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index d5bc86b..fa76f83 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1208,6 +1208,7 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, #define LITERAL_ON_HEAP 0x01 #define LITERAL_CMD_NAME 0x02 +#define LITERAL_UNSHARED 0x04 /* * Form of TclRegisterLiteral with flags == 0. In that case, it is safe to @@ -1229,8 +1230,8 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * int length); */ -#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \ - TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME) +#define TclRegisterNewCmdLiteral(envPtr, bytes, length, extraLiteralFlags) \ + TclRegisterLiteral(envPtr, (char *)(bytes), length, ((extraLiteralFlags)|LITERAL_CMD_NAME)) /* * Macro used to manually adjust the stack requirements; used in cases where diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 8e5e410..22c475f 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3306,7 +3306,7 @@ CompileToInvokedCommand( Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; char *bytes; - int length, i, numWords, cmdLit; + int length, i, numWords, cmdLit, extraLiteralFlags = 0; DefineLineInformation; /* @@ -3349,7 +3349,12 @@ CompileToInvokedCommand( objPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); - cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length); + if (cmdPtr != NULL) { + if ((cmdPtr->flags & CMD_VIA_RESOLVER)) { + extraLiteralFlags = LITERAL_UNSHARED; + } + } + cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length, extraLiteralFlags); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); diff --git a/generic/tclInt.h b/generic/tclInt.h index 4f7ea6e..4d3c0b1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1677,11 +1677,13 @@ typedef struct Command { * (these last two flags are defined in tcl.h) */ -#define CMD_IS_DELETED 0x1 -#define CMD_TRACE_ACTIVE 0x2 -#define CMD_HAS_EXEC_TRACES 0x4 -#define CMD_COMPILES_EXPANDED 0x8 +#define CMD_IS_DELETED 0x01 +#define CMD_TRACE_ACTIVE 0x02 +#define CMD_HAS_EXEC_TRACES 0x04 +#define CMD_COMPILES_EXPANDED 0x08 #define CMD_REDEF_IN_PROGRESS 0x10 +#define CMD_VIA_RESOLVER 0x20 + /* *---------------------------------------------------------------- diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 03200ca..864d050 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -214,15 +214,16 @@ TclCreateLiteral( if (globalPtrPtr) { *globalPtrPtr = globalPtr; } - if (flags & LITERAL_ON_HEAP) { + if ((flags & LITERAL_ON_HEAP)) { ckfree(bytes); } globalPtr->refCount++; return objPtr; } } + if (!newPtr) { - if (flags & LITERAL_ON_HEAP) { + if ((flags & LITERAL_ON_HEAP)) { ckfree(bytes); } return NULL; @@ -235,13 +236,24 @@ TclCreateLiteral( TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); - if (flags & LITERAL_ON_HEAP) { + if ((flags & LITERAL_ON_HEAP)) { objPtr->bytes = bytes; objPtr->length = length; } else { TclInitStringRep(objPtr, bytes, length); } + if ((flags & LITERAL_UNSHARED)) { + /* + * Make clear, that no global value is returned + */ + if (globalPtrPtr != NULL) { + *globalPtrPtr = NULL; + } + /*fprintf(stderr, "UNSHARED LITERAL <%s>\n", bytes);*/ + return objPtr; + } + #ifdef TCL_COMPILE_DEBUG if (LookupLiteralEntry((Tcl_Interp *) iPtr, objPtr) != NULL) { Tcl_Panic("%s: literal \"%.*s\" found globally but shouldn't be", @@ -417,7 +429,7 @@ TclRegisterLiteral( * the namespace as the interp's global NS. */ - if (flags & LITERAL_CMD_NAME) { + if ((flags & LITERAL_CMD_NAME)) { if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) { nsPtr = iPtr->globalNsPtr; } else { @@ -426,17 +438,17 @@ TclRegisterLiteral( } else { nsPtr = NULL; } - + /* * Is it in the interpreter's global literal table? If not, create it. */ - + globalPtr = NULL; objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags, &globalPtr); objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr->refCount < 1) { + if (globalPtr != NULL && globalPtr->refCount < 1) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); @@ -1155,9 +1167,10 @@ TclVerifyLocalLiteralTable( if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" is not global", - "TclVerifyLocalLiteralTable", - (length>60? 60 : length), bytes); + //Tcl_Panic("%s: local literal \"%.*s\" is not global", + // "TclVerifyLocalLiteralTable", + // (length>60? 60 : length), bytes); + /*fprintf(stderr, "local literal \"%s\" is not global\n",bytes);*/ } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 5930859..a8d351f 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -2566,7 +2566,9 @@ Tcl_FindCommand( } if (result == TCL_OK) { + ((Command *)cmd)->flags |= CMD_VIA_RESOLVER; return cmd; + } else if (result != TCL_CONTINUE) { return NULL; } @@ -2658,6 +2660,7 @@ Tcl_FindCommand( } if (cmdPtr != NULL) { + cmdPtr->flags &= ~CMD_VIA_RESOLVER; return (Tcl_Command) cmdPtr; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 628c3a7..661ab48 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4219,7 +4219,10 @@ TclSetCmdNameObj( const char *name; if (objPtr->typePtr == &tclCmdNameType) { - return; + resPtr = objPtr->internalRep.twoPtrValue.ptr1; + if (resPtr->cmdPtr == cmdPtr) { + return; + } } cmdPtr->refCount++; @@ -4397,7 +4400,9 @@ SetCmdNameFromAny( cmdPtr->refCount++; resPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) - && resPtr && (resPtr->refCount == 1)) { + && resPtr != NULL + && (resPtr->refCount == 1) + ) { /* * Reuse the old ResolvedCmdName struct instead of freeing it */ diff --git a/generic/tclTest.c b/generic/tclTest.c index e33d263..522e966 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7295,29 +7295,88 @@ InterpCmdResolver( int flags, Tcl_Command *rPtr) { - Interp *iPtr = (Interp *) interp; - CallFrame *varFramePtr = iPtr->varFramePtr; - Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? - varFramePtr->procPtr : NULL; - Namespace *ns2NsPtr = (Namespace *) - Tcl_FindNamespace(interp, "::ns2", NULL, 0); - - if (procPtr && (procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr - || (ns2NsPtr && procPtr->cmdPtr->nsPtr == ns2NsPtr))) { - const char *callingCmdName = + Interp *iPtr = (Interp *) interp; + CallFrame *varFramePtr = iPtr->varFramePtr; + Proc *procPtr = (varFramePtr->isProcCallFrame & FRAME_IS_PROC) ? varFramePtr->procPtr : NULL; + Namespace *callerNsPtr = varFramePtr->nsPtr; + Tcl_Command resolvedCmdPtr = NULL; + + /* + * Just do something special on a cmd literal "z" in two cases: + * A) when the caller is a proc "x", and the proc is either in "::" or in "::ns2". + * B) the caller's namespace is "ctx1" or "ctx2" + */ + if ( (name[0] == 'z') && (name[1] == '\0') ) { + Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); + + if (procPtr != NULL + && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) + || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) + ) + ) { + /* + * Case A) + * + * - The context, in which this resolver becomes active, is + * determined by the name of the caller proc, which has to be + * named "x". + * + * - To determine the name of the caller proc, the proc is taken + * from the topmost stack frame. + * + * - Note that the context is NOT provided during byte-code + * compilation (e.g. in TclProcCompileProc) + * + * When these conditions hold, this function resolves the + * passed-in cmd literal into a cmd "y", which is taken from the + * the global namespace (for simplicity). + */ + + const char *callingCmdName = Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); + + if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { + resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); + } + } else if (callerNsPtr != NULL) { + /* + * Case B) + * + * - The context, in which this resolver becomes active, is + * determined by the name of the parent namespace, which has + * to be named "ctx1" or "ctx2". + * + * - To determine the name of the parent namesace, it is taken + * from the 2nd highest stack frame. + * + * - Note that the context can be provided during byte-code + * compilation (e.g. in TclProcCompileProc) + * + * When these conditions hold, this function resolves the + * passed-in cmd literal into a cmd "y" or "Y" depending on the + * context. The resolved procs are taken from the the global + * namespace (for simplicity). + */ - if ((callingCmdName[0] == 'x') && (callingCmdName[1] == '\0') - && (name[0] == 'z') && (name[1] == '\0')) { - Tcl_Command sourceCmdPtr = Tcl_FindCommand(interp, "y", NULL, - TCL_GLOBAL_ONLY); + CallFrame *parentFramePtr = varFramePtr->callerPtr; + char *context = parentFramePtr != NULL ? parentFramePtr->nsPtr->name : "(NULL)"; - if (sourceCmdPtr != NULL) { - *rPtr = sourceCmdPtr; - return TCL_OK; + if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { + resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); + /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ + + } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { + resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); + /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ } } + + if (resolvedCmdPtr != NULL) { + *rPtr = resolvedCmdPtr; + return TCL_OK; + } } + return TCL_CONTINUE; } @@ -7449,10 +7508,17 @@ TestInterpResolverCmd( int idx; #define RESOLVER_KEY "testInterpResolver" - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "up|down"); + if (objc < 2 || objc >3) { + Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?"); return TCL_ERROR; } + if (objc == 3) { + interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2])); + if (interp == NULL) { + Tcl_AppendResult(interp, "provided interpreter not found", NULL); + return TCL_ERROR; + } + } if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, &idx) != TCL_OK) { return TCL_ERROR; diff --git a/tests/resolver.test b/tests/resolver.test index f3d22e5..01e2e0b 100644 --- a/tests/resolver.test +++ b/tests/resolver.test @@ -38,10 +38,12 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup # is turned into a command literal shared for a given (here: the global) # namespace. set r0 [x]; # --> The result of [x] is "Y" + # 2) After having requested cmd resolution above, we can now use the # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is # certainly questionable, but defensible set r1 [z]; # --> The result of [z] is "Y" + # 3) We import from the namespace ns1 another z. [namespace import] takes # care "shadowed" cmd references, however, till now cmd literals have not # been touched. This is, however, necessary since the BC compiler (used in @@ -59,12 +61,12 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup rename ::y "" namespace delete ::ns1 } -result {Y Y Z} + + test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup { testinterpresolver up proc ::y {} { return Y } - proc ::x {} { - z - } + proc ::x {} { z } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] @@ -80,6 +82,8 @@ test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup { rename ::foo "" rename ::z "" } -result {Y Y Z} + + test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup { testinterpresolver up proc ::Z {} { return Z } @@ -101,6 +105,8 @@ test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup { rename ::y "" rename ::z "" } -result {Y Y Z} + + test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup { testinterpresolver up proc ::Z {} { return Z } @@ -123,6 +129,8 @@ test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup { rename ::y "" rename ::z "" } -result {Y Y Z} + + test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup { testinterpresolver up namespace eval ::ns1 { @@ -131,9 +139,7 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s } proc ::y {} { return Y } namespace eval ::ns2 { - proc x {} { - z - } + proc x {} { z } } namespace eval :: { variable r2 "" @@ -151,13 +157,13 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s namespace delete ::ns2 namespace delete ::ns1 } -result {Y Y Z} + + test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup { testinterpresolver up proc ::Z {} { return Z } proc ::y {} { return Y } - proc ::x {} { - z - } + proc ::x {} { z } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] @@ -187,7 +193,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup { # During the compilation the compiled var resolver, the resolve-specific # var info is allocated, during the execution of the body, the variable is # fetched and cached. - x; + x # During later calls, the cached variable is reused. x # When the proc is freed, the resolver-specific resolver var info is @@ -196,6 +202,121 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup { } -cleanup { testinterpresolver down } -result {} + + +# +# The test resolver-3.1* test bad interactions of resolvers on the "global" +# (per interp) literal pools. A resolver might resolve a cmd literal depending +# on a context differently, whereas the cmd literal sharing assumed that the +# namespace containing the literal solely determines the resolved cmd (and is +# resolver-agnostic). +# +# In order to make the test cases for the per-interpreter cmd literal pool +# reproducable and to minimize interactions between test cases, we use a slave +# interpreter per test-case. +# +# +# Testing resolver in namespace-based context "ctx1" +# +test resolver-3.1a { + interp command resolver, + resolve literal "z" in proc "x1" in context "ctx1" +} -setup { + + interp create i0 + testinterpresolver up i0 + i0 eval { + proc y {} { return yy } + namespace eval ::ns { + proc x1 {} { z } + } + } +} -constraints testinterpresolver -body { + + set r [i0 eval {namespace eval ::ctx1 { + ::ns::x1 + }}] + + return $r +} -cleanup { + testinterpresolver down i0 + interp delete i0 +} -result {yy} + +# +# Testing resolver in namespace-based context "ctx2" +# +test resolver-3.1b { + interp command resolver, + resolve literal "z" in proc "x2" in context "ctx2" +} -setup { + + interp create i0 + testinterpresolver up i0 + i0 eval { + proc Y {} { return YY } + namespace eval ::ns { + proc x2 {} { z } + } + } +} -constraints testinterpresolver -body { + + set r [i0 eval {namespace eval ::ctx2 { + ::ns::x2 + }}] + + return $r +} -cleanup { + testinterpresolver down i0 + interp delete i0 +} -result {YY} + +# +# Testing resolver in namespace-based context "ctx1" and "ctx2" in the same +# interpreter. +# + +test resolver-3.1c { + interp command resolver, + resolve literal "z" in proc "x1" in context "ctx1", + resolve literal "z" in proc "x2" in context "ctx2" + + Test, whether the shared cmd literal created by the first byte-code + compilation interacts with the second one. +} -setup { + + interp create i0 + testinterpresolver up i0 + + i0 eval { + proc y {} { return yy } + proc Y {} { return YY } + namespace eval ::ns { + proc x1 {} { z } + proc x2 {} { z } + } + } + +} -constraints testinterpresolver -body { + + set r1 [i0 eval {namespace eval ::ctx1 { + ::ns::x1 + }}] + + set r2 [i0 eval {namespace eval ::ctx2 { + ::ns::x2 + }}] + + set r3 [i0 eval {namespace eval ::ctx1 { + ::ns::x1 + }}] + + return [list $r1 $r2 $r3] +} -cleanup { + testinterpresolver down i0 + interp delete i0 +} -result {yy YY yy} + cleanupTests return -- cgit v0.12 From b41a44e3942c841677cdcf7cd46be77c5c27ab08 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Sep 2016 13:14:45 +0000 Subject: Some patch clean-up, no change in functionality --- generic/tclCompExpr.c | 2 +- generic/tclCompile.c | 4 ++-- generic/tclCompile.h | 4 ++-- generic/tclEnsemble.c | 2 +- generic/tclLiteral.c | 20 ++++++++------------ generic/tclTest.c | 18 +++++++++--------- tests/resolver.test | 26 ++++++++++---------------- 7 files changed, 33 insertions(+), 43 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index ab5e8af..4390282 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2272,7 +2272,7 @@ CompileExprTree( Tcl_DStringAppend(&cmdName, p, length); TclEmitPush(TclRegisterNewCmdLiteral(envPtr, Tcl_DStringValue(&cmdName), - Tcl_DStringLength(&cmdName), 0), envPtr); + Tcl_DStringLength(&cmdName)), envPtr); Tcl_DStringFree(&cmdName); /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 4e4ead6..ee36bff 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1793,8 +1793,8 @@ CompileCmdLiteral( } bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); - cmdLitIdx = TclRegisterNewCmdLiteral(envPtr, bytes, numBytes, extraLiteralFlags); - + cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags|LITERAL_CMD_NAME); + if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index fa76f83..ba6ad44 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1230,8 +1230,8 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, * int length); */ -#define TclRegisterNewCmdLiteral(envPtr, bytes, length, extraLiteralFlags) \ - TclRegisterLiteral(envPtr, (char *)(bytes), length, ((extraLiteralFlags)|LITERAL_CMD_NAME)) +#define TclRegisterNewCmdLiteral(envPtr, bytes, length) \ + TclRegisterLiteral(envPtr, (char *)(bytes), length, LITERAL_CMD_NAME) /* * Macro used to manually adjust the stack requirements; used in cases where diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 22c475f..67ee65e 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3354,7 +3354,7 @@ CompileToInvokedCommand( extraLiteralFlags = LITERAL_UNSHARED; } } - cmdLit = TclRegisterNewCmdLiteral(envPtr, bytes, length, extraLiteralFlags); + cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags|LITERAL_CMD_NAME); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 864d050..484b86b 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -214,16 +214,15 @@ TclCreateLiteral( if (globalPtrPtr) { *globalPtrPtr = globalPtr; } - if ((flags & LITERAL_ON_HEAP)) { + if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } globalPtr->refCount++; return objPtr; } } - if (!newPtr) { - if ((flags & LITERAL_ON_HEAP)) { + if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } return NULL; @@ -236,15 +235,15 @@ TclCreateLiteral( TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); - if ((flags & LITERAL_ON_HEAP)) { + if (flags & LITERAL_ON_HEAP) { objPtr->bytes = bytes; objPtr->length = length; } else { TclInitStringRep(objPtr, bytes, length); } - if ((flags & LITERAL_UNSHARED)) { - /* + if (flags & LITERAL_UNSHARED) { + /* * Make clear, that no global value is returned */ if (globalPtrPtr != NULL) { @@ -429,7 +428,7 @@ TclRegisterLiteral( * the namespace as the interp's global NS. */ - if ((flags & LITERAL_CMD_NAME)) { + if (flags & LITERAL_CMD_NAME) { if ((length >= 2) && (bytes[0] == ':') && (bytes[1] == ':')) { nsPtr = iPtr->globalNsPtr; } else { @@ -438,10 +437,11 @@ TclRegisterLiteral( } else { nsPtr = NULL; } - + /* * Is it in the interpreter's global literal table? If not, create it. */ + globalPtr = NULL; objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags, &globalPtr); @@ -1167,10 +1167,6 @@ TclVerifyLocalLiteralTable( if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); - //Tcl_Panic("%s: local literal \"%.*s\" is not global", - // "TclVerifyLocalLiteralTable", - // (length>60? 60 : length), bytes); - /*fprintf(stderr, "local literal \"%s\" is not global\n",bytes);*/ } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", diff --git a/generic/tclTest.c b/generic/tclTest.c index 522e966..1e595d6 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7308,21 +7308,21 @@ InterpCmdResolver( */ if ( (name[0] == 'z') && (name[1] == '\0') ) { Namespace *ns2NsPtr = (Namespace *) Tcl_FindNamespace(interp, "::ns2", NULL, 0); - + if (procPtr != NULL && ((procPtr->cmdPtr->nsPtr == iPtr->globalNsPtr) || (ns2NsPtr != NULL && procPtr->cmdPtr->nsPtr == ns2NsPtr) ) ) { /* - * Case A) + * Case A) * * - The context, in which this resolver becomes active, is * determined by the name of the caller proc, which has to be * named "x". * * - To determine the name of the caller proc, the proc is taken - * from the topmost stack frame. + * from the topmost stack frame. * * - Note that the context is NOT provided during byte-code * compilation (e.g. in TclProcCompileProc) @@ -7331,23 +7331,23 @@ InterpCmdResolver( * passed-in cmd literal into a cmd "y", which is taken from the * the global namespace (for simplicity). */ - + const char *callingCmdName = Tcl_GetCommandName(interp, (Tcl_Command) procPtr->cmdPtr); - + if ( callingCmdName[0] == 'x' && callingCmdName[1] == '\0' ) { resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); } } else if (callerNsPtr != NULL) { /* - * Case B) + * Case B) * * - The context, in which this resolver becomes active, is * determined by the name of the parent namespace, which has * to be named "ctx1" or "ctx2". * * - To determine the name of the parent namesace, it is taken - * from the 2nd highest stack frame. + * from the 2nd highest stack frame. * * - Note that the context can be provided during byte-code * compilation (e.g. in TclProcCompileProc) @@ -7364,13 +7364,13 @@ InterpCmdResolver( if (strcmp(context, "ctx1") == 0 && (name[0] == 'z') && (name[1] == '\0')) { resolvedCmdPtr = Tcl_FindCommand(interp, "y", NULL, TCL_GLOBAL_ONLY); /* fprintf(stderr, "... y ==> %p\n", resolvedCmdPtr);*/ - + } else if (strcmp(context, "ctx2") == 0 && (name[0] == 'z') && (name[1] == '\0')) { resolvedCmdPtr = Tcl_FindCommand(interp, "Y", NULL, TCL_GLOBAL_ONLY); /*fprintf(stderr, "... Y ==> %p\n", resolvedCmdPtr);*/ } } - + if (resolvedCmdPtr != NULL) { *rPtr = resolvedCmdPtr; return TCL_OK; diff --git a/tests/resolver.test b/tests/resolver.test index 01e2e0b..dc38ff0 100644 --- a/tests/resolver.test +++ b/tests/resolver.test @@ -38,12 +38,10 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup # is turned into a command literal shared for a given (here: the global) # namespace. set r0 [x]; # --> The result of [x] is "Y" - # 2) After having requested cmd resolution above, we can now use the # globally shared CmdName Tcl_Obj "z", now bound to cmd ::y. This is # certainly questionable, but defensible set r1 [z]; # --> The result of [z] is "Y" - # 3) We import from the namespace ns1 another z. [namespace import] takes # care "shadowed" cmd references, however, till now cmd literals have not # been touched. This is, however, necessary since the BC compiler (used in @@ -61,12 +59,12 @@ test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup rename ::y "" namespace delete ::ns1 } -result {Y Y Z} - - test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup { testinterpresolver up proc ::y {} { return Y } - proc ::x {} { z } + proc ::x {} { + z + } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] @@ -82,8 +80,6 @@ test resolver-1.2 {cmdNameObj sharing vs. cmd resolver: proc creation} -setup { rename ::foo "" rename ::z "" } -result {Y Y Z} - - test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup { testinterpresolver up proc ::Z {} { return Z } @@ -105,8 +101,6 @@ test resolver-1.3 {cmdNameObj sharing vs. cmd resolver: rename} -setup { rename ::y "" rename ::z "" } -result {Y Y Z} - - test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup { testinterpresolver up proc ::Z {} { return Z } @@ -129,8 +123,6 @@ test resolver-1.4 {cmdNameObj sharing vs. cmd resolver: interp expose} -setup { rename ::y "" rename ::z "" } -result {Y Y Z} - - test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -setup { testinterpresolver up namespace eval ::ns1 { @@ -139,7 +131,9 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s } proc ::y {} { return Y } namespace eval ::ns2 { - proc x {} { z } + proc x {} { + z + } } namespace eval :: { variable r2 "" @@ -157,13 +151,13 @@ test resolver-1.5 {cmdNameObj sharing vs. cmd resolver: other than global NS} -s namespace delete ::ns2 namespace delete ::ns1 } -result {Y Y Z} - - test resolver-1.6 {cmdNameObj sharing vs. cmd resolver: interp alias} -setup { testinterpresolver up proc ::Z {} { return Z } proc ::y {} { return Y } - proc ::x {} { z } + proc ::x {} { + z + } } -constraints testinterpresolver -body { set r0 [x] set r1 [z] @@ -193,7 +187,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup { # During the compilation the compiled var resolver, the resolve-specific # var info is allocated, during the execution of the body, the variable is # fetched and cached. - x + x; # During later calls, the cached variable is reused. x # When the proc is freed, the resolver-specific resolver var info is -- cgit v0.12 From 8dac135fc9c8efae2cc3113bc975ab871ff2271f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Sep 2016 13:55:00 +0000 Subject: Allow additional optional "interp" argument for testinterpresolver command. Not used yet in any test-case. Protect panic in tclLiteral.c for possible null-pointer access. (cherry-picked from Gustaf Neuman's interpresolver patch). Eliminate some unecessary spacing. --- generic/tclCmdAH.c | 2 +- generic/tclExecute.c | 2 +- generic/tclLiteral.c | 3 ++- generic/tclTest.c | 13 ++++++++++--- tests/resolver.test | 2 +- win/tclWinFile.c | 8 ++++---- win/tclWinPipe.c | 2 +- win/tclWinPort.h | 2 +- 8 files changed, 21 insertions(+), 13 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 88cc17d..4c299f8 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -1597,7 +1597,7 @@ FileAttrIsOwnedCmd( Tcl_Obj *const objv[]) { #ifdef __CYGWIN__ -#define geteuid() (short)(geteuid)() +#define geteuid() (short)(geteuid)() #endif #if !defined(_WIN32) Tcl_StatBuf buf; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index e539161..34d92d3 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3173,7 +3173,7 @@ TEBCresume( Tcl_Obj *copyPtr = Tcl_NewListObj(objc - opnd + 1, NULL); Tcl_ListObjAppendElement(NULL, copyPtr, objPtr); - Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, + Tcl_ListObjReplace(NULL, copyPtr, LIST_MAX, 0, objc - opnd, objv + opnd); Tcl_DecrRefCount(objPtr); objPtr = copyPtr; diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 03200ca..26c21db 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -431,12 +431,13 @@ TclRegisterLiteral( * Is it in the interpreter's global literal table? If not, create it. */ + globalPtr = NULL; objPtr = TclCreateLiteral(iPtr, bytes, length, hash, &new, nsPtr, flags, &globalPtr); objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr->refCount < 1) { + if (globalPtr != NULL && globalPtr->refCount < 1) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); diff --git a/generic/tclTest.c b/generic/tclTest.c index e33d263..b3508f1 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -7449,9 +7449,16 @@ TestInterpResolverCmd( int idx; #define RESOLVER_KEY "testInterpResolver" - if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "up|down"); - return TCL_ERROR; + if ((objc < 2) || (objc > 3)) { + Tcl_WrongNumArgs(interp, 1, objv, "up|down ?interp?"); + return TCL_ERROR; + } + if (objc == 3) { + interp = Tcl_GetSlave(interp, Tcl_GetString(objv[2])); + if (interp == NULL) { + Tcl_AppendResult(interp, "provided interpreter not found", NULL); + return TCL_ERROR; + } } if (Tcl_GetIndexFromObj(interp, objv[1], table, "operation", TCL_EXACT, &idx) != TCL_OK) { diff --git a/tests/resolver.test b/tests/resolver.test index f3d22e5..aaad02c 100644 --- a/tests/resolver.test +++ b/tests/resolver.test @@ -187,7 +187,7 @@ test resolver-2.1 {compiled var resolver: Bug #3383616} -setup { # During the compilation the compiled var resolver, the resolve-specific # var info is allocated, during the execution of the body, the variable is # fetched and cached. - x; + x # During later calls, the cached variable is reused. x # When the proc is freed, the resolver-specific resolver var info is diff --git a/win/tclWinFile.c b/win/tclWinFile.c index 4d7500b..6662327 100755 --- a/win/tclWinFile.c +++ b/win/tclWinFile.c @@ -3166,8 +3166,8 @@ TclWinFileOwned( 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 @@ -3191,10 +3191,10 @@ TclWinFileOwned( LocalFree(secd); /* Also frees ownerSid */ if (buf) ckfree(buf); - + return (owned != 0); /* Convert non-0 to 1 */ } - + /* * Local Variables: * mode: c diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 382addd..4666deb 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1337,7 +1337,7 @@ ApplicationType( Tcl_DStringFree(&ds); ext = strrchr(fullName, '.'); - if ((ext != NULL) && + 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 b486466..159a708 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -360,7 +360,7 @@ 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 -- cgit v0.12 From 2501ad1ea2dd8592c15e7f3bda1f9c298fa446a6 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 5 Sep 2016 14:52:01 +0000 Subject: some more clean-up --- generic/tclCompile.c | 10 ++++------ generic/tclEnsemble.c | 10 ++++------ generic/tclLiteral.c | 4 +++- generic/tclObj.c | 12 +++++------- 4 files changed, 16 insertions(+), 20 deletions(-) diff --git a/generic/tclCompile.c b/generic/tclCompile.c index ee36bff..f6b3c52 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1783,17 +1783,15 @@ CompileCmdLiteral( int numBytes; const char *bytes; Command *cmdPtr; - int cmdLitIdx, extraLiteralFlags = 0; + int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); - if (cmdPtr != NULL) { - if ((cmdPtr->flags & CMD_VIA_RESOLVER)) { - extraLiteralFlags = LITERAL_UNSHARED; - } + if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { + extraLiteralFlags |= LITERAL_UNSHARED; } bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); - cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags|LITERAL_CMD_NAME); + cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags); if (cmdPtr) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 67ee65e..6fedf29 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -3306,7 +3306,7 @@ CompileToInvokedCommand( Tcl_Token *tokPtr; Tcl_Obj *objPtr, **words; char *bytes; - int length, i, numWords, cmdLit, extraLiteralFlags = 0; + int length, i, numWords, cmdLit, extraLiteralFlags = LITERAL_CMD_NAME; DefineLineInformation; /* @@ -3349,12 +3349,10 @@ CompileToInvokedCommand( objPtr = Tcl_NewObj(); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); - if (cmdPtr != NULL) { - if ((cmdPtr->flags & CMD_VIA_RESOLVER)) { - extraLiteralFlags = LITERAL_UNSHARED; - } + if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { + extraLiteralFlags |= LITERAL_UNSHARED; } - cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags|LITERAL_CMD_NAME); + cmdLit = TclRegisterLiteral(envPtr, (char *)bytes, length, extraLiteralFlags); TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLit), cmdPtr); TclEmitPush(cmdLit, envPtr); TclDecrRefCount(objPtr); diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 484b86b..c329ed7 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -249,7 +249,6 @@ TclCreateLiteral( if (globalPtrPtr != NULL) { *globalPtrPtr = NULL; } - /*fprintf(stderr, "UNSHARED LITERAL <%s>\n", bytes);*/ return objPtr; } @@ -1167,6 +1166,9 @@ TclVerifyLocalLiteralTable( if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, localPtr->objPtr) == NULL) { bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); + Tcl_Panic("%s: local literal \"%.*s\" is not global", + "TclVerifyLocalLiteralTable", + (length>60? 60 : length), bytes); } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", diff --git a/generic/tclObj.c b/generic/tclObj.c index 661ab48..283c8d2 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4219,10 +4219,10 @@ TclSetCmdNameObj( const char *name; if (objPtr->typePtr == &tclCmdNameType) { - resPtr = objPtr->internalRep.twoPtrValue.ptr1; - if (resPtr->cmdPtr == cmdPtr) { - return; - } + resPtr = objPtr->internalRep.twoPtrValue.ptr1; + if (resPtr->cmdPtr == cmdPtr) { + return; + } } cmdPtr->refCount++; @@ -4400,9 +4400,7 @@ SetCmdNameFromAny( cmdPtr->refCount++; resPtr = objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr == &tclCmdNameType) - && resPtr != NULL - && (resPtr->refCount == 1) - ) { + && resPtr && (resPtr->refCount == 1)) { /* * Reuse the old ResolvedCmdName struct instead of freeing it */ -- cgit v0.12 From 2a4281604ab70d1943a74f592e151c6a203f0bdd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 6 Sep 2016 08:25:18 +0000 Subject: Additiona patch/suggestion from Gustaf. This indeed fixes the crash in oo.test. Looks good to me, so only waiting for final feedback from Gustaf and eventually feedback from other people. --- generic/tclLiteral.c | 7 ------- generic/tclObj.c | 2 +- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index c329ed7..6b3560d 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -1163,13 +1163,6 @@ TclVerifyLocalLiteralTable( "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } - if (LookupLiteralEntry((Tcl_Interp *) envPtr->iPtr, - localPtr->objPtr) == NULL) { - bytes = Tcl_GetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" is not global", - "TclVerifyLocalLiteralTable", - (length>60? 60 : length), bytes); - } if (localPtr->objPtr->bytes == NULL) { Tcl_Panic("%s: literal has NULL string rep", "TclVerifyLocalLiteralTable"); diff --git a/generic/tclObj.c b/generic/tclObj.c index 283c8d2..29c8e23 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4220,7 +4220,7 @@ TclSetCmdNameObj( if (objPtr->typePtr == &tclCmdNameType) { resPtr = objPtr->internalRep.twoPtrValue.ptr1; - if (resPtr->cmdPtr == cmdPtr) { + if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) { return; } } -- cgit v0.12 From 907e3ead5a3a2615c5721af947895bb4cacd3c99 Mon Sep 17 00:00:00 2001 From: dkf Date: Tue, 6 Sep 2016 10:44:45 +0000 Subject: Fixed bug in pushed transforms with full internal buffers not writing out. --- generic/tclZlib.c | 48 +++++++++++++++++++++++++++++++++--------------- tests/zlib.test | 23 +++++++++++++++++++++++ 2 files changed, 56 insertions(+), 15 deletions(-) diff --git a/generic/tclZlib.c b/generic/tclZlib.c index dac47cf..c9d7b88 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -2864,7 +2864,7 @@ ZlibTransformClose( Tcl_Interp *interp) { ZlibChannelData *cd = instanceData; - int e, result = TCL_OK; + int e, written, result = TCL_OK; /* * Delete the support timer. @@ -2882,6 +2882,17 @@ ZlibTransformClose( cd->outStream.next_out = (Bytef *) cd->outBuffer; cd->outStream.avail_out = (unsigned) cd->outAllocated; e = deflate(&cd->outStream, Z_FINISH); + written = cd->outAllocated - cd->outStream.avail_out; + + /* + * Can't be sure that deflate() won't declare the buffer to be + * full (with Z_BUF_ERROR) so handle that case. + */ + + if (e == Z_BUF_ERROR) { + e = Z_OK; + written = cd->outAllocated; + } if (e != Z_OK && e != Z_STREAM_END) { /* TODO: is this the right way to do errors on close? */ if (!TclInThreadExit()) { @@ -2890,20 +2901,17 @@ ZlibTransformClose( result = TCL_ERROR; break; } - if (cd->outStream.avail_out != (unsigned) cd->outAllocated) { - if (Tcl_WriteRaw(cd->parent, cd->outBuffer, - cd->outAllocated - cd->outStream.avail_out) < 0) { - /* TODO: is this the right way to do errors on close? - * Note: when close is called from FinalizeIOSubsystem - * then interp may be NULL */ - if (!TclInThreadExit() && interp) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "error while finalizing file: %s", - Tcl_PosixError(interp))); - } - result = TCL_ERROR; - break; + if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) < 0) { + /* TODO: is this the right way to do errors on close? + * Note: when close is called from FinalizeIOSubsystem then + * interp may be NULL */ + if (!TclInThreadExit() && interp) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "error while finalizing file: %s", + Tcl_PosixError(interp))); } + result = TCL_ERROR; + break; } } while (e != Z_STREAM_END); (void) deflateEnd(&cd->outStream); @@ -3084,7 +3092,17 @@ ZlibTransformOutput( e = deflate(&cd->outStream, Z_NO_FLUSH); produced = cd->outAllocated - cd->outStream.avail_out; - if (e == Z_OK && produced > 0) { + if ((e == Z_OK && produced > 0) || e == Z_BUF_ERROR) { + /* + * deflate() indicates that it is out of space by returning + * Z_BUF_ERROR; in that case, we must write the whole buffer out + * and retry to compress what is left. + */ + + if (e == Z_BUF_ERROR) { + produced = cd->outAllocated; + e = Z_OK; + } if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) < 0) { *errorCodePtr = Tcl_GetErrno(); return -1; diff --git a/tests/zlib.test b/tests/zlib.test index 8a040d8..15dbb34 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -917,6 +917,29 @@ test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup { } -cleanup { $stream close } -result {12026 18000} +test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup { + set filesrc [makeFile {} test.input] + set filedst [makeFile {} test.output] + set f [open $filesrc "wb"] + for {set i 0} {$i < 10000} {incr i} { + puts -nonewline $f "x" + } + close $f +} -body { + set fin [open $filesrc "rb"] + set fout [open $filedst "wb"] + set header [dict create filename "test.input" time 0] + try { + fcopy $fin [zlib push gzip $fout -header $header] + } finally { + close $fin + close $fout + } + file size $filedst +} -cleanup { + removeFile $filesrc + removeFile $filedst +} -result 4152 ::tcltest::cleanupTests return -- cgit v0.12 From a8ee2c14547d09ebb8f93ee3cea938302ea7a4c8 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 6 Sep 2016 20:30:07 +0000 Subject: [4dbdd9af14] Proposed fix for mem leak. --- generic/tclVar.c | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index bdc64b7..55eb91c 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4498,7 +4498,6 @@ TclDeleteNamespaceVars( Tcl_GetVariableFullName(interp, (Tcl_Var) varPtr, objPtr); UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags); - Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ /* * Remove the variable from the table and force it undefined in case @@ -4527,6 +4526,12 @@ TclDeleteNamespaceVars( } } } + + if (!TclIsVarUndefined(varPtr)) { + UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, + NULL, flags); + } + Tcl_DecrRefCount(objPtr); /* free no longer needed obj */ VarHashRefCount(varPtr)--; VarHashDeleteEntry(varPtr); } -- cgit v0.12 From a05766d3d315e7ecba48b10b3d24d98a7cd450df Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 7 Sep 2016 16:19:42 +0000 Subject: Improve the comments and add a test. --- generic/tclVar.c | 13 +++++++++++-- tests/var.test | 31 +++++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+), 2 deletions(-) diff --git a/generic/tclVar.c b/generic/tclVar.c index 55eb91c..e95307e 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -4500,8 +4500,12 @@ TclDeleteNamespaceVars( NULL, flags); /* - * Remove the variable from the table and force it undefined in case - * an unset trace brought it back from the dead. + * We just unset the variable. However, an unset trace might + * have re-set it, or might have re-established traces on it. + * This namespace and its vartable are going away unconditionally, + * so we cannot let such things linger. That would be a leak. + * + * First we destroy all traces. ... */ if (TclIsVarTraced(varPtr)) { @@ -4527,6 +4531,11 @@ TclDeleteNamespaceVars( } } + /* + * ...and then, if the variable still holds a value, we unset it + * again. This time with no traces left, we're sure it goes away. + */ + if (!TclIsVarUndefined(varPtr)) { UnsetVarStruct(varPtr, NULL, iPtr, /* part1 */ objPtr, NULL, flags); diff --git a/tests/var.test b/tests/var.test index c852ca9..30e340e 100644 --- a/tests/var.test +++ b/tests/var.test @@ -22,6 +22,21 @@ if {[lsearch [namespace children] ::tcltest] == -1} { testConstraint testupvar [llength [info commands testupvar]] testConstraint testgetvarfullname [llength [info commands testgetvarfullname]] testConstraint testsetnoerr [llength [info commands testsetnoerr]] +testConstraint memory [llength [info commands memory]] +if {[testConstraint memory]} { + proc getbytes {} { + return [lindex [split [memory info] \n] 3 3] + } + proc leaktest {script {iterations 3}} { + set end [getbytes] + for {set i 0} {$i < $iterations} {incr i} { + uplevel 1 $script + set tmp $end + set end [getbytes] + } + return [expr {$end - $tmp}] + } +} catch {rename p ""} catch {namespace delete test_ns_var} @@ -540,6 +555,22 @@ test var-8.2 {TclDeleteNamespaceVars, "unset" traces on ns delete are called wit list [namespace delete test_ns_var] $::info } {{} {::test_ns_var::v {} u}} +test var-8.3 {TclDeleteNamespaceVars, mem leak} -constraints memory -setup { + proc ::t {a i o} { + set $a 321 + } +} -body { + leaktest { + namespace eval n { + variable v 123 + trace variable v u ::t + } + namespace delete n + } +} -cleanup { + rename ::t {} +} -result 0 + test var-9.1 {behaviour of TclGet/SetVar simple get/set} testsetnoerr { catch {unset u}; catch {unset v} list \ -- cgit v0.12 From fc743498e7623e7cefbe124ef936d30de91e3625 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 7 Sep 2016 18:31:58 +0000 Subject: Attempt to fix [7f02ff1efa]. Make trace-18.1 fail. Suspect test is an experiment that preserves the bug. --- generic/tclNamesp.c | 20 +++++++------------- generic/tclVar.c | 49 +++++++++++++++++++++++++++++++++---------------- 2 files changed, 40 insertions(+), 29 deletions(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 7f6ecf5..74dfaf8 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -382,19 +382,6 @@ Tcl_PopCallFrame( register CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; - /* - * It's important to remove the call frame from the interpreter's stack of - * call frames before deleting local variables, so that traces invoked by - * the variable deletion don't see the partially-deleted frame. - */ - - if (framePtr->callerPtr) { - iPtr->framePtr = framePtr->callerPtr; - iPtr->varFramePtr = framePtr->callerVarPtr; - } else { - /* Tcl_PopCallFrame: trying to pop rootCallFrame! */ - } - if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); ckfree(framePtr->varTablePtr); @@ -422,6 +409,13 @@ Tcl_PopCallFrame( } framePtr->nsPtr = NULL; + if (framePtr->callerPtr) { + iPtr->framePtr = framePtr->callerPtr; + iPtr->varFramePtr = framePtr->callerVarPtr; + } else { + /* Tcl_PopCallFrame: trying to pop rootCallFrame! */ + } + if (framePtr->tailcallPtr) { TclSetTailcall(interp, framePtr->tailcallPtr); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 48e09f6..0b371ee 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -5032,27 +5032,44 @@ TclDeleteVars( TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { - Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; register Var *varPtr; - int flags; - Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - - /* - * Determine what flags to pass to the trace callback functions. - */ - - flags = TCL_TRACE_UNSETS; - if (tablePtr == &iPtr->globalNsPtr->varTable) { - flags |= TCL_GLOBAL_ONLY; - } else if (tablePtr == &currNsPtr->varTable) { - flags |= TCL_NAMESPACE_ONLY; - } for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; varPtr = VarHashFirstVar(tablePtr, &search)) { - UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags, - -1); + VarHashRefCount(varPtr)++; + + UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), + NULL, TCL_TRACE_UNSETS, -1); + + if (TclIsVarTraced(varPtr)) { + Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); + VarTrace *tracePtr = Tcl_GetHashValue(tPtr); + ActiveVarTrace *activePtr; + + while (tracePtr) { + VarTrace *prevPtr = tracePtr; + + tracePtr = tracePtr->nextPtr; + prevPtr->nextPtr = NULL; + Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC); + } + Tcl_DeleteHashEntry(tPtr); + varPtr->flags &= ~VAR_ALL_TRACES; + for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; + activePtr = activePtr->nextPtr) { + if (activePtr->varPtr == varPtr) { + activePtr->nextTracePtr = NULL; + } + } + } + + if (!TclIsVarUndefined(varPtr)) { + UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), + NULL, TCL_TRACE_UNSETS, -1); + } + + VarHashRefCount(varPtr)--; VarHashDeleteEntry(varPtr); } VarHashDeleteTable(tablePtr); -- cgit v0.12 From 69e6c8e2f7cc9c7cd816bb7acfe52c7b4556e4cb Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 8 Sep 2016 02:34:37 +0000 Subject: New test trace-18.5 for the bug. Updated trace-18.1 which was tuned to it. --- tests/trace.test | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/tests/trace.test b/tests/trace.test index 1099f48..3b69d38 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -1227,7 +1227,7 @@ test trace-17.3 {traced variables must survive procedure exits} { test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} - proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}} + proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 2 {info vars}]}}} set info {} p1 foo bar set info @@ -1263,6 +1263,27 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} { rename doTrace {} set info } 1110 +test trace-18.5 {Bug 7f02ff1efa} -setup { + proc constant {name value} { + upvar 1 $name c + set c $value + trace variable c wu [list reset $value] + } + proc reset {v a i o} { + uplevel 1 [list constant $a $v] + } + proc demo {} { + constant pi 3.14 + } +} -body { + unset -nocomplain pi + demo + info exists pi +} -cleanup { + rename demo {} + rename reset {} + rename constant {} +} -result 0 # Delete arrays when done, so they can be re-used as scalars # elsewhere. -- cgit v0.12 From 768ec09104da815f43907bc6c3f829d03d4d4fc9 Mon Sep 17 00:00:00 2001 From: gahr Date: Fri, 9 Sep 2016 07:28:45 +0000 Subject: Remove unnecessary use of fpsetround. See https://bugs.freebsd.org/212512 --- unix/tclUnixInit.c | 8 -------- 1 file changed, 8 deletions(-) diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 57215f1..91fb986 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -391,14 +391,6 @@ TclpInitPlatform(void) #endif /* SIGPIPE */ #if defined(__FreeBSD__) && defined(__GNUC__) - /* - * Adjust the rounding mode to be more conventional. Note that FreeBSD - * only provides the __fpsetreg() used by the following two for the GNU - * Compiler. When using, say, Intel's icc they break. (Partially based on - * patch in BSD ports system from root@celsius.bychok.com) - */ - - fpsetround(FP_RN); (void) fpsetmask(0L); #endif -- cgit v0.12 From f26a4a0948cbd769519cf1e79ea027511051b2bd Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 9 Sep 2016 12:36:53 +0000 Subject: Revert b98ee56376. The "bug" fixed was documented behavior. --- generic/tclNamesp.c | 20 +++++++++++++------- generic/tclVar.c | 49 ++++++++++++++++--------------------------------- tests/trace.test | 23 +---------------------- 3 files changed, 30 insertions(+), 62 deletions(-) diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 74dfaf8..7f6ecf5 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -382,6 +382,19 @@ Tcl_PopCallFrame( register CallFrame *framePtr = iPtr->framePtr; Namespace *nsPtr; + /* + * It's important to remove the call frame from the interpreter's stack of + * call frames before deleting local variables, so that traces invoked by + * the variable deletion don't see the partially-deleted frame. + */ + + if (framePtr->callerPtr) { + iPtr->framePtr = framePtr->callerPtr; + iPtr->varFramePtr = framePtr->callerVarPtr; + } else { + /* Tcl_PopCallFrame: trying to pop rootCallFrame! */ + } + if (framePtr->varTablePtr != NULL) { TclDeleteVars(iPtr, framePtr->varTablePtr); ckfree(framePtr->varTablePtr); @@ -409,13 +422,6 @@ Tcl_PopCallFrame( } framePtr->nsPtr = NULL; - if (framePtr->callerPtr) { - iPtr->framePtr = framePtr->callerPtr; - iPtr->varFramePtr = framePtr->callerVarPtr; - } else { - /* Tcl_PopCallFrame: trying to pop rootCallFrame! */ - } - if (framePtr->tailcallPtr) { TclSetTailcall(interp, framePtr->tailcallPtr); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 0b371ee..48e09f6 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -5032,44 +5032,27 @@ TclDeleteVars( TclVarHashTable *tablePtr) /* Hash table containing variables to * delete. */ { + Tcl_Interp *interp = (Tcl_Interp *) iPtr; Tcl_HashSearch search; register Var *varPtr; + int flags; + Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); - for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; - varPtr = VarHashFirstVar(tablePtr, &search)) { - VarHashRefCount(varPtr)++; - - UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), - NULL, TCL_TRACE_UNSETS, -1); - - if (TclIsVarTraced(varPtr)) { - Tcl_HashEntry *tPtr = Tcl_FindHashEntry(&iPtr->varTraces, varPtr); - VarTrace *tracePtr = Tcl_GetHashValue(tPtr); - ActiveVarTrace *activePtr; - - while (tracePtr) { - VarTrace *prevPtr = tracePtr; - - tracePtr = tracePtr->nextPtr; - prevPtr->nextPtr = NULL; - Tcl_EventuallyFree(prevPtr, TCL_DYNAMIC); - } - Tcl_DeleteHashEntry(tPtr); - varPtr->flags &= ~VAR_ALL_TRACES; - for (activePtr = iPtr->activeVarTracePtr; activePtr != NULL; - activePtr = activePtr->nextPtr) { - if (activePtr->varPtr == varPtr) { - activePtr->nextTracePtr = NULL; - } - } - } + /* + * Determine what flags to pass to the trace callback functions. + */ - if (!TclIsVarUndefined(varPtr)) { - UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), - NULL, TCL_TRACE_UNSETS, -1); - } + flags = TCL_TRACE_UNSETS; + if (tablePtr == &iPtr->globalNsPtr->varTable) { + flags |= TCL_GLOBAL_ONLY; + } else if (tablePtr == &currNsPtr->varTable) { + flags |= TCL_NAMESPACE_ONLY; + } - VarHashRefCount(varPtr)--; + for (varPtr = VarHashFirstVar(tablePtr, &search); varPtr != NULL; + varPtr = VarHashFirstVar(tablePtr, &search)) { + UnsetVarStruct(varPtr, NULL, iPtr, VarHashGetKey(varPtr), NULL, flags, + -1); VarHashDeleteEntry(varPtr); } VarHashDeleteTable(tablePtr); diff --git a/tests/trace.test b/tests/trace.test index 3b69d38..1099f48 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -1227,7 +1227,7 @@ test trace-17.3 {traced variables must survive procedure exits} { test trace-18.1 {unset traces on procedure returns} { proc p1 {x y} {set a 44; p2 14} - proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 2 {info vars}]}}} + proc p2 {z} {trace add variable z unset {traceCheck {lsort [uplevel 1 {info vars}]}}} set info {} p1 foo bar set info @@ -1263,27 +1263,6 @@ test trace-18.4 {namespace delete / trace vdelete combo, Bug \#1338280} { rename doTrace {} set info } 1110 -test trace-18.5 {Bug 7f02ff1efa} -setup { - proc constant {name value} { - upvar 1 $name c - set c $value - trace variable c wu [list reset $value] - } - proc reset {v a i o} { - uplevel 1 [list constant $a $v] - } - proc demo {} { - constant pi 3.14 - } -} -body { - unset -nocomplain pi - demo - info exists pi -} -cleanup { - rename demo {} - rename reset {} - rename constant {} -} -result 0 # Delete arrays when done, so they can be re-used as scalars # elsewhere. -- cgit v0.12