Package init

This commit is contained in:
overweight 2019-09-30 11:18:08 -04:00
commit fe90c77fc4
26 changed files with 1970 additions and 0 deletions

View File

@ -0,0 +1,56 @@
From a1e20681a032f9f3ce4c47922ee8509891401691 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Fri, 6 Apr 2018 17:28:56 +0000
Subject: [PATCH 1079/1800] =?UTF-8?q?[27b682284974d0cd]=20command=20"file?=
=?UTF-8?q?=20delete":=20avoid=20possible=20race=20condition=20if=20file/d?=
=?UTF-8?q?irectory=20deleted=20after=20call=20of=20lstat,=20so=20bypass?=
=?UTF-8?q?=20ENOENT=20error=20code.=20Thanks=20to=20Rainer=20M=C3=BCller?=
=?UTF-8?q?=20(aka=20raimue)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
---
generic/tclFCmd.c | 18 +++++++++---------
1 file changed, 9 insertions(+), 9 deletions(-)
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index c52cd1e7e..5b2fbe1fa 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -373,14 +373,7 @@ TclFileDeleteCmd(
*/
if (Tcl_FSLstat(objv[i], &statBuf) != 0) {
- /*
- * Trying to delete a file that does not exist is not considered
- * an error, just a no-op
- */
-
- if (errno != ENOENT) {
- result = TCL_ERROR;
- }
+ result = TCL_ERROR;
} else if (S_ISDIR(statBuf.st_mode)) {
/*
* We own a reference count on errorBuffer, if it was set as a
@@ -416,8 +409,15 @@ TclFileDeleteCmd(
}
if (result != TCL_OK) {
- result = TCL_ERROR;
+ /*
+ * Avoid possible race condition (file/directory deleted after call
+ * of lstat), so bypass ENOENT because not an error, just a no-op
+ */
+ if (errno == ENOENT) {
+ result = TCL_OK;
+ continue;
+ }
/*
* It is important that we break on error, otherwise we might end
* up owning reference counts on numerous errorBuffers.
--
2.19.1

View File

@ -0,0 +1,80 @@
From f2343ead74b78173ed8b13543107a689c408e908 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 23 Apr 2018 23:23:00 +0000
Subject: [PATCH 1121/1800] Bug-fix in Tcl_UtfAtIndex (for TCL_UTF_MAX=4 only).
With test-case (in "string totitle") demonstrating the bug.
---
generic/tclUtf.c | 8 ++++++++
tests/string.test | 11 +++++++++--
2 files changed, 17 insertions(+), 2 deletions(-)
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 0d88d36b3..c08464b9d 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -762,10 +762,18 @@ Tcl_UtfAtIndex(
register int index) /* The position of the desired character. */
{
Tcl_UniChar ch = 0;
+ int len = 1;
while (index-- > 0) {
+ len = TclUtfToUniChar(src, &ch);
+ src += len;
+ }
+#if TCL_UTF_MAX == 4
+ if (!len) {
+ /* Index points at character following High Surrogate */
src += TclUtfToUniChar(src, &ch);
}
+#endif
return src;
}
diff --git a/tests/string.test b/tests/string.test
index d69fda44d..868fc25fc 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -24,7 +24,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
-testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
+testConstraint tip389 [expr {[string length \U010000] == 2}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
@@ -291,6 +291,9 @@ test string-5.19 {string index, bytearray object out of bounds} {
test string-5.20 {string index, bytearray object out of bounds} {
string index [binary format I* {0x50515253 0x52}] 20
} {}
+test string-5.21 {string index, surrogates, bug [11ae2be95dac9417]} tip389 {
+ list [string index a\U100000b 1] [string index a\U100000b 2] [string index a\U100000b 3]
+} [list \U100000 {} b]
proc largest_int {} {
@@ -1280,7 +1283,7 @@ test string-12.22 {string range, shimmering binary/index} {
binary scan $s a* x
string range $s $s end
} 000000001
-test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf {
+test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} tip389 {
list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]
} [list \U100000 {} b]
@@ -1477,6 +1480,10 @@ test string-17.7 {string totitle, unicode} {
test string-17.8 {string totitle, compiled} {
lindex [string totitle [list aa bb [list cc]]] 0
} Aa
+test string-17.9 {string totitle, surrogates, bug [11ae2be95dac9417]} tip389 {
+ list [string totitle a\U118c0c 1 1] [string totitle a\U118c0c 2 2] \
+ [string totitle a\U118c0c 3 3]
+} [list a\U118a0c a\U118c0C a\U118c0C]
test string-18.1 {string trim} {
list [catch {string trim} msg] $msg
--
2.19.1

View File

@ -0,0 +1,35 @@
From 7fff40c678507ffe82b3c65f1a0277a6da0b906e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Fri, 12 Jan 2018 10:03:58 +0000
Subject: [PATCH 0837/1800] Fix [11ae2be95d]: tip-389 branch: string range
errors with code points greater than U+FFFF
---
generic/tclExecute.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index f2cda0ca8..63281a85e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5445,7 +5445,7 @@ TEBCresume(
valuePtr->bytes+index, 1);
} else {
char buf[TCL_UTF_MAX];
- Tcl_UniChar ch = Tcl_GetUniChar(valuePtr, index);
+ int ch = Tcl_GetUniChar(valuePtr, index);
/*
* This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
@@ -5453,7 +5453,7 @@ TEBCresume(
* practical use.
*/
- length = Tcl_UniCharToUtf(ch, buf);
+ length = (ch != -1) ? Tcl_UniCharToUtf(ch, buf) : 0;
objResultPtr = Tcl_NewStringObj(buf, length);
}
--
2.19.1

View File

@ -0,0 +1,68 @@
From 4199a703dccda415778cc3431696a6bed57ab15c Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 11 Jan 2018 15:44:05 +0000
Subject: [PATCH 0834/1800] Fix behavior of Tcl_GetRange() and "string range"
regarding surrogates, when Tcl is compiled with -DTCL_UTF_MAX=4. Partial fix
for bug [11ae2be95dac9417]. Also, fix typo.
---
generic/tclStringObj.c | 13 ++++++++++++-
tests/string.test | 4 ++++
2 files changed, 16 insertions(+), 1 deletion(-)
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 0f238cfb1..1b35c567b 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -533,7 +533,7 @@ Tcl_GetUniChar(
*
* Get the Unicode form of the String object. If the object is not
* already a String object, it will be converted to one. If the String
- * object does not have a Unicode rep, then one is create from the UTF
+ * object does not have a Unicode rep, then one is created from the UTF
* string format.
*
* Results:
@@ -667,6 +667,17 @@ Tcl_GetRange(
stringPtr = GET_STRING(objPtr);
}
+#if TCL_UTF_MAX == 4
+ /* See: bug [11ae2be95dac9417] */
+ if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00)
+ && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) {
+ ++first;
+ }
+ if ((last+1<stringPtr->numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00)
+ && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) {
+ ++last;
+ }
+#endif
return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1);
}
diff --git a/tests/string.test b/tests/string.test
index bbba5ebec..53f1cfb73 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -24,6 +24,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
testConstraint testobj [expr {[info commands testobj] != {}}]
testConstraint testindexobj [expr {[info commands testindexobj] != {}}]
+testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}]
# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
@@ -1276,6 +1277,9 @@ test string-12.22 {string range, shimmering binary/index} {
binary scan $s a* x
string range $s $s end
} 000000001
+test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf {
+ list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3]
+} [list \U100000 {} b]
test string-13.1 {string repeat} {
list [catch {string repeat} msg] $msg
--
2.19.1

View File

@ -0,0 +1,47 @@
From c8e3d65affc560d3053066d562920223e1780d89 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Wed, 1 Nov 2017 21:05:32 +0000
Subject: [PATCH 0652/1800] Fix bug 3c32a3f8bd, segmentation fault in
TclOO.c/ReleaseClassContents() for a class mixed into one of its instances.
---
generic/tclOO.c | 15 +++++++++++++--
1 file changed, 13 insertions(+), 2 deletions(-)
diff --git a/generic/tclOO.c b/generic/tclOO.c
index e9ef2ce29..51731d3d1 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -1006,8 +1006,18 @@ ReleaseClassContents(
}
for(j=0 ; j<instancePtr->mixins.num ; j++) {
Class *mixin = instancePtr->mixins.list[j];
+ Class *nextMixin = NULL;
if (mixin == clsPtr) {
- instancePtr->mixins.list[j] = NULL;
+ if (j < instancePtr->mixins.num - 1) {
+ nextMixin = instancePtr->mixins.list[j+1];
+ }
+ if (j == 0) {
+ instancePtr->mixins.num = 0;
+ instancePtr->mixins.list = NULL;
+ } else {
+ instancePtr->mixins.list[j-1] = nextMixin;
+ }
+ instancePtr->mixins.num -= 1;
}
}
if (instancePtr != NULL && !IsRoot(instancePtr)) {
@@ -1181,7 +1191,8 @@ ObjectNamespaceDeleted(
if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
/*
* Namespace deletion must have been triggered by a trace on command
- * deletion , meaning that
+ * deletion , meaning that ObjectRenamedTrace() is eventually going
+ * to be called .
*/
deleteAlreadyInProgress = 1;
}
--
2.19.1

View File

@ -0,0 +1,88 @@
From a965b9b2624fefd1087fca8505ba3b486772ee70 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Mon, 20 Nov 2017 10:15:59 +0000
Subject: [PATCH 0718/1800] Fix error-message for min/math functions: "to" ->
"for", for consistancy with the error-messages for other math functions.
---
library/init.tcl | 4 ++--
tests/expr-old.test | 20 ++++++++++++++++----
2 files changed, 18 insertions(+), 6 deletions(-)
diff --git a/library/init.tcl b/library/init.tcl
index 87d9f14da..13a4300c3 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -79,7 +79,7 @@ namespace eval tcl {
proc min {args} {
if {![llength $args]} {
return -code error \
- "too few arguments to math function \"min\""
+ "too few arguments for math function \"min\""
}
set val Inf
foreach arg $args {
@@ -95,7 +95,7 @@ namespace eval tcl {
proc max {args} {
if {![llength $args]} {
return -code error \
- "too few arguments to math function \"max\""
+ "too few arguments for math function \"max\""
}
set val -Inf
foreach arg $args {
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 3adfb635f..8c159b2bb 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -1159,8 +1159,8 @@ test expr-old-40.2 {min math function} -body {
expr {min(0.0)}
} -result 0.0
test expr-old-40.3 {min math function} -body {
- list [catch {expr {min()}} msg] $msg
-} -result {1 {too few arguments to math function "min"}}
+ expr {min()}
+} -returnCodes error -result {too few arguments for math function "min"}
test expr-old-40.4 {min math function} -body {
expr {min(wide(-1) << 30, 4.5, -10)}
} -result [expr {wide(-1) << 30}]
@@ -1170,6 +1170,12 @@ test expr-old-40.5 {min math function} -body {
test expr-old-40.6 {min math function} -body {
expr {min(300, "0xFF")}
} -result 255
+test expr-old-40.7 {min math function} -body {
+ expr min(1[string repeat 0 10000], 1e300)
+} -result 1e+300
+test expr-old-40.8 {min math function} -body {
+ expr {min(0, "a")}
+} -returnCodes error -match glob -result *
test expr-old-41.1 {max math function} -body {
expr {max(0)}
@@ -1178,8 +1184,8 @@ test expr-old-41.2 {max math function} -body {
expr {max(0.0)}
} -result 0.0
test expr-old-41.3 {max math function} -body {
- list [catch {expr {max()}} msg] $msg
-} -result {1 {too few arguments to math function "max"}}
+ expr {max()}
+} -returnCodes error -result {too few arguments for math function "max"}
test expr-old-41.4 {max math function} -body {
expr {max(wide(1) << 30, 4.5, -10)}
} -result [expr {wide(1) << 30}]
@@ -1189,6 +1195,12 @@ test expr-old-41.5 {max math function} -body {
test expr-old-41.6 {max math function} -body {
expr {max(200, "0xFF")}
} -result 255
+test expr-old-41.7 {max math function} -body {
+ expr max(1[string repeat 0 10000], 1e300)
+} -result 1[string repeat 0 10000]
+test expr-old-41.8 {max math function} -body {
+ expr {max(0, "a")}
+} -returnCodes error -match glob -result *
# Special test for Pentium arithmetic bug of 1994:
--
2.19.1

View File

@ -0,0 +1,294 @@
From cb0d0668227042f07802ebd4e713577cdf85a116 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 30 Oct 2017 05:19:55 +0000
Subject: [PATCH 0634/1800] Fix for issue 9fd5c629c1, TclOO - aborts when a
trace on command deletion deletes the object's namespace.
---
generic/tclBasic.c | 8 ++++----
generic/tclFileName.c | 2 +-
generic/tclOO.c | 35 ++++++++++++++++++++++++++---------
generic/tclOOCall.c | 8 ++++----
generic/tclOOInt.h | 16 ++++++++--------
tests/oo.test | 12 ++++++++++++
6 files changed, 55 insertions(+), 26 deletions(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d4fa8330b..e6022ac6b 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3112,7 +3112,7 @@ Tcl_DeleteCommandFromToken(
/*
* We must delete this command, even though both traces and delete procs
* may try to avoid this (renaming the command etc). Also traces and
- * delete procs may try to delete the command themsevles. This flag
+ * delete procs may try to delete the command themselves. This flag
* declares that a delete is in progress and that recursive deletes should
* be ignored.
*/
@@ -7722,8 +7722,8 @@ ExprRandFunc(
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
- * Take into consideration the thread this interp is running in order
- * to insure different seeds in different threads (bug #416643)
+ * To ensure different seeds in different threads (bug #416643),
+ * take into consideration the thread this interp is running in.
*/
iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12);
@@ -9091,7 +9091,7 @@ TclNRCoroutineObjCmd(
TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
NULL, NULL, NULL);
- /* insure that the command is looked up in the correct namespace */
+ /* ensure that the command is looked up in the correct namespace */
iPtr->lookupNsPtr = lookupNsPtr;
Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);
iPtr->numLevels--;
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 150fb8c4d..15fcde74a 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1904,7 +1904,7 @@ TclGlob(
}
/*
- * To process a [glob] invokation, this function may be called multiple
+ * To process a [glob] invocation, this function may be called multiple
* times. Each time, the previously discovered filenames are in the
* interpreter result. We stash that away here so the result is free for
* error messsages.
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 73acce844..e9ef2ce29 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -880,7 +880,7 @@ ObjectRenamedTrace(
* 2950259]
*/
- if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
+ if (oPtr->namespacePtr && ((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
Tcl_DeleteNamespace(oPtr->namespacePtr);
}
if (oPtr->classPtr) {
@@ -1168,7 +1168,7 @@ ObjectNamespaceDeleted(
Class *clsPtr = oPtr->classPtr, *mixinPtr;
Method *mPtr;
Tcl_Obj *filterObj, *variableObj;
- int i;
+ int deleteAlreadyInProgress = 0, i;
/*
* Instruct everyone to no longer use any allocated fields of the object.
@@ -1178,6 +1178,14 @@ ObjectNamespaceDeleted(
*/
if (oPtr->command) {
+ if ((((Command *)oPtr->command)->flags && CMD_IS_DELETED)) {
+ /*
+ * Namespace deletion must have been triggered by a trace on command
+ * deletion , meaning that
+ */
+ deleteAlreadyInProgress = 1;
+ }
+
Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
}
if (oPtr->myCommand) {
@@ -1273,14 +1281,17 @@ ObjectNamespaceDeleted(
if (clsPtr->subclasses.list) {
ckfree(clsPtr->subclasses.list);
+ clsPtr->subclasses.list = NULL;
clsPtr->subclasses.num = 0;
}
if (clsPtr->instances.list) {
ckfree(clsPtr->instances.list);
+ clsPtr->instances.list = NULL;
clsPtr->instances.num = 0;
}
if (clsPtr->mixinSubs.list) {
ckfree(clsPtr->mixinSubs.list);
+ clsPtr->mixinSubs.list = NULL;
clsPtr->mixinSubs.num = 0;
}
@@ -1305,7 +1316,13 @@ ObjectNamespaceDeleted(
* Delete the object structure itself.
*/
- DelRef(oPtr);
+ if (deleteAlreadyInProgress) {
+ oPtr->classPtr = NULL;
+ oPtr->namespacePtr = NULL;
+ } else {
+ DelRef(oPtr);
+ }
+
}
/*
@@ -2433,7 +2450,7 @@ Tcl_ObjectSetMetadata(
*
* PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
*
- * Main entry point for object invokations. The Public* and Private*
+ * Main entry point for object invocations. The Public* and Private*
* wrapper functions (implementations of both object instance commands
* and [my]) are just thin wrappers round the main TclOOObjectCmdCore
* function. Note that the core is function is NRE-aware.
@@ -2518,8 +2535,8 @@ TclOOInvokeObject(
*
* TclOOObjectCmdCore, FinalizeObjectCall --
*
- * Main function for object invokations. Does call chain creation,
- * management and invokation. The function FinalizeObjectCall exists to
+ * Main function for object invocations. Does call chain creation,
+ * management and invocation. The function FinalizeObjectCall exists to
* clean up after the non-recursive processing of TclOOObjectCmdCore.
*
* ----------------------------------------------------------------------
@@ -2531,7 +2548,7 @@ TclOOObjectCmdCore(
Tcl_Interp *interp, /* The interpreter containing the object. */
int objc, /* How many arguments are being passed in. */
Tcl_Obj *const *objv, /* The array of arguments. */
- int flags, /* Whether this is an invokation through the
+ int flags, /* Whether this is an invocation through the
* public or the private command interface. */
Class *startCls) /* Where to start in the call chain, or NULL
* if we are to start at the front with
@@ -2720,7 +2737,7 @@ Tcl_ObjectContextInvokeNext(
* call context while we process the body. However, need to adjust the
* argument-skip control because we're guaranteed to have a single prefix
* arg (i.e., 'next') and not the variable amount that can happen because
- * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+ * method invocations (i.e., '$obj meth' and 'my meth'), constructors
* (i.e., '$cls new' and '$cls create obj') and destructors (no args at
* all) come through the same code.
*/
@@ -2789,7 +2806,7 @@ TclNRObjectContextInvokeNext(
* call context while we process the body. However, need to adjust the
* argument-skip control because we're guaranteed to have a single prefix
* arg (i.e., 'next') and not the variable amount that can happen because
- * method invokations (i.e., '$obj meth' and 'my meth'), constructors
+ * method invocations (i.e., '$obj meth' and 'my meth'), constructors
* (i.e., '$cls new' and '$cls create obj') and destructors (no args at
* all) come through the same code.
*/
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 3e4f561d2..d4e1e34d5 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -233,7 +233,7 @@ FreeMethodNameRep(
* TclOOInvokeContext --
*
* Invokes a single step along a method call-chain context. Note that the
- * invokation of a step along the chain can cause further steps along the
+ * invocation of a step along the chain can cause further steps along the
* chain to be invoked. Note that this function is written to be as light
* in stack usage as possible.
*
@@ -830,7 +830,7 @@ AddMethodToCallChain(
* Call chain semantics states that methods come as *late* in the
* call chain as possible. This is done by copying down the
* following methods. Note that this does not change the number of
- * method invokations in the call chain; it just rearranges them.
+ * method invocations in the call chain; it just rearranges them.
*/
Class *declCls = callPtr->chain[i].filterDeclarer;
@@ -935,7 +935,7 @@ IsStillValid(
* TclOOGetCallContext --
*
* Responsible for constructing the call context, an ordered list of all
- * method implementations to be called as part of a method invokation.
+ * method implementations to be called as part of a method invocation.
* This method is central to the whole operation of the OO system.
*
* ----------------------------------------------------------------------
@@ -1517,7 +1517,7 @@ TclOORenderCallChain(
/*
* Do the actual construction of the descriptions. They consist of a list
* of triples that describe the details of how a method is understood. For
- * each triple, the first word is the type of invokation ("method" is
+ * each triple, the first word is the type of invocation ("method" is
* normal, "unknown" is special because it adds the method name as an
* extra argument when handled by some method types, and "filter" is
* special because it's a filter method). The second word is the name of
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 476446dbb..11ba698a3 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -149,8 +149,8 @@ typedef struct Object {
struct Foundation *fPtr; /* The basis for the object system. Putting
* this here allows the avoidance of quite a
* lot of hash lookups on the critical path
- * for object invokation and creation. */
- Tcl_Namespace *namespacePtr;/* This object's tame namespace. */
+ * for object invocation and creation. */
+ Tcl_Namespace *namespacePtr;/* This object's namespace. */
Tcl_Command command; /* Reference to this object's public
* command. */
Tcl_Command myCommand; /* Reference to this object's internal
@@ -162,12 +162,12 @@ typedef struct Object {
/* Classes mixed into this object. */
LIST_STATIC(Tcl_Obj *) filters;
/* List of filter names. */
- struct Class *classPtr; /* All classes have this non-NULL; it points
- * to the class structure. Everything else has
- * this NULL. */
+ struct Class *classPtr; /* This is non-NULL for all classes, and NULL
+ * for everything else. It points to the class
+ * structure. */
int refCount; /* Number of strong references to this object.
* Note that there may be many more weak
- * references; this mechanism is there to
+ * references; this mechanism exists to
* avoid Tcl_Preserve. */
int flags;
int creationEpoch; /* Unique value to make comparisons of objects
@@ -323,7 +323,7 @@ typedef struct Foundation {
} Foundation;
/*
- * A call context structure is built when a method is called. They contain the
+ * A call context structure is built when a method is called. It contains the
* chain of method implementations that are to be invoked by a particular
* call, and the process of calling walks the chain, with the [next] command
* proceeding to the next entry in the chain.
@@ -334,7 +334,7 @@ typedef struct Foundation {
struct MInvoke {
Method *mPtr; /* Reference to the method implementation
* record. */
- int isFilter; /* Whether this is a filter invokation. */
+ int isFilter; /* Whether this is a filter invocation. */
Class *filterDeclarer; /* What class decided to add the filter; if
* NULL, it was added by the object. */
};
diff --git a/tests/oo.test b/tests/oo.test
index 2a6eb8003..6268dc6e0 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -1482,6 +1482,18 @@ test oo-11.4 {OO: cleanup} {
lappend result [bar0 destroy] [oo::object create foo] [foo destroy] \
[oo::object create bar2] [bar2 destroy]
} {1 {can't create object "foo": command already exists with that name} destroyed {} ::foo {} ::bar2 {}}
+test oo-11.5 {OO: cleanup} {
+ oo::class create obj1
+
+ trace add command obj1 delete {apply {{name1 name2 action} {
+ set namespace [info object namespace $name1]
+ namespace delete $namespace
+ }}}
+
+ rename obj1 {}
+ # No segmentation fault
+ return done
+} done
test oo-12.1 {OO: filters} {
oo::class create Aclass
--
2.19.1

View File

@ -0,0 +1,148 @@
From ad342ab381c2c25e3b9fb35f7d989c1da6dbc0bc Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 28 Dec 2017 18:49:24 +0000
Subject: [PATCH 0807/1800] Fix handling of surrogates (when TCL_UTF_MAX > 3)
in Tcl_UtfNcmp()/Tcl_UtfNcasecmp()/TclUtfCasecmp(). Backported from
core-8-branch, where this was fixed already.
---
generic/tclPkg.c | 6 ++---
generic/tclUtf.c | 57 ++++++++++++++++++++++++------------------------
2 files changed, 32 insertions(+), 31 deletions(-)
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 4f6faa87c..6d826a96d 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -414,7 +414,7 @@ PkgRequireCore(
continue;
}
-
+
/* Check satisfaction of requirements before considering the current version further. */
if (reqc > 0) {
satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
@@ -424,7 +424,7 @@ PkgRequireCore(
continue;
}
}
-
+
if (bestPtr != NULL) {
int res = CompareVersions(availVersion, bestVersion, NULL);
@@ -485,7 +485,7 @@ PkgRequireCore(
/*
* Clean up memorized internal reps, if any.
*/
-
+
if (bestVersion != NULL) {
ckfree(bestVersion);
bestVersion = NULL;
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index c60e99ed8..6255a4e24 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -726,8 +726,7 @@ Tcl_UniCharAtIndex(
{
Tcl_UniChar ch = 0;
- while (index >= 0) {
- index--;
+ while (index-- >= 0) {
src += TclUtfToUniChar(src, &ch);
}
return ch;
@@ -757,8 +756,7 @@ Tcl_UtfAtIndex(
{
Tcl_UniChar ch = 0;
- while (index > 0) {
- index--;
+ while (index-- > 0) {
src += TclUtfToUniChar(src, &ch);
}
return src;
@@ -1072,16 +1070,17 @@ Tcl_UtfNcmp(
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
- /* map high surrogate characters to values > 0xffff */
- if ((ch1 & 0xFC00) == 0xD800) {
- ch1 += 0x4000;
- }
- if ((ch2 & 0xFC00) == 0xD800) {
- ch2 += 0x4000;
- }
+ /* Surrogates always report higher than non-surrogates */
+ if (((ch1 & 0xFC00) == 0xD800)) {
+ if ((ch2 & 0xFC00) != 0xD800) {
+ return ch1;
+ }
+ } else if ((ch2 & 0xFC00) == 0xD800) {
+ return -ch2;
+ }
#endif
- if (ch1 != ch2) {
return (ch1 - ch2);
}
}
@@ -1122,16 +1121,17 @@ Tcl_UtfNcasecmp(
*/
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
- /* map high surrogate characters to values > 0xffff */
- if ((ch1 & 0xFC00) == 0xD800) {
- ch1 += 0x4000;
- }
- if ((ch2 & 0xFC00) == 0xD800) {
- ch2 += 0x4000;
- }
+ /* Surrogates always report higher than non-surrogates */
+ if (((ch1 & 0xFC00) == 0xD800)) {
+ if ((ch2 & 0xFC00) != 0xD800) {
+ return ch1;
+ }
+ } else if ((ch2 & 0xFC00) == 0xD800) {
+ return -ch2;
+ }
#endif
- if (ch1 != ch2) {
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
@@ -1170,16 +1170,17 @@ TclUtfCasecmp(
while (*cs && *ct) {
cs += TclUtfToUniChar(cs, &ch1);
ct += TclUtfToUniChar(ct, &ch2);
+ if (ch1 != ch2) {
#if TCL_UTF_MAX == 4
- /* map high surrogate characters to values > 0xffff */
- if ((ch1 & 0xFC00) == 0xD800) {
- ch1 += 0x4000;
- }
- if ((ch2 & 0xFC00) == 0xD800) {
- ch2 += 0x4000;
- }
+ /* Surrogates always report higher than non-surrogates */
+ if (((ch1 & 0xFC00) == 0xD800)) {
+ if ((ch2 & 0xFC00) != 0xD800) {
+ return ch1;
+ }
+ } else if ((ch2 & 0xFC00) == 0xD800) {
+ return -ch2;
+ }
#endif
- if (ch1 != ch2) {
ch1 = Tcl_UniCharToLower(ch1);
ch2 = Tcl_UniCharToLower(ch2);
if (ch1 != ch2) {
--
2.19.1

View File

@ -0,0 +1,27 @@
From 5dfa918023df4ec9c5cbd4fe567ee509328f8d4f Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 5 Feb 2018 13:33:21 +0000
Subject: [PATCH 0878/1800] Improved overflow prevention.
---
generic/tclStringObj.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index ae75e449e..8437555ed 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -140,8 +140,8 @@ GrowStringBuffer(
objPtr->bytes = NULL;
}
if (flag == 0 || stringPtr->allocated > 0) {
- attempt = 2 * needed;
- if (attempt >= 0) {
+ if (needed <= INT_MAX / 2) {
+ attempt = 2 * needed;
ptr = attemptckrealloc(objPtr->bytes, attempt + 1);
}
if (ptr == NULL) {
--
2.19.1

View File

@ -0,0 +1,27 @@
From 183dadc7fae0994a33901a7246989d2605f5c70c Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Mon, 5 Feb 2018 13:41:26 +0000
Subject: [PATCH 0879/1800] Improved overflow prevention.
---
generic/tclStringObj.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 8437555ed..c3a0192d8 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -190,8 +190,8 @@ GrowUnicodeBuffer(
* Subsequent appends - apply the growth algorithm.
*/
- attempt = 2 * needed;
- if (attempt >= 0 && attempt <= STRING_MAXCHARS) {
+ if (needed <= STRING_MAXCHARS / 2) {
+ attempt = 2 * needed;
ptr = stringAttemptRealloc(stringPtr, attempt);
}
if (ptr == NULL) {
--
2.19.1

View File

@ -0,0 +1,150 @@
From eb3a1a3eaa3b789fc4cf34746a29245ccb1f57ea Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 4 Oct 2018 19:22:37 +0000
Subject: [PATCH 1432/1800] In registry, protect "keyName" from being NULL:
This actually can lead to crashed (I experienced this ...). Update version to
1.3.3, and align implementation in all branches (core-8-6-branch and higher)
---
library/reg/pkgIndex.tcl | 4 ++--
win/tclWinReg.c | 34 +++++++++++++++-------------------
2 files changed, 17 insertions(+), 21 deletions(-)
diff --git a/library/reg/pkgIndex.tcl b/library/reg/pkgIndex.tcl
index b1fe234c4..ee559b5a8 100755
--- a/library/reg/pkgIndex.tcl
+++ b/library/reg/pkgIndex.tcl
@@ -1,9 +1,9 @@
if {([info commands ::tcl::pkgconfig] eq "")
|| ([info sharedlibextension] ne ".dll")} return
if {[::tcl::pkgconfig get debug]} {
- package ifneeded registry 1.3.2 \
+ package ifneeded registry 1.3.3 \
[list load [file join $dir tclreg13g.dll] registry]
} else {
- package ifneeded registry 1.3.2 \
+ package ifneeded registry 1.3.3 \
[list load [file join $dir tclreg13.dll] registry]
}
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index de48b9b4b..f3d7a07c8 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -22,13 +22,6 @@
#endif
#include <stdlib.h>
-#ifndef UNICODE
-# undef Tcl_WinTCharToUtf
-# define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
-# undef Tcl_WinUtfToTChar
-# define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
-#endif /* !UNICODE */
-
/*
* Ensure that we can say which registry is being accessed.
*/
@@ -163,7 +156,7 @@ Registry_Init(
cmd = Tcl_CreateObjCommand(interp, "registry", RegistryObjCmd,
interp, DeleteCmd);
Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
- return Tcl_PkgProvide(interp, "registry", "1.3.2");
+ return Tcl_PkgProvide(interp, "registry", "1.3.3");
}
/*
@@ -414,12 +407,12 @@ DeleteKey(
*/
keyName = Tcl_GetString(keyNameObj);
- buffer = ckalloc(keyNameObj->length + 1);
+ buffer = Tcl_Alloc(keyNameObj->length + 1);
strcpy(buffer, keyName);
if (ParseKeyName(interp, buffer, &hostName, &rootKey,
&keyName) != TCL_OK) {
- ckfree(buffer);
+ Tcl_Free(buffer);
return TCL_ERROR;
}
@@ -427,7 +420,7 @@ DeleteKey(
Tcl_SetObjResult(interp,
Tcl_NewStringObj("bad key: cannot delete root keys", -1));
Tcl_SetErrorCode(interp, "WIN_REG", "DEL_ROOT_KEY", NULL);
- ckfree(buffer);
+ Tcl_Free(buffer);
return TCL_ERROR;
}
@@ -442,7 +435,7 @@ DeleteKey(
mode |= KEY_ENUMERATE_SUB_KEYS | DELETE;
result = OpenSubKey(hostName, rootKey, keyName, mode, 0, &subkey);
if (result != ERROR_SUCCESS) {
- ckfree(buffer);
+ Tcl_Free(buffer);
if (result == ERROR_FILE_NOT_FOUND) {
return TCL_OK;
}
@@ -470,7 +463,7 @@ DeleteKey(
}
RegCloseKey(subkey);
- ckfree(buffer);
+ Tcl_Free(buffer);
return result;
}
@@ -603,8 +596,7 @@ GetKeyNames(
}
break;
}
- Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
- name = Tcl_DStringValue(&ds);
+ name = Tcl_WinTCharToUtf(buffer, bufSize * sizeof(TCHAR), &ds);
if (pattern && !Tcl_StringMatch(name, pattern)) {
Tcl_DStringFree(&ds);
continue;
@@ -950,7 +942,7 @@ OpenKey(
keyName = Tcl_GetString(keyNameObj);
length = keyNameObj->length;
- buffer = ckalloc(length + 1);
+ buffer = Tcl_Alloc(length + 1);
strcpy(buffer, keyName);
result = ParseKeyName(interp, buffer, &hostName, &rootKey, &keyName);
@@ -966,7 +958,7 @@ OpenKey(
}
}
- ckfree(buffer);
+ Tcl_Free(buffer);
return result;
}
@@ -1019,7 +1011,9 @@ OpenSubKey(
* this key must be closed by the caller.
*/
- keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
+ if (keyName) {
+ keyName = (char *) Tcl_WinUtfToTChar(keyName, -1, &buf);
+ }
if (flags & REG_CREATE) {
DWORD create;
@@ -1037,7 +1031,9 @@ OpenSubKey(
result = RegOpenKeyEx(rootKey, (TCHAR *)keyName, 0, mode,
keyPtr);
}
- Tcl_DStringFree(&buf);
+ if (keyName) {
+ Tcl_DStringFree(&buf);
+ }
/*
* Be sure to close the root key since we are done with it now.
--
2.19.1

View File

@ -0,0 +1,43 @@
From fdc88b9a1be8cdd3d3e98406f244edfec6050771 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 18 Jun 2018 05:59:22 +0000
Subject: [PATCH 1260/1800] Plug leak in TclSetEnv.
---
generic/tclEnv.c | 4 ++++
tests/pkgIndex.tcl | 8 ++++----
2 files changed, 8 insertions(+), 4 deletions(-)
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 8cc4b746a..c559c69b8 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -730,6 +730,10 @@ TclFinalizeEnvironment(void)
ckfree(env.cache);
env.cache = NULL;
env.cacheSize = 0;
+ if ((env.ourEnviron != NULL)) {
+ ckfree(env.ourEnviron);
+ env.ourEnviron = NULL;
+ }
#ifndef USE_PUTENV
env.ourEnvironSize = 0;
#endif
diff --git a/tests/pkgIndex.tcl b/tests/pkgIndex.tcl
index 48ab71b73..0feb0eb38 100644
--- a/tests/pkgIndex.tcl
+++ b/tests/pkgIndex.tcl
@@ -1,6 +1,6 @@
#! /usr/bin/env tclsh
-package ifneeded tcltests 0.1 {
- source [file dirname [file dirname [file normalize [info script]/...]]]/tcltests.tcl
- package provide tcltests 0.1
-}
+package ifneeded tcltests 0.1 "
+ source [list $dir]/tcltests.tcl
+ package provide tcltests 0.1
+"
--
2.19.1

View File

@ -0,0 +1,25 @@
From d72e2b37fd678418e2ee74b681501337a4c2be4d Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Thu, 26 Jul 2018 18:56:41 +0000
Subject: [PATCH 1332/1800] amend after merge: 8.6th provide additionally an
error-code (so missing `errCode = "OVERFLOW"`)
---
generic/tclStringObj.c | 1 +
1 file changed, 1 insertion(+)
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 3139be44d..493378c38 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1878,6 +1878,7 @@ Tcl_AppendFormatToObj(
width = strtoul(format, &end, 10);
if (width < 0) {
msg = overflow;
+ errCode = "OVERFLOW";
goto errorMsg;
}
format = end;
--
2.19.1

View File

@ -0,0 +1,29 @@
From 20c0ed50e35e6075f82eb87fdeb7a13e522b710a Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Thu, 26 Jul 2018 15:57:38 +0000
Subject: [PATCH 1329/1800] closes [d051b77fc18d7340]: fixed segfault by
integer overflow (if width by format like "%4000000000g" overflows to
negative values by scan of length)
---
generic/tclStringObj.c | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 996be77ee..462ef0424 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1938,6 +1938,10 @@ Tcl_AppendFormatToObj(
width = 0;
if (isdigit(UCHAR(ch))) {
width = strtoul(format, &end, 10);
+ if (width < 0) {
+ msg = overflow;
+ goto errorMsg;
+ }
format = end;
step = TclUtfToUniChar(format, &ch);
} else if (ch == '*') {
--
2.19.1

27
fix-exec-test-error.patch Normal file
View File

@ -0,0 +1,27 @@
From 6abda12a6aea301b037341b4c7c6ff1fe84920f9 Mon Sep 17 00:00:00 2001
From: chenzhen <chenzhen44@huawei.com>
Date: Tue, 6 Aug 2019 08:05:04 -0400
Subject: [PATCH] fix exec test error
reason: fix exec test error
Signed-off-by: chenzhen <chenzhen44@huawei.com>
---
tests/exec.test | 1 -
1 file changed, 1 deletion(-)
diff --git a/tests/exec.test b/tests/exec.test
index cd29171..c718b2f 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -17,7 +17,6 @@
package require tcltest 2
namespace import -force ::tcltest::*
-package require tcltests
# All tests require the "exec" command.
# Skip them if exec is not defined.
--
2.19.1

View File

@ -0,0 +1,27 @@
From b985529f9905b326d7da711ffbe28d80418c7ef8 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Mon, 28 Jan 2019 16:12:56 +0000
Subject: [PATCH 1693/1800] fixes [4ee9b4f3e965a7da5133]: result of command
`time` overflows by single iteration longer as 35 minutes (uses wide-int
instead of int as result now).
---
generic/tclCmdMZ.c | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index db4e57b1e..b1ba3ae01 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -3931,7 +3931,7 @@ Tcl_TimeObjCmd(
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
- objs[0] = Tcl_NewIntObj((count <= 0) ? 0 : (int) totalMicroSec);
+ objs[0] = Tcl_NewWideIntObj((count <= 0) ? 0 : (Tcl_WideInt)totalMicroSec);
} else {
objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
}
--
2.19.1

View File

@ -0,0 +1,43 @@
From a6ff061087eaf644eb30f0e8334059c5cbb0dbc1 Mon Sep 17 00:00:00 2001
From: sebres <sebres@users.sourceforge.net>
Date: Thu, 15 Nov 2018 22:31:39 +0000
Subject: [PATCH 1592/1800] fixes segfault [00d04c4f12], unfulfilled base64
(strict and non-strict mode, etc).
---
generic/tclBinary.c | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index bb918f27f..571eb07b1 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -2914,6 +2914,11 @@ BinaryDecode64(
} else if (i > 1) {
c = '=';
} else {
+ if (strict && i <= 1) {
+ /* single resp. unfulfilled char (each 4th next single char)
+ * is rather bad64 error case in strict mode */
+ goto bad64;
+ }
cut += 3;
break;
}
@@ -2944,9 +2949,11 @@ BinaryDecode64(
value = (value << 6) | 0x3e;
} else if (c == '/') {
value = (value << 6) | 0x3f;
- } else if (c == '=') {
+ } else if (c == '=' && (
+ !strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */
+ ) {
value <<= 6;
- cut++;
+ if (i) cut++;
} else if (strict || !isspace(c)) {
goto bad64;
} else {
--
2.19.1

155
new-package.patch Normal file
View File

@ -0,0 +1,155 @@
From 07fa7f623c1efa576128d3710689efed2bc427a0 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Sat, 16 Jun 2018 17:55:31 +0000
Subject: [PATCH 1251/1800] new package tcltests exclude some exec.test
tests when running under valgrind
---
tests/all.tcl | 9 +++++++++
tests/exec.test | 25 +++++++++++++++----------
tests/ioCmd.test | 1 -
tests/pkgIndex.tcl | 6 ++++++
4 files changed, 30 insertions(+), 11 deletions(-)
create mode 100644 tests/pkgIndex.tcl
diff --git a/tests/all.tcl b/tests/all.tcl
index 69a16ba0c..ad372dbb4 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -18,5 +18,14 @@ configure {*}$argv -testdir [file dir [info script]]
if {[singleProcess]} {
interp debug {} -frame 1
}
+
+set testsdir [file dirname [file dirname [file normalize [info script]/...]]]
+lappend auto_path $testsdir {*}[apply {{testsdir args} {
+ lmap x $args {
+ if {$x eq $testsdir} continue
+ lindex $x
+ }
+}} $testsdir {*}$auto_path]
+
runAllTests
proc exit args {}
diff --git a/tests/exec.test b/tests/exec.test
index 5542f3d8d..6570e5723 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -11,9 +11,14 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+# There is no point in running Valgrind on cases where [exec] forks but then
+# fails and the child process doesn't go through full cleanup.
+
package require tcltest 2
namespace import -force ::tcltest::*
+package require tcltests
+
# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
@@ -325,11 +330,11 @@ test exec-8.2 {long input and output} {exec} {
# Commands that return errors.
-test exec-9.1 {commands returning errors} {exec} {
+test exec-9.1 {commands returning errors} {exec notValgrind} {
set x [catch {exec gorp456} msg]
list $x [string tolower $msg] [string tolower $errorCode]
} {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.2 {commands returning errors} {exec} {
+test exec-9.2 {commands returning errors} {exec notValgrind} {
string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
} {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
@@ -339,7 +344,7 @@ test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
} -returnCodes error -result {foo bar
child process exited abnormally}
-test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
+test exec-9.5 {commands returning errors} -constraints {exec stdio notValgrind} -body {
exec gorp456 | [interpreter] echo a b c
} -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
test exec-9.6 {commands returning errors} -constraints {exec} -body {
@@ -428,13 +433,13 @@ test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
exec cat >@ $f
} -returnCodes error -result "channel \"$f\" wasn't opened for writing"
close $f
-test exec-10.20 {errors in exec invocation} -constraints {exec} -body {
+test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body {
exec ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
-test exec-10.21 {errors in exec invocation} -constraints {exec} -body {
+test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body {
exec [interpreter] true | ~xyzzy_bad_user/x | false
} -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
-test exec-10.22 {errors in exec invocation} -constraints exec -body {
+test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body {
exec echo test > ~non_existent_user/foo/bar
} -returnCodes error -result {user "non_existent_user" doesn't exist}
# Commands in background.
@@ -510,7 +515,7 @@ test exec-13.1 {setting errorCode variable} {exec} {
test exec-13.2 {setting errorCode variable} {exec} {
list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
} {1 {posix enoent {no such file or directory}}}
-test exec-13.3 {setting errorCode variable} {exec} {
+test exec-13.3 {setting errorCode variable} {exec notValgrind} {
set x [catch {exec _weird_cmd_} msg]
list $x [string tolower $msg] [lindex $errorCode 0] \
[string tolower [lrange $errorCode 2 end]]
@@ -548,7 +553,7 @@ test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
test exec-14.3 {unknown switch} -constraints {exec} -body {
exec -gorp
} -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --}
-test exec-14.4 {-- switch} -constraints {exec} -body {
+test exec-14.4 {-- switch} -constraints {exec notValgrind} -body {
exec -- -gorp
} -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
test exec-14.5 {-ignorestderr switch} {exec} {
@@ -662,7 +667,7 @@ test exec-18.2 {exec cat deals with weird file names} -body {
# Note that this test cannot be adapted to work on Windows; that platform has
# no kernel support for an analog of O_APPEND. OTOH, that means we can assume
# that there is a POSIX shell...
-test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
+test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind} -setup {
set tmpfile [makeFile {0} tmpfile.exec-19.1]
} -body {
# Note that we have to allow for the current contents of the temporary
@@ -675,7 +680,7 @@ test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
{for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
exec /bin/sh -c \
{for a in d e f; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
- # The above four shell invokations take about 3 seconds to finish, so allow
+ # The above four shell invocations take about 3 seconds to finish, so allow
# 5s (in case the machine is busy)
after 5000
# Check that no bytes have got lost through mixups with overlapping
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index cab4e9734..ae58025d9 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -3781,7 +3781,6 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
# Use constraints to skip this test while valgrinding so this expected leak
# doesn't prevent a finding of "leak-free".
#
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
#puts <<$tcltest::mainThread>>main
diff --git a/tests/pkgIndex.tcl b/tests/pkgIndex.tcl
new file mode 100644
index 000000000..48ab71b73
--- /dev/null
+++ b/tests/pkgIndex.tcl
@@ -0,0 +1,6 @@
+#! /usr/bin/env tclsh
+
+package ifneeded tcltests 0.1 {
+ source [file dirname [file dirname [file normalize [info script]/...]]]/tcltests.tcl
+ package provide tcltests 0.1
+}
--
2.19.1

46
oops.patch Normal file
View File

@ -0,0 +1,46 @@
From 15a2f423f0ea1de799f88ff78bcc8237e0afb5c8 Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Mar 2016 13:16:42 +0000
Subject: [PATCH 0239/1800] oops
---
generic/tclOOMethod.c | 4 +---
generic/tclTest.c | 4 ++--
2 files changed, 3 insertions(+), 5 deletions(-)
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 34fa10893..6c9a2eb8d 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -1540,9 +1540,7 @@ TclOOGetMethodBody(
if (mPtr->typePtr == &procMethodType) {
ProcedureMethod *pmPtr = mPtr->clientData;
- if (pmPtr->procPtr->bodyPtr->bytes == NULL) {
- (void) Tcl_GetString(pmPtr->procPtr->bodyPtr);
- }
+ (void) TclGetString(pmPtr->procPtr->bodyPtr);
return pmPtr->procPtr->bodyPtr;
}
return NULL;
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 5bfa8f7ca..d96e35641 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -7012,11 +7012,11 @@ TestconcatobjCmd(
list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
Tcl_ListObjLength(NULL, list1Ptr, &len);
- Tcl_InvalidateStringrep(list1Ptr);
+ Tcl_InvalidateStringRep(list1Ptr);
list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
Tcl_ListObjLength(NULL, list2Ptr, &len);
- Tcl_InvalidateStringrep(list2Ptr);
+ Tcl_InvalidateStringRep(list2Ptr);
/*
* Verify that concat'ing a list obj with one or more empty strings does
--
2.19.1

View File

@ -0,0 +1,37 @@
From d8f01a421223dcf58b22e4cffef613818efde1fa Mon Sep 17 00:00:00 2001
From: dgp <dgp@users.sourceforge.net>
Date: Thu, 24 Mar 2016 12:59:06 +0000
Subject: [PATCH 0238/1800] stay out of internals when nice interfaces are
available.
---
generic/tclTest.c | 10 ++--------
1 file changed, 2 insertions(+), 8 deletions(-)
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 7c30d36e7..5bfa8f7ca 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -7012,17 +7012,11 @@ TestconcatobjCmd(
list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
Tcl_ListObjLength(NULL, list1Ptr, &len);
- if (list1Ptr->bytes != NULL) {
- ckfree(list1Ptr->bytes);
- list1Ptr->bytes = NULL;
- }
+ Tcl_InvalidateStringrep(list1Ptr);
list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
Tcl_ListObjLength(NULL, list2Ptr, &len);
- if (list2Ptr->bytes != NULL) {
- ckfree(list2Ptr->bytes);
- list2Ptr->bytes = NULL;
- }
+ Tcl_InvalidateStringrep(list2Ptr);
/*
* Verify that concat'ing a list obj with one or more empty strings does
--
2.19.1

56
tcl-8.6.3-autopath.patch Normal file
View File

@ -0,0 +1,56 @@
diff --git a/library/auto.tcl b/library/auto.tcl
index 02edcc4..cd3b587 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -81,6 +81,13 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
lappend dirs [::${basename}::pkgconfig get scriptdir,runtime]
}
+ # 2a. As a sibling of Tcl's script directory
+ if {[catch {
+ ::tcl::pkgconfig get scriptdir,runtime
+ } value] == 0} {
+ lappend dirs [file join [file dirname $value] $basename$version]
+ }
+
# 3. Relative to auto_path directories. This checks relative to the
# Tcl library as well as allowing loading of libraries added to the
# auto_path that is not relative to the core library or binary paths.
diff --git a/library/init.tcl b/library/init.tcl
index f1f7704..03ede56 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -47,16 +47,11 @@ if {![info exists auto_path]} {
}
namespace eval tcl {
variable Dir
- foreach Dir [list $::tcl_library [file dirname $::tcl_library]] {
+ foreach Dir [list $::tcl_library] {
if {$Dir ni $::auto_path} {
lappend ::auto_path $Dir
}
}
- set Dir [file join [file dirname [file dirname \
- [info nameofexecutable]]] lib]
- if {$Dir ni $::auto_path} {
- lappend ::auto_path $Dir
- }
catch {
foreach Dir $::tcl_pkgPath {
if {$Dir ni $::auto_path} {
diff --git a/unix/configure.in b/unix/configure.in
index e44d554..c017eaa 100755
--- a/unix/configure.in
+++ b/unix/configure.in
@@ -886,9 +886,9 @@ if test "$FRAMEWORK_BUILD" = "1" ; then
test -z "$TCL_MODULE_PATH" && \
TCL_MODULE_PATH="~/Library/Tcl /Library/Tcl /System/Library/Tcl"
elif test "$prefix/lib" != "$libdir"; then
- TCL_PACKAGE_PATH="${libdir} ${prefix}/lib ${TCL_PACKAGE_PATH}"
+ TCL_PACKAGE_PATH="${libdir}/tcl8.6 ${prefix}/share/tcl8.6 ${libdir}/tk8.6 ${prefix}/share/tk8.6 ${TCL_PACKAGE_PATH}"
else
- TCL_PACKAGE_PATH="${prefix}/lib ${TCL_PACKAGE_PATH}"
+ TCL_PACKAGE_PATH="${libdir}/tcl8.6 ${prefix}/share/tcl8.6 ${libdir}/tk8.6 ${prefix}/share/tk8.6 ${TCL_PACKAGE_PATH}"
fi
#--------------------------------------------------------------------

View File

@ -0,0 +1,265 @@
diff --git a/unix/Makefile.in b/unix/Makefile.in
index bc73118..cc438a4 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1351,196 +1351,196 @@ tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c
tclTomMathInterface.o: $(GENERIC_DIR)/tclTomMathInterface.c $(MATHHDRS)
$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclTomMathInterface.c
-bncore.o: $(TOMMATH_DIR)/bncore.c $(MATHHDRS)
+bncore.o: $(TOMMATH_DIR)/bncore.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bncore.c
-bn_reverse.o: $(TOMMATH_DIR)/bn_reverse.c $(MATHHDRS)
+bn_reverse.o: $(TOMMATH_DIR)/bn_reverse.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_reverse.c
-bn_fast_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c $(MATHHDRS)
+bn_fast_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_fast_s_mp_mul_digs.c
-bn_fast_s_mp_sqr.o: $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c $(MATHHDRS)
+bn_fast_s_mp_sqr.o: $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_fast_s_mp_sqr.c
-bn_mp_add.o: $(TOMMATH_DIR)/bn_mp_add.c $(MATHHDRS)
+bn_mp_add.o: $(TOMMATH_DIR)/bn_mp_add.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add.c
-bn_mp_add_d.o: $(TOMMATH_DIR)/bn_mp_add_d.c $(MATHHDRS)
+bn_mp_add_d.o: $(TOMMATH_DIR)/bn_mp_add_d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_add_d.c
-bn_mp_and.o: $(TOMMATH_DIR)/bn_mp_and.c $(MATHHDRS)
+bn_mp_and.o: $(TOMMATH_DIR)/bn_mp_and.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_and.c
-bn_mp_clamp.o: $(TOMMATH_DIR)/bn_mp_clamp.c $(MATHHDRS)
+bn_mp_clamp.o: $(TOMMATH_DIR)/bn_mp_clamp.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_clamp.c
-bn_mp_clear.o: $(TOMMATH_DIR)/bn_mp_clear.c $(MATHHDRS)
+bn_mp_clear.o: $(TOMMATH_DIR)/bn_mp_clear.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_clear.c
-bn_mp_clear_multi.o: $(TOMMATH_DIR)/bn_mp_clear_multi.c $(MATHHDRS)
+bn_mp_clear_multi.o: $(TOMMATH_DIR)/bn_mp_clear_multi.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_clear_multi.c
-bn_mp_cmp.o: $(TOMMATH_DIR)/bn_mp_cmp.c $(MATHHDRS)
+bn_mp_cmp.o: $(TOMMATH_DIR)/bn_mp_cmp.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp.c
-bn_mp_cmp_d.o: $(TOMMATH_DIR)/bn_mp_cmp_d.c $(MATHHDRS)
+bn_mp_cmp_d.o: $(TOMMATH_DIR)/bn_mp_cmp_d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp_d.c
-bn_mp_cmp_mag.o: $(TOMMATH_DIR)/bn_mp_cmp_mag.c $(MATHHDRS)
+bn_mp_cmp_mag.o: $(TOMMATH_DIR)/bn_mp_cmp_mag.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cmp_mag.c
-bn_mp_cnt_lsb.o: $(TOMMATH_DIR)/bn_mp_cnt_lsb.c $(MATHHDRS)
+bn_mp_cnt_lsb.o: $(TOMMATH_DIR)/bn_mp_cnt_lsb.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_cnt_lsb.c
-bn_mp_copy.o: $(TOMMATH_DIR)/bn_mp_copy.c $(MATHHDRS)
+bn_mp_copy.o: $(TOMMATH_DIR)/bn_mp_copy.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_copy.c
-bn_mp_count_bits.o: $(TOMMATH_DIR)/bn_mp_count_bits.c $(MATHHDRS)
+bn_mp_count_bits.o: $(TOMMATH_DIR)/bn_mp_count_bits.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_count_bits.c
-bn_mp_div.o: $(TOMMATH_DIR)/bn_mp_div.c $(MATHHDRS)
+bn_mp_div.o: $(TOMMATH_DIR)/bn_mp_div.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div.c
-bn_mp_div_d.o: $(TOMMATH_DIR)/bn_mp_div_d.c $(MATHHDRS)
+bn_mp_div_d.o: $(TOMMATH_DIR)/bn_mp_div_d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_d.c
-bn_mp_div_2.o: $(TOMMATH_DIR)/bn_mp_div_2.c $(MATHHDRS)
+bn_mp_div_2.o: $(TOMMATH_DIR)/bn_mp_div_2.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_2.c
-bn_mp_div_2d.o: $(TOMMATH_DIR)/bn_mp_div_2d.c $(MATHHDRS)
+bn_mp_div_2d.o: $(TOMMATH_DIR)/bn_mp_div_2d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_2d.c
-bn_mp_div_3.o: $(TOMMATH_DIR)/bn_mp_div_3.c $(MATHHDRS)
+bn_mp_div_3.o: $(TOMMATH_DIR)/bn_mp_div_3.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_div_3.c
-bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS)
+bn_mp_exch.o: $(TOMMATH_DIR)/bn_mp_exch.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_exch.c
-bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS)
+bn_mp_expt_d.o: $(TOMMATH_DIR)/bn_mp_expt_d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_expt_d.c
-bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS)
+bn_mp_grow.o: $(TOMMATH_DIR)/bn_mp_grow.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_grow.c
-bn_mp_init.o: $(TOMMATH_DIR)/bn_mp_init.c $(MATHHDRS)
+bn_mp_init.o: $(TOMMATH_DIR)/bn_mp_init.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init.c
-bn_mp_init_copy.o: $(TOMMATH_DIR)/bn_mp_init_copy.c $(MATHHDRS)
+bn_mp_init_copy.o: $(TOMMATH_DIR)/bn_mp_init_copy.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_copy.c
-bn_mp_init_multi.o: $(TOMMATH_DIR)/bn_mp_init_multi.c $(MATHHDRS)
+bn_mp_init_multi.o: $(TOMMATH_DIR)/bn_mp_init_multi.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_multi.c
-bn_mp_init_set.o: $(TOMMATH_DIR)/bn_mp_init_set.c $(MATHHDRS)
+bn_mp_init_set.o: $(TOMMATH_DIR)/bn_mp_init_set.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set.c
-bn_mp_init_set_int.o: $(TOMMATH_DIR)/bn_mp_init_set_int.c $(MATHHDRS)
+bn_mp_init_set_int.o: $(TOMMATH_DIR)/bn_mp_init_set_int.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_set_int.c
-bn_mp_init_size.o:$(TOMMATH_DIR)/bn_mp_init_size.c $(MATHHDRS)
+bn_mp_init_size.o:$(TOMMATH_DIR)/bn_mp_init_size.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_init_size.c
-bn_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c $(MATHHDRS)
+bn_mp_karatsuba_mul.o: $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_karatsuba_mul.c
-bn_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c $(MATHHDRS)
+bn_mp_karatsuba_sqr.o: $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_karatsuba_sqr.c
-bn_mp_lshd.o: $(TOMMATH_DIR)/bn_mp_lshd.c $(MATHHDRS)
+bn_mp_lshd.o: $(TOMMATH_DIR)/bn_mp_lshd.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_lshd.c
-bn_mp_mod.o: $(TOMMATH_DIR)/bn_mp_mod.c $(MATHHDRS)
+bn_mp_mod.o: $(TOMMATH_DIR)/bn_mp_mod.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mod.c
-bn_mp_mod_2d.o: $(TOMMATH_DIR)/bn_mp_mod_2d.c $(MATHHDRS)
+bn_mp_mod_2d.o: $(TOMMATH_DIR)/bn_mp_mod_2d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mod_2d.c
-bn_mp_mul.o: $(TOMMATH_DIR)/bn_mp_mul.c $(MATHHDRS)
+bn_mp_mul.o: $(TOMMATH_DIR)/bn_mp_mul.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul.c
-bn_mp_mul_2.o: $(TOMMATH_DIR)/bn_mp_mul_2.c $(MATHHDRS)
+bn_mp_mul_2.o: $(TOMMATH_DIR)/bn_mp_mul_2.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul_2.c
-bn_mp_mul_2d.o: $(TOMMATH_DIR)/bn_mp_mul_2d.c $(MATHHDRS)
+bn_mp_mul_2d.o: $(TOMMATH_DIR)/bn_mp_mul_2d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul_2d.c
-bn_mp_mul_d.o: $(TOMMATH_DIR)/bn_mp_mul_d.c $(MATHHDRS)
+bn_mp_mul_d.o: $(TOMMATH_DIR)/bn_mp_mul_d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_mul_d.c
-bn_mp_neg.o: $(TOMMATH_DIR)/bn_mp_neg.c $(MATHHDRS)
+bn_mp_neg.o: $(TOMMATH_DIR)/bn_mp_neg.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_neg.c
-bn_mp_or.o: $(TOMMATH_DIR)/bn_mp_or.c $(MATHHDRS)
+bn_mp_or.o: $(TOMMATH_DIR)/bn_mp_or.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_or.c
-bn_mp_radix_size.o: $(TOMMATH_DIR)/bn_mp_radix_size.c $(MATHHDRS)
+bn_mp_radix_size.o: $(TOMMATH_DIR)/bn_mp_radix_size.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_size.c
-bn_mp_radix_smap.o: $(TOMMATH_DIR)/bn_mp_radix_smap.c $(MATHHDRS)
+bn_mp_radix_smap.o: $(TOMMATH_DIR)/bn_mp_radix_smap.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_radix_smap.c
-bn_mp_read_radix.o: $(TOMMATH_DIR)/bn_mp_read_radix.c $(MATHHDRS)
+bn_mp_read_radix.o: $(TOMMATH_DIR)/bn_mp_read_radix.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_read_radix.c
-bn_mp_rshd.o: $(TOMMATH_DIR)/bn_mp_rshd.c $(MATHHDRS)
+bn_mp_rshd.o: $(TOMMATH_DIR)/bn_mp_rshd.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_rshd.c
-bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS)
+bn_mp_set.o: $(TOMMATH_DIR)/bn_mp_set.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set.c
-bn_mp_set_int.o: $(TOMMATH_DIR)/bn_mp_set_int.c $(MATHHDRS)
+bn_mp_set_int.o: $(TOMMATH_DIR)/bn_mp_set_int.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_set_int.c
-bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS)
+bn_mp_shrink.o: $(TOMMATH_DIR)/bn_mp_shrink.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_shrink.c
-bn_mp_sqr.o: $(TOMMATH_DIR)/bn_mp_sqr.c $(MATHHDRS)
+bn_mp_sqr.o: $(TOMMATH_DIR)/bn_mp_sqr.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqr.c
-bn_mp_sqrt.o: $(TOMMATH_DIR)/bn_mp_sqrt.c $(MATHHDRS)
+bn_mp_sqrt.o: $(TOMMATH_DIR)/bn_mp_sqrt.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sqrt.c
-bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS)
+bn_mp_sub.o: $(TOMMATH_DIR)/bn_mp_sub.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub.c
-bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS)
+bn_mp_sub_d.o: $(TOMMATH_DIR)/bn_mp_sub_d.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_sub_d.c
-bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS)
+bn_mp_to_unsigned_bin.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin.c
-bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS)
+bn_mp_to_unsigned_bin_n.o: $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_to_unsigned_bin_n.c
-bn_mp_toom_mul.o: $(TOMMATH_DIR)/bn_mp_toom_mul.c $(MATHHDRS)
+bn_mp_toom_mul.o: $(TOMMATH_DIR)/bn_mp_toom_mul.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toom_mul.c
-bn_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_mp_toom_sqr.c $(MATHHDRS)
+bn_mp_toom_sqr.o: $(TOMMATH_DIR)/bn_mp_toom_sqr.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toom_sqr.c
-bn_mp_toradix_n.o: $(TOMMATH_DIR)/bn_mp_toradix_n.c $(MATHHDRS)
+bn_mp_toradix_n.o: $(TOMMATH_DIR)/bn_mp_toradix_n.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_toradix_n.c
-bn_mp_unsigned_bin_size.o: $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c $(MATHHDRS)
+bn_mp_unsigned_bin_size.o: $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_unsigned_bin_size.c
-bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS)
+bn_mp_xor.o: $(TOMMATH_DIR)/bn_mp_xor.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_xor.c
-bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS)
+bn_mp_zero.o: $(TOMMATH_DIR)/bn_mp_zero.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_mp_zero.c
-bn_s_mp_add.o: $(TOMMATH_DIR)/bn_s_mp_add.c $(MATHHDRS)
+bn_s_mp_add.o: $(TOMMATH_DIR)/bn_s_mp_add.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_add.c
-bn_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_s_mp_mul_digs.c $(MATHHDRS)
+bn_s_mp_mul_digs.o: $(TOMMATH_DIR)/bn_s_mp_mul_digs.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_mul_digs.c
-bn_s_mp_sqr.o: $(TOMMATH_DIR)/bn_s_mp_sqr.c $(MATHHDRS)
+bn_s_mp_sqr.o: $(TOMMATH_DIR)/bn_s_mp_sqr.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sqr.c
-bn_s_mp_sub.o: $(TOMMATH_DIR)/bn_s_mp_sub.c $(MATHHDRS)
+bn_s_mp_sub.o: $(TOMMATH_DIR)/bn_s_mp_sub.c $(MATHHDRS) $(DTRACE_HDR)
$(CC) -c $(CC_SWITCHES) $(TOMMATH_DIR)/bn_s_mp_sub.c
tclUnixChan.o: $(UNIX_DIR)/tclUnixChan.c $(IOHDR)

19
tcl-8.6.8-conf.patch Normal file
View File

@ -0,0 +1,19 @@
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 8a802fb..0df92fd 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -1402,12 +1402,12 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
# get rid of the warnings.
#CFLAGS_OPTIMIZE="${CFLAGS_OPTIMIZE} -D__NO_STRING_INLINES -D__NO_MATH_INLINES"
- SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared'
+ SHLIB_LD='${CC} ${CFLAGS} ${LDFLAGS} -shared -fPIC -Wl,-soname,${@}'
DL_OBJS="tclLoadDl.o"
DL_LIBS="-ldl"
LDFLAGS="$LDFLAGS -Wl,--export-dynamic"
AS_IF([test $doRpath = yes], [
- CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
+ CC_SEARCH_FLAGS=''])
LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
AS_IF([test "`uname -m`" = "alpha"], [CFLAGS="$CFLAGS -mieee"])
AS_IF([test $do64bit = yes], [

35
tcl-8.6.8-hidden.patch Normal file
View File

@ -0,0 +1,35 @@
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 91c8b96..623a598 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3215,7 +3215,7 @@ MODULE_SCOPE void TclClockInit(Tcl_Interp *interp);
MODULE_SCOPE int TclClockOldscanObjCmd(
ClientData clientData, Tcl_Interp *interp,
int objc, Tcl_Obj *const objv[]);
-MODULE_SCOPE int Tcl_CloseObjCmd(ClientData clientData,
+extern int Tcl_CloseObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ConcatObjCmd(ClientData clientData,
@@ -3396,7 +3396,7 @@ MODULE_SCOPE int Tcl_RenameObjCmd(ClientData clientData,
MODULE_SCOPE int Tcl_RepresentationCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-MODULE_SCOPE int Tcl_ReturnObjCmd(ClientData clientData,
+extern int Tcl_ReturnObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
MODULE_SCOPE int Tcl_ScanObjCmd(ClientData clientData,
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 12a60db..d817154 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -20,7 +20,7 @@
#if defined(_WIN32)
# include "tclWinPort.h"
#else
-# include "tclUnixPort.h"
+# include "../unix/tclUnixPort.h"
#endif
#include "tcl.h"

BIN
tcl-core8.6.8-src.tar.gz Normal file

Binary file not shown.

143
tcl.spec Normal file
View File

@ -0,0 +1,143 @@
%define MAJOR 8.6
Name: tcl
Version: 8.6.8
Release: 3
Epoch: 1
Summary: The Tool Command Language implementation
License: BSD
URL: https://sourceforge.net/projects/tcl/
Source0: http://downloads.sourceforge.net/sourceforge/tcl/tcl-core%{version}-src.tar.gz
BuildRequires: autoconf zlib-devel systemtap-sdt-devel
Provides: tcl(abi) = %{MAJOR}
Obsoletes: tcl-tcldict <= %{version}
Provides: tcl-tcldict = %{version}
#patch0000~0002 come from fedora
Patch0000: tcl-8.6.3-autopath.patch
Patch0001: tcl-8.6.8-conf.patch
Patch0002: tcl-8.6.8-hidden.patch
#patch0003 backport from https://core.tcl.tk/tcl/tktview/7d0db7c388f52de81faf12da332bc97a24f7b9e5
Patch0003: tcl-8.6.5-parallel-make-fix.patch
Patch6000: stay-out-of-internals-when-nice-interfaces-are-avail.patch
Patch6001: oops.patch
Patch6002: Fix-for-issue-9fd5c629c1-TclOO-aborts-when-a-trace-o.patch
Patch6003: Fix-bug-3c32a3f8bd-segmentation-fault-in-TclOO.c-Rel.patch
Patch6004: Fix-error-message-for-min-math-functions-to-for-for-.patch
Patch6005: Fix-behavior-of-Tcl_GetRange-and-string-range-regard.patch
Patch6006: Fix-11ae2be95d-tip-389-branch-string-range-errors-wi.patch
Patch6007: Improved-overflow-prevention-1.patch
Patch6008: Improved-overflow-prevention-2.patch
Patch6009: 27b682284974d0cd-command-file-delete-avoid-possible-.patch
Patch6010: Fix-handling-of-surrogates-when-TCL_UTF_MAX-3-in-Tcl.patch
Patch6011: Bug-fix-in-Tcl_UtfAtIndex-for-TCL_UTF_MAX-4-only-.-W.patch
Patch6012: new-package.patch
Patch6013: Plug-leak-in-TclSetEnv.patch
Patch6014: closes-d051b77fc18d7340-fixed-segfault-by-integer-ov.patch
Patch6015: amend-after-merge-8.6th-provide-additionally-an-erro.patch
Patch6016: In-registry-protect-keyName-from-being-NULL-This-act.patch
Patch6017: fixes-segfault-00d04c4f12-unfulfilled-base64-strict-.patch
Patch6018: fixes-4ee9b4f3e965a7da5133-result-of-command-time-ov.patch
Patch9000: fix-exec-test-error.patch
%description
Tcl(Tool Command Language) provides a powerful platform for creating integration applications
that tie together diverse applications, protocols, devices, and frameworks. When paired with
the Tk toolkit, Tcl provides the fastest and most powerful way to create GUI applications that
run on linux, Unix, and Mac OS X. Tcl can also be used for a variety of web-related tasks and
for creating powerful command languages for applications.
%package help
Summary: help document for tcl
Requires: %{name} = %{epoch}:%{version}-%{release}
BuildArch: noarch
%description help
Help document for tcl.
%package devel
Summary: The development files for tcl
Requires: %{name} = %{epoch}:%{version}-%{release}
%description devel
The development files for tcl.
%prep
%autosetup -n %{name}%{version} -p1
%build
cd unix
autoconf
%configure --enable-threads --enable-symbols --enable-shared --enable-dtrace
%make_build CFLAGS="%{optflags}" TCL_LIBRARY=%{_datadir}/%{name}%{MAJOR}
%install
cd unix
make INSTALL_ROOT=$RPM_BUILD_ROOT TCL_LIBRARY=%{_datadir}/%{name}%{MAJOR} install
cd ..
mv $RPM_BUILD_ROOT%{_bindir}/tclsh%{MAJOR} $RPM_BUILD_ROOT%{_bindir}/tclsh
ln -s lib%{name}%{MAJOR}.so $RPM_BUILD_ROOT%{_libdir}/lib%{name}.so
mkdir -p $RPM_BUILD_ROOT%{_libdir}/%{name}%{MAJOR}
ln -s %{_libdir}/%{name}Config.sh $RPM_BUILD_ROOT%{_libdir}/%{name}%{MAJOR}/%{name}Config.sh
mv license.terms COPYING
mkdir -p $RPM_BUILD_ROOT%{_includedir}/%{name}-private/generic
mkdir -p $RPM_BUILD_ROOT%{_includedir}/%{name}-private/unix
find generic unix -name "*.h" -exec cp -p '{}' %{buildroot}/%{_includedir}/%{name}-private/'{}' ';'
cd %{buildroot}/%{_includedir}
for header in *.h ; do
if [ -f %{buildroot}/%{_includedir}/%{name}-private/generic/$header ]; then
ln -sf ../../$header %{buildroot}/%{_includedir}/%{name}-private/generic
fi
done
sed -i -e "s|$PWD/unix|%{_libdir}|; s|$PWD|%{_includedir}/%{name}-private|" %{buildroot}/%{_libdir}/%{name}Config.sh
rm -rf %{buildroot}/%{_datadir}/%{name}%{MAJOR}/ldAix
%check
cd unix
make test
%pre
%preun
%post
/sbin/ldconfig
%postun
/sbin/ldconfig
%files
%defattr(-,root,root)
%doc README changes COPYING
%{_bindir}/tclsh
%{_datadir}/%{name}%{MAJOR}
%{_datadir}/%{name}8
%{_libdir}/lib%{name}%{MAJOR}.so
%exclude %{_datadir}/%{name}%{MAJOR}/tclAppInit.c
%files devel
%{_includedir}/*
%{_libdir}/lib%{name}stub%{MAJOR}.a
%{_libdir}/lib%{name}.so
%{_libdir}/%{name}Config.sh
%{_libdir}/%{name}ooConfig.sh
%{_libdir}/%{name}%{MAJOR}/%{name}Config.sh
%{_libdir}/pkgconfig/tcl.pc
%{_datadir}/%{name}%{MAJOR}/tclAppInit.c
%files help
%{_mandir}/man3/*
%{_mandir}/man1/*
%{_mandir}/mann/*
%changelog
* Mon Sep 09 2019 Huiming Xie <xiehuiming@huawei.com> - 1:8.6.8.3
- Package init