From c5b0b72ed7cbfd413896d9c9b0cb7bdcf521fc53 Mon Sep 17 00:00:00 2001 From: dgp Date: Tue, 10 Nov 2015 16:31:29 +0000 Subject: [261a8a79f0] Integer overflow leads to segfault. --- generic/tclIO.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIO.c b/generic/tclIO.c index 9a4735f..7bc849e 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -5938,7 +5938,7 @@ TranslateInputEOL( break; default: /* In other modes, at most 2 src bytes become a dst byte. */ - if (srcLen > 2 * dstLen) { + if (srcLen/2 > dstLen) { srcLen = 2 * dstLen; } break; -- cgit v0.12 From f84d09bdd759fbee98108d0a097f322255fdf0e3 Mon Sep 17 00:00:00 2001 From: max Date: Wed, 11 Nov 2015 09:56:41 +0000 Subject: Remove unused calculation of the result set size from TclCreateSocketAddress() --- generic/tclIOSock.c | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index d578d19..c5b7d28 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -171,7 +171,7 @@ TclCreateSocketAddress( char *native = NULL, portbuf[TCL_INTEGER_SPACE], *portstring; const char *family = NULL; Tcl_DString ds; - int result, i; + int result; if (host != NULL) { native = Tcl_UtfToExternalDString(NULL, host, -1, &ds); @@ -279,11 +279,6 @@ TclCreateSocketAddress( *addrlist = v4head; } } - i = 0; - for (p = *addrlist; p != NULL; p = p->ai_next) { - i++; - } - return 1; } -- cgit v0.12 From e93e78ae999879629f4db62379c05fd53ca4db57 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Nov 2015 08:40:54 +0000 Subject: Fix [https://www.sqlite.org/src/info/34eb6911afee09e7|34eb6911af], taken over from SQLite: Fix uses of ctype functions (ex: isspace()) on signed characters in test programs and in some obscure extensions. No changes to the core. --- win/nmakehlp.c | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/win/nmakehlp.c b/win/nmakehlp.c index d0edcf0..84cf75c 100644 --- a/win/nmakehlp.c +++ b/win/nmakehlp.c @@ -498,9 +498,10 @@ GetVersionFromFile( p = strstr(szBuffer, match); if (p != NULL) { /* - * Skip to first digit. + * Skip to first digit after the match. */ + p += strlen(match); while (*p && !isdigit(*p)) { ++p; } @@ -605,8 +606,8 @@ SubstituteFile( sp = fopen(substitutions, "rt"); if (sp != NULL) { while (fgets(szBuffer, cbBuffer, sp) != NULL) { - char *ks, *ke, *vs, *ve; - ks = szBuffer; + unsigned char *ks, *ke, *vs, *ve; + ks = (unsigned char*)szBuffer; while (ks && *ks && isspace(*ks)) ++ks; ke = ks; while (ke && *ke && !isspace(*ke)) ++ke; @@ -615,7 +616,7 @@ SubstituteFile( ve = vs; while (ve && *ve && !(*ve == '\r' || *ve == '\n')) ++ve; *ke = 0, *ve = 0; - list_insert(&substPtr, ks, vs); + list_insert(&substPtr, (char*)ks, (char*)vs); } fclose(sp); } @@ -630,11 +631,11 @@ SubstituteFile( } } #endif - + /* * Run the substitutions over each line of the input */ - + while (fgets(szBuffer, cbBuffer, fp) != NULL) { list_item_t *p = NULL; for (p = substPtr; p != NULL; p = p->nextPtr) { @@ -654,7 +655,7 @@ SubstituteFile( } printf(szBuffer); } - + list_free(&substPtr); } fclose(fp); -- cgit v0.12 From 31b415218813b465bfd99d4d79ae85e95c90028f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 16 Nov 2015 10:32:40 +0000 Subject: =?UTF-8?q?Fix=20--enable-symbols=20build=20on=20Cygwin.=20Reporte?= =?UTF-8?q?d=20by=20Fran=C3=A7ois=20Vogel?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- unix/Makefile.in | 2 +- win/Makefile.in | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/unix/Makefile.in b/unix/Makefile.in index 1f2cd77..84d0391 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -560,7 +560,7 @@ ${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${STUB_LIB_FILE}: ${STUB_LIB_OBJS} @if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \ - (cd ${TOP_DIR}/win; ${MAKE} libtclstub${MAJOR_VERSION}${MINOR_VERSION}.a); \ + (cd ${TOP_DIR}/win; ${MAKE} winextensions); \ fi rm -f $@ @MAKE_STUB_LIB@ diff --git a/win/Makefile.in b/win/Makefile.in index e9a28c4..ada9448 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -400,6 +400,8 @@ winhelp: $(ROOT_DIR)/tools/man2help.tcl $(MAN2TCL) ./$(TCLSH) "$(ROOT_DIR_NATIVE)"/tools/man2help.tcl tcl "$(VER)" $(TCL_DOCS) hcw /c /e tcl.hpj +winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} + $(MAN2TCL): $(ROOT_DIR)/tools/man2tcl.c $(CC) $(CFLAGS_OPTIMIZE) $(MAN2TCLFLAGS) -o $(MAN2TCL) "$(ROOT_DIR_NATIVE)"/tools/man2tcl.c -- cgit v0.12 From 0c95d1d7c2d07e8a422b8af055160e8009e7eeb4 Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 17 Nov 2015 17:01:58 +0000 Subject: Spanish translation of example corrected --- doc/msgcat.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/msgcat.n b/doc/msgcat.n index 7e46528..34e153d 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -384,7 +384,7 @@ the package. For example, a short \fBes.msg\fR might contain: .PP .CS namespace eval ::mypackage { - \fB::msgcat::mcflset\fR "Free Beer!" "Cerveza Gracias!" + \fB::msgcat::mcflset\fR "Free Beer" "Cerveza Gratis" } .CE .SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES" -- cgit v0.12 From 5498d8aaa43327e94fd652a66fde74f4187452db Mon Sep 17 00:00:00 2001 From: oehhar Date: Tue, 17 Nov 2015 17:07:33 +0000 Subject: Spanish translation of example corrected --- doc/msgcat.n | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/msgcat.n b/doc/msgcat.n index bae6dbe..b4f7140 100644 --- a/doc/msgcat.n +++ b/doc/msgcat.n @@ -321,7 +321,7 @@ the package. For example, a short \fBes.msg\fR might contain: .PP .CS namespace eval ::mypackage { - \fB::msgcat::mcflset\fR "Free Beer!" "Cerveza Gracias!" + \fB::msgcat::mcflset\fR "Free Beer" "Cerveza Gratis" } .CE .SH "RECOMMENDED MESSAGE SETUP FOR PACKAGES" -- cgit v0.12 From c32d032cbd7947d9e64e931df87fc4f374d81e7f Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 20 Nov 2015 15:47:30 +0000 Subject: [40f628e8e3] Tcl_ListObjReplace() callers need to handle TCL_ERROR. --- generic/tclCmdIL.c | 10 ++++++++-- generic/tclUtil.c | 8 +++++++- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index ea9c1e4..02e5812 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -2233,7 +2233,10 @@ Tcl_LinsertObjCmd( Tcl_ListObjAppendElement(NULL, listPtr, objv[3]); } else { - Tcl_ListObjReplace(NULL, listPtr, index, 0, (objc-3), &(objv[3])); + if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, index, 0, + (objc-3), &(objv[3]))) { + return TCL_ERROR; + } } /* @@ -2598,7 +2601,10 @@ Tcl_LreplaceObjCmd( * optimize this case away. */ - Tcl_ListObjReplace(NULL, listPtr, first, numToDelete, objc-4, &(objv[4])); + if (TCL_OK != Tcl_ListObjReplace(interp, listPtr, first, numToDelete, + objc-4, &(objv[4]))) { + return TCL_ERROR; + } /* * Set the interpreter's object result. diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 69d0b17..bc1490e 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1791,7 +1791,12 @@ Tcl_ConcatObj( TclListObjGetElements(NULL, objPtr, &listc, &listv); if (listc) { if (resPtr) { - Tcl_ListObjReplace(NULL, resPtr, INT_MAX, 0, listc, listv); + if (TCL_OK != Tcl_ListObjReplace(NULL, resPtr, + INT_MAX, 0, listc, listv)) { + /* Abandon ship! */ + Tcl_DecrRefCount(resPtr); + goto slow; + } } else { resPtr = TclListObjCopy(NULL, objPtr); } @@ -1808,6 +1813,7 @@ Tcl_ConcatObj( * the slow way, using the string representations. */ + slow: /* First try to pre-allocate the size required */ for (i = 0; i < objc; i++) { element = TclGetStringFromObj(objv[i], &elemLength); -- cgit v0.12 From dfbac0054227702fab645e6c03d08c35a8dd9b7c Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 20 Nov 2015 16:58:11 +0000 Subject: [3293874] Simplified fix (not backport). Also detect >LIST_MAX early. --- generic/tclListObj.c | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 289cf2d..c4b5cfc 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -854,8 +854,13 @@ Tcl_ListObjReplace( count = numElems - first; } + if (objc > LIST_MAX - (numElems - count)) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "max length of a Tcl list (%d elements) exceeded", LIST_MAX)); + return TCL_ERROR; + } isShared = (listRepPtr->refCount > 1); - numRequired = numElems - count + objc; + numRequired = numElems - count + objc; /* Known <= LIST_MAX */ for (i = 0; i < objc; i++) { Tcl_IncrRefCount(objv[i]); @@ -906,6 +911,8 @@ Tcl_ListObjReplace( listRepPtr = AttemptNewList(interp, newMax, NULL); if (listRepPtr == NULL) { + listRepPtr = AttemptNewList(interp, numRequired, NULL); + if (listRepPtr == NULL) { for (i = 0; i < objc; i++) { /* See bug 3598580 */ #if TCL_MAJOR_VERSION > 8 @@ -916,6 +923,7 @@ Tcl_ListObjReplace( } return TCL_ERROR; } + } listPtr->internalRep.twoPtrValue.ptr1 = (void *) listRepPtr; listRepPtr->refCount++; -- cgit v0.12 From 6b4bc6bb8d46722088d73bd4a93f51e7fc65dbf4 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 21 Nov 2015 22:22:49 +0000 Subject: [3d96b7076e] Prevent crashes when destroying an object's class inside a method call. --- generic/tclOO.c | 20 +++++++++++++++---- generic/tclOODefineCmds.c | 15 ++++++++++---- generic/tclOOInfo.c | 12 +++++++++++ generic/tclOOInt.h | 3 +++ tests/oo.test | 51 +++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 93 insertions(+), 8 deletions(-) diff --git a/generic/tclOO.c b/generic/tclOO.c index 84bb85a..5fca220 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -951,6 +951,16 @@ ReleaseClassContents( } if (!IsRootClass(oPtr)) { FOREACH(instancePtr, clsPtr->instances) { + int j; + if (instancePtr->selfCls == clsPtr) { + instancePtr->flags |= CLASS_GONE; + } + for(j=0 ; jmixins.num ; j++) { + Class *mixin = instancePtr->mixins.list[j]; + if (mixin == clsPtr) { + instancePtr->mixins.list[j] = NULL; + } + } if (instancePtr != NULL && !IsRoot(instancePtr)) { AddRef(instancePtr); } @@ -1131,12 +1141,14 @@ ObjectNamespaceDeleted( * methods on the object. */ - if (!IsRootObject(oPtr)) { + if (!IsRootObject(oPtr) && !(oPtr->flags & CLASS_GONE)) { TclOORemoveFromInstances(oPtr, oPtr->selfCls); } FOREACH(mixinPtr, oPtr->mixins) { - TclOORemoveFromInstances(oPtr, mixinPtr); + if (mixinPtr) { + TclOORemoveFromInstances(oPtr, mixinPtr); + } } if (i) { ckfree(oPtr->mixins.list); @@ -1908,13 +1920,13 @@ Tcl_CopyObjectInstance( */ FOREACH(mixinPtr, o2Ptr->mixins) { - if (mixinPtr != o2Ptr->selfCls) { + if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOORemoveFromInstances(o2Ptr, mixinPtr); } } DUPLICATE(o2Ptr->mixins, oPtr->mixins, Class *); FOREACH(mixinPtr, o2Ptr->mixins) { - if (mixinPtr != o2Ptr->selfCls) { + if (mixinPtr && mixinPtr != o2Ptr->selfCls) { TclOOAddToInstances(o2Ptr, mixinPtr); } } diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index 85f6c31..c880754 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -323,7 +323,9 @@ TclOOObjectSetMixins( if (numMixins == 0) { if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { - TclOORemoveFromInstances(oPtr, mixinPtr); + if (mixinPtr) { + TclOORemoveFromInstances(oPtr, mixinPtr); + } } ckfree(oPtr->mixins.list); oPtr->mixins.num = 0; @@ -332,7 +334,7 @@ TclOOObjectSetMixins( } else { if (oPtr->mixins.num != 0) { FOREACH(mixinPtr, oPtr->mixins) { - if (mixinPtr != oPtr->selfCls) { + if (mixinPtr && mixinPtr != oPtr->selfCls) { TclOORemoveFromInstances(oPtr, mixinPtr); } } @@ -1213,6 +1215,9 @@ TclOODefineClassObjCmd( TclOORemoveFromInstances(oPtr, oPtr->selfCls); oPtr->selfCls = clsPtr; TclOOAddToInstances(oPtr, oPtr->selfCls); + if (!(clsPtr->thisPtr->flags & OBJECT_DELETED)) { + oPtr->flags &= ~CLASS_GONE; + } if (oPtr->classPtr != NULL) { BumpGlobalEpoch(interp, oPtr->classPtr); } else { @@ -2509,8 +2514,10 @@ ObjMixinGet( resultObj = Tcl_NewObj(); FOREACH(mixinPtr, oPtr->mixins) { - Tcl_ListObjAppendElement(NULL, resultObj, - TclOOObjectName(interp, mixinPtr->thisPtr)); + if (mixinPtr) { + Tcl_ListObjAppendElement(NULL, resultObj, + TclOOObjectName(interp, mixinPtr->thisPtr)); + } } Tcl_SetObjResult(interp, resultObj); return TCL_OK; diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 0c22bcf..76eaef5 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -196,6 +196,9 @@ InfoObjectClassCmd( } FOREACH(mixinPtr, oPtr->mixins) { + if (!mixinPtr) { + continue; + } if (TclOOIsReachable(o2clsPtr, mixinPtr)) { Tcl_SetObjResult(interp, Tcl_NewIntObj(1)); return TCL_OK; @@ -467,6 +470,9 @@ InfoObjectIsACmd( Class *mixinPtr; FOREACH(mixinPtr, oPtr->mixins) { + if (!mixinPtr) { + continue; + } if (TclOOIsReachable(o2Ptr->classPtr, mixinPtr)) { result = 1; break; @@ -665,6 +671,9 @@ InfoObjectMixinsCmd( resultObj = Tcl_NewObj(); FOREACH(mixinPtr, oPtr->mixins) { + if (!mixinPtr) { + continue; + } Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } @@ -1281,6 +1290,9 @@ InfoClassMixinsCmd( resultObj = Tcl_NewObj(); FOREACH(mixinPtr, clsPtr->mixins) { + if (!mixinPtr) { + continue; + } Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 208e32c..b75ffdb 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -193,6 +193,9 @@ typedef struct Object { * destroyed. */ #define DESTRUCTOR_CALLED 2 /* Flag to say that the destructor has been * called. */ +#define CLASS_GONE 4 /* Indicates that the class of this object has + * been deleted, and so the object should not + * attempt to remove itself from its class. */ #define ROOT_OBJECT 0x1000 /* Flag to say that this object is the root of * the class hierarchy and should be treated * specially during teardown. */ diff --git a/tests/oo.test b/tests/oo.test index c83e015..2112f10 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -638,6 +638,57 @@ test oo-3.9 {Bug 2944404: deleting the object in the destructor} -setup { } -cleanup { cls destroy } -result {in destructor} +test oo-3.10 {Bug 3d96b7076e: killing the object's class in a method call} -setup { + oo::class create Super +} -body { + # Only reliably failed in a memdebug build + oo::class create Cls { + superclass Super + method mthd {} { + [self class] destroy + return ok + } + } + [Cls new] mthd +} -cleanup { + Super destroy +} -result ok +test oo-3.11 {Bug 3d96b7076e: killing the object's class in a method call} -setup { + oo::class create Super + oo::class create Sub { + superclass Super + } +} -body { + # Only reliably failed in a memdebug build + oo::class create Cls { + superclass Super + method mthd {} { + oo::objdefine [self] class Sub + Cls destroy + return ok + } + } + [Cls new] mthd +} -cleanup { + Super destroy +} -result ok +test oo-3.12 {Bug 3d96b7076e: killing the object's class in a method call} -setup { + oo::class create Super +} -body { + # Only reliably failed in a memdebug build + oo::class create Cls { + superclass Super + method mthd {} { + [self class] destroy + return ok + } + } + set o [Super new] + oo::objdefine $o mixin Cls + $o mthd +} -cleanup { + Super destroy +} -result ok test oo-4.1 {basic test of OO functionality: export} { set o [oo::object new] -- cgit v0.12 From 5eeef96ee9e6fbb573a438338662fea9ca7c0efd Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sun, 22 Nov 2015 21:02:29 +0000 Subject: Cherrypick [812a81812ebf89d2416059d45fabd27e45603f5e|812a81812e]: Turn off NRE asserts by default. About a 5% speedup on [clock format]. --- generic/regc_nfa.c | 12 ++++++------ generic/tclBasic.c | 3 --- generic/tclExecute.c | 3 --- generic/tclInt.h | 4 +++- 4 files changed, 9 insertions(+), 13 deletions(-) diff --git a/generic/regc_nfa.c b/generic/regc_nfa.c index 0e0343e..088c6c0 100644 --- a/generic/regc_nfa.c +++ b/generic/regc_nfa.c @@ -293,7 +293,7 @@ newarc( } } } - + /* no dup, so create the arc */ createarc(nfa, t, co, from, to); } @@ -657,7 +657,7 @@ sortins_cmp( } return 0; } - + /* * sortouts - sort the out arcs of a state by to/color/type */ @@ -2020,7 +2020,7 @@ fixempties( arcarray[arccount++] = a; } } - + /* Reset the tmp fields as we walk back */ nexts = s2->tmp; s2->tmp = NULL; @@ -2042,7 +2042,7 @@ fixempties( } inarcsorig[s->no] = a; } - + FREE(arcarray); FREE(inarcsorig); @@ -2193,7 +2193,7 @@ fixconstraintloops( dropstate(nfa, s); } } - + /* Nothing to do if no remaining constraint arcs */ if (NISERR() || !hasconstraints) { return; @@ -2909,7 +2909,7 @@ carc_cmp( { const struct carc *aa = (const struct carc *) a; const struct carc *bb = (const struct carc *) b; - + if (aa->co < bb->co) { return -1; } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a09bf10..5c5bc64 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -22,10 +22,7 @@ #include "tclCompile.h" #include "tommath.h" #include - -#if NRE_ENABLE_ASSERTS #include -#endif #define INTERP_STACK_INITIAL_SIZE 2000 #define CORO_STACK_INITIAL_SIZE 200 diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 7f65262..b10af65 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -20,10 +20,7 @@ #include "tclOOInt.h" #include "tommath.h" #include - -#if NRE_ENABLE_ASSERTS #include -#endif /* * Hack to determine whether we may expect IEEE floating point. The hack is diff --git a/generic/tclInt.h b/generic/tclInt.h index f9d2edf..082fab4 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4791,7 +4791,9 @@ void Tcl_Panic(const char *, ...) __attribute__((analyzer_noreturn)); */ #define NRE_USE_SMALL_ALLOC 1 /* Only turn off for debugging purposes. */ -#define NRE_ENABLE_ASSERTS 1 +#ifndef NRE_ENABLE_ASSERTS +#define NRE_ENABLE_ASSERTS 0 +#endif /* * This is the main data struct for representing NR commands. It is designed -- cgit v0.12 From 48ac4215cf78865b39eadc4341f8c59def82aa12 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 24 Nov 2015 09:00:27 +0000 Subject: Make ::tcl::tm::roots work for alpha/beta Tcl releases. (backported from "novem", will be needed anyway for whatever future developments) --- library/tm.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tm.tcl b/library/tm.tcl index 55efda6..66c56a1 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -354,7 +354,7 @@ proc ::tcl::tm::Defaults {} { # Calls 'path add' to paths to the list of module search paths. proc ::tcl::tm::roots {paths} { - lassign [split [package present Tcl] .] major minor + regexp {^(\d+)\.(\d+)} [package present Tcl] - major minor foreach pa $paths { set p [file join $pa tcl$major] for {set n $minor} {$n >= 0} {incr n -1} { -- cgit v0.12