summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/StringObj.318
-rw-r--r--generic/tcl.decls2
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclBinary.c18
-rw-r--r--generic/tclCkalloc.c4
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--generic/tclCompCmds.c12
-rw-r--r--generic/tclCompCmdsGR.c2
-rw-r--r--generic/tclCompCmdsSZ.c28
-rw-r--r--generic/tclCompile.h2
-rw-r--r--generic/tclDecls.h5
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclPathObj.c10
-rw-r--r--generic/tclStringObj.c25
-rw-r--r--generic/tclUtil.c3
-rw-r--r--tests/all.tcl9
-rw-r--r--tests/exec.test25
-rw-r--r--tests/ioCmd.test1
-rw-r--r--tests/pkgIndex.tcl6
-rw-r--r--unix/tcl.m47
20 files changed, 110 insertions, 79 deletions
diff --git a/doc/StringObj.3 b/doc/StringObj.3
index c805f7a..93d8868 100644
--- a/doc/StringObj.3
+++ b/doc/StringObj.3
@@ -87,29 +87,29 @@ Tcl_Obj *
Points to the first byte of an array of UTF-8-encoded bytes
used to set or append to a string value.
This byte array may contain embedded null characters
-unless \fInumChars\fR is negative. (Applications needing null bytes
+unless \fInumChars\fR is (size_t)-1. (Applications needing null bytes
should represent them as the two-byte sequence \fI\e700\e600\fR, use
\fBTcl_ExternalToUtf\fR to convert, or \fBTcl_NewByteArrayObj\fR if
the string is a collection of uninterpreted bytes.)
-.AP int length in
+.AP size_t length in
The number of bytes to copy from \fIbytes\fR when
initializing, setting, or appending to a string value.
-If negative, all bytes up to the first null are used.
+If (size_t)-1, all bytes up to the first null are used.
.AP "const Tcl_UniChar" *unicode in
Points to the first byte of an array of Unicode characters
used to set or append to a string value.
This byte array may contain embedded null characters
unless \fInumChars\fR is negative.
-.AP int numChars in
+.AP size_t numChars in
The number of Unicode characters to copy from \fIunicode\fR when
initializing, setting, or appending to a string value.
-If negative, all characters up to the first null character are used.
+If (size_t)-1, all characters up to the first null character are used.
.AP size_t index in
The index of the Unicode character to return.
-.AP int first in
+.AP size_t first in
The index of the first Unicode character in the Unicode range to be
returned as a new value.
-.AP int last in
+.AP size_t last in
The index of the last Unicode character in the Unicode range to be
returned as a new value.
.AP Tcl_Obj *objPtr in/out
@@ -124,7 +124,7 @@ Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
-.AP int limit in
+.AP size_t limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
@@ -137,7 +137,7 @@ Format control string including % conversion specifiers.
The number of elements to format or concatenate.
.AP Tcl_Obj *objv[] in
The array of values to format or concatenate.
-.AP int newLength in
+.AP size_t newLength in
New length for the string value of \fIobjPtr\fR, not including the
final null character.
.BE
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 906c817..431e9d2 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -1376,7 +1376,7 @@ declare 382 {
Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
}
declare 383 {
- Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, int first, int last)
+ Tcl_Obj *Tcl_GetRange(Tcl_Obj *objPtr, size_t first, size_t last)
}
declare 384 {
void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr, const Tcl_UniChar *unicode,
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2a3852c..705cccb 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4286,7 +4286,7 @@ TEOV_NotFound(
Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr,
&handlerObjc, &handlerObjv);
newObjc = objc + handlerObjc;
- newObjv = TclStackAlloc(interp, (int) sizeof(Tcl_Obj *) * newObjc);
+ newObjv = TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc);
/*
* Copy command prefix from unknown handler and add on the real command's
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 2814d4a..acc8fa5 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -752,9 +752,9 @@ TclAppendBytesToByteArray(
}
if (ptr == NULL) {
/* Try to allocate double the increment that is needed (plus). */
- unsigned int limit = INT_MAX - needed;
- unsigned int extra = len + TCL_MIN_GROWTH;
- int growth = (int) ((extra > limit) ? limit : extra);
+ size_t limit = INT_MAX - needed;
+ size_t extra = len + TCL_MIN_GROWTH;
+ size_t growth = (extra > limit) ? limit : extra;
attempt = needed + growth;
ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt));
@@ -2513,8 +2513,8 @@ BinaryDecodeHex(
badChar:
TclDecrRefCount(resultObj);
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid hexadecimal digit \"%c\" at position %d",
- c, (int) (data - datastart - 1)));
+ "invalid hexadecimal digit \"%c\" at position %td",
+ c, data - datastart - 1));
return TCL_ERROR;
}
@@ -2915,8 +2915,8 @@ BinaryDecodeUu(
badUu:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid uuencode character \"%c\" at position %d",
- c, (int) (data - datastart - 1)));
+ "invalid uuencode character \"%c\" at position %td",
+ c, data - datastart - 1));
Tcl_SetErrorCode(interp, "TCL", "BINARY", "DECODE", "INVALID", NULL);
TclDecrRefCount(resultObj);
return TCL_ERROR;
@@ -3065,8 +3065,8 @@ BinaryDecode64(
bad64:
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "invalid base64 character \"%c\" at position %d",
- (char) c, (int) (data - datastart - 1)));
+ "invalid base64 character \"%c\" at position %td",
+ (char) c, data - datastart - 1));
TclDecrRefCount(resultObj);
return TCL_ERROR;
}
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index f5a2340..35e868e 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -243,7 +243,7 @@ ValidateMemory(
guard_failed = TRUE;
fflush(stdout);
byte &= 0xff;
- fprintf(stderr, "low guard byte %d is 0x%x \t%c\n", (int)idx, byte,
+ fprintf(stderr, "low guard byte %zu is 0x%x \t%c\n", idx, byte,
(isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
}
}
@@ -264,7 +264,7 @@ ValidateMemory(
guard_failed = TRUE;
fflush(stdout);
byte &= 0xff;
- fprintf(stderr, "hi guard byte %d is 0x%x \t%c\n", (int)idx, byte,
+ fprintf(stderr, "hi guard byte %zu is 0x%x \t%c\n", idx, byte,
(isprint(UCHAR(byte)) ? byte : ' ')); /* INTL: bytes */
}
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 6a68e0e..15fefae 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1257,7 +1257,7 @@ Tcl_SplitObjCmd(
* byte in length.
*/
- while (*stringPtr && (p=strchr(stringPtr,(int)*splitChars)) != NULL) {
+ while (*stringPtr && (p=strchr(stringPtr,*splitChars)) != NULL) {
objPtr = Tcl_NewStringObj(stringPtr, p - stringPtr);
Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
stringPtr = p + 1;
@@ -4005,7 +4005,7 @@ Tcl_TimeObjCmd(
* Use int obj since we know time is not fractional. [Bug 1202178]
*/
- objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : (int) totalMicroSec);
+ objs[0] = Tcl_NewLongObj((count <= 0) ? 0 : totalMicroSec);
} else {
objs[0] = Tcl_NewDoubleObj(totalMicroSec/count);
}
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 95c6702..0fe7ceb 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -701,8 +701,8 @@ TclCompileCatchCmd(
/* Stack at this point on both branches: result returnCode */
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileCatchCmd: bad jump distance %d",
- (int)(CurrentOffset(envPtr) - jumpFixup.codeOffset));
+ Tcl_Panic("TclCompileCatchCmd: bad jump distance %td",
+ (CurrentOffset(envPtr) - jumpFixup.codeOffset));
}
/*
@@ -1863,8 +1863,8 @@ TclCompileDictUpdateCmd(
TclEmitInvoke(envPtr,INST_RETURN_STK);
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
- (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %td",
+ CurrentOffset(envPtr) - jumpFixup.codeOffset);
}
TclStackFree(interp, keyTokenPtrs);
return TCL_OK;
@@ -2225,8 +2225,8 @@ TclCompileDictWithCmd(
*/
if (TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127)) {
- Tcl_Panic("TclCompileDictCmd(update): bad jump distance %d",
- (int) (CurrentOffset(envPtr) - jumpFixup.codeOffset));
+ Tcl_Panic("TclCompileDictCmd(update): bad jump distance %td",
+ CurrentOffset(envPtr) - jumpFixup.codeOffset);
}
return TCL_OK;
}
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 9df7f49..969f4aa 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -434,7 +434,7 @@ TclCompileIfCmd(
jumpFalseDist += 3;
TclStoreInt4AtPtr(jumpFalseDist, (ifFalsePc + 1));
} else {
- Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%d\" updating ifFalse jump", (int) opCode);
+ Tcl_Panic("TclCompileIfCmd: unexpected opcode \"%u\" updating ifFalse jump", opCode);
}
}
}
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index ae16e6e..df512af 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1567,8 +1567,8 @@ TclSubstCompile(
/* Start */
if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad start jump distance %d",
- (int) (CurrentOffset(envPtr) - startFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad start jump distance %td",
+ CurrentOffset(envPtr) - startFixup.codeOffset);
}
}
@@ -1626,8 +1626,8 @@ TclSubstCompile(
TclAdjustStackDepth(1, envPtr);
/* BREAK destination */
if (TclFixupForwardJumpToHere(envPtr, &breakFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
- (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad break jump distance %td",
+ CurrentOffset(envPtr) - breakFixup.codeOffset);
}
OP( POP);
OP( POP);
@@ -1642,8 +1642,8 @@ TclSubstCompile(
TclAdjustStackDepth(2, envPtr);
/* CONTINUE destination */
if (TclFixupForwardJumpToHere(envPtr, &continueFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %d",
- (int) (CurrentOffset(envPtr) - continueFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad continue jump distance %td",
+ CurrentOffset(envPtr) - continueFixup.codeOffset);
}
OP( POP);
OP( POP);
@@ -1652,12 +1652,12 @@ TclSubstCompile(
TclAdjustStackDepth(2, envPtr);
/* RETURN + other destination */
if (TclFixupForwardJumpToHere(envPtr, &returnFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad return jump distance %d",
- (int) (CurrentOffset(envPtr) - returnFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad return jump distance %td",
+ CurrentOffset(envPtr) - returnFixup.codeOffset);
}
if (TclFixupForwardJumpToHere(envPtr, &otherFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad other jump distance %d",
- (int) (CurrentOffset(envPtr) - otherFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad other jump distance %td",
+ CurrentOffset(envPtr) - otherFixup.codeOffset);
}
/*
@@ -1669,8 +1669,8 @@ TclSubstCompile(
/* OK destination */
if (TclFixupForwardJumpToHere(envPtr, &okFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %d",
- (int) (CurrentOffset(envPtr) - okFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad ok jump distance %td",
+ CurrentOffset(envPtr) - okFixup.codeOffset);
}
if (count > 1) {
OP1(STR_CONCAT1, count);
@@ -1679,8 +1679,8 @@ TclSubstCompile(
/* CONTINUE jump to here */
if (TclFixupForwardJumpToHere(envPtr, &endFixup, 127)) {
- Tcl_Panic("TclCompileSubstCmd: bad end jump distance %d",
- (int) (CurrentOffset(envPtr) - endFixup.codeOffset));
+ Tcl_Panic("TclCompileSubstCmd: bad end jump distance %td",
+ CurrentOffset(envPtr) - endFixup.codeOffset);
}
bline = envPtr->line;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 4033134..ea97fa6 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -1529,7 +1529,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData,
* Macro to get the offset to the next instruction to be issued. The ANSI C
* "prototype" for this macro is:
*
- * static int CurrentOffset(CompileEnv *envPtr);
+ * static ptrdiff_t CurrentOffset(CompileEnv *envPtr);
*/
#define CurrentOffset(envPtr) \
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index f42188e..ee2f6f7 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1077,7 +1077,8 @@ EXTERN int Tcl_GetUniChar(Tcl_Obj *objPtr, size_t index);
/* 382 */
EXTERN Tcl_UniChar * Tcl_GetUnicode(Tcl_Obj *objPtr);
/* 383 */
-EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
+EXTERN Tcl_Obj * Tcl_GetRange(Tcl_Obj *objPtr, size_t first,
+ size_t last);
/* 384 */
EXTERN void Tcl_AppendUnicodeToObj(Tcl_Obj *objPtr,
const Tcl_UniChar *unicode, size_t length);
@@ -2186,7 +2187,7 @@ typedef struct TclStubs {
size_t (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
int (*tcl_GetUniChar) (Tcl_Obj *objPtr, size_t index); /* 381 */
Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
- Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
+ Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, size_t first, size_t last); /* 383 */
void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, size_t length); /* 384 */
int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
void (*tcl_SetNotifier) (Tcl_NotifierProcs *notifierProcPtr); /* 386 */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index da7565e..5b8bc01 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -8645,7 +8645,7 @@ PrintByteCodeInfo(
#endif /* TCL_COMPILE_STATS */
if (procPtr != NULL) {
fprintf(stdout,
- " Proc 0x%p, refCt %zd, args %d, compiled locals %d\n",
+ " Proc 0x%p, refCt %zu, args %d, compiled locals %d\n",
procPtr, procPtr->refCount, procPtr->numArgs,
procPtr->numCompiledLocals);
}
@@ -9063,8 +9063,8 @@ GetExceptRangeForPc(
ExceptionRange *rangeArrayPtr;
int numRanges = codePtr->numExceptRanges;
register ExceptionRange *rangePtr;
- int pcOffset = pc - codePtr->codeStart;
- register int start;
+ unsigned int pcOffset = pc - codePtr->codeStart;
+ unsigned int start;
if (numRanges == 0) {
return NULL;
diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c
index d890a12..7fa4198 100644
--- a/generic/tclPathObj.c
+++ b/generic/tclPathObj.c
@@ -668,7 +668,7 @@ TclPathPart(
Tcl_Obj *resultPtr =
TclNewFSPathObj(fsPathPtr->cwdPtr, fileName,
- (int)(length - strlen(extension)));
+ length - strlen(extension));
Tcl_IncrRefCount(resultPtr);
return resultPtr;
@@ -706,7 +706,7 @@ TclPathPart(
return pathPtr;
} else {
Tcl_Obj *root = Tcl_NewStringObj(fileName,
- (int) (length - strlen(extension)));
+ length - strlen(extension));
Tcl_IncrRefCount(root);
return root;
@@ -1100,7 +1100,7 @@ TclJoinPath(
Tcl_AppendToObj(res, &separator, 1);
TclGetStringFromObj(res, &length);
}
- Tcl_SetObjLength(res, length + (int) strlen(strElt));
+ Tcl_SetObjLength(res, length + strlen(strElt));
ptr = TclGetString(res) + length;
for (; *strElt != '\0'; strElt++) {
@@ -1338,12 +1338,12 @@ TclNewFSPathObj(
* things as needing more aggressive normalization that don't actually
* need it. No harm done.
*/
- for (p = addStrRep; len > 0; p++, len--) {
+ for (p = addStrRep; len+1 > 1; p++, len--) {
switch (state) {
case 0: /* So far only "." since last dirsep or start */
switch (*p) {
case '.':
- count++;
+ count = 1;
break;
case '/':
case '\\':
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index fc599a9..4d30374 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -676,14 +676,17 @@ Tcl_GetUnicodeFromObj(
Tcl_Obj *
Tcl_GetRange(
Tcl_Obj *objPtr, /* The Tcl object to find the range of. */
- int first, /* First index of the range. */
- int last) /* Last index of the range. */
+ size_t first, /* First index of the range. */
+ size_t last) /* Last index of the range. */
{
Tcl_Obj *newObjPtr; /* The Tcl object to find the range of. */
String *stringPtr;
int length;
- if (first < 0) {
+ if (last == (size_t)-2) {
+ last = (size_t)-1; /* For compatibility with pre-9.0 behavior */
+ }
+ if (first == (size_t)-1) {
first = 0;
}
@@ -695,10 +698,10 @@ Tcl_GetRange(
if (TclIsPureByteArray(objPtr)) {
unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length);
- if (last >= length) {
+ if (last+1 >= (size_t)(unsigned int)length+1) {
last = length - 1;
}
- if (last < first) {
+ if (last + 1 < first + 1) {
return Tcl_NewObj();
}
return Tcl_NewByteArrayObj(bytes + first, last - first + 1);
@@ -720,10 +723,10 @@ Tcl_GetRange(
TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length);
}
if (stringPtr->numChars == objPtr->length) {
- if (last >= (int)stringPtr->numChars) {
+ if (last + 1 >= stringPtr->numChars + 1) {
last = stringPtr->numChars - 1;
}
- if (last < first) {
+ if (last + 1 < first + 1) {
return Tcl_NewObj();
}
newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1);
@@ -740,19 +743,19 @@ Tcl_GetRange(
FillUnicodeRep(objPtr);
stringPtr = GET_STRING(objPtr);
}
- if (last > (int)stringPtr->numChars) {
+ if (last + 1 > stringPtr->numChars + 1) {
last = stringPtr->numChars;
}
- if (last < first) {
+ if (last + 1 < first + 1) {
return Tcl_NewObj();
}
#if TCL_UTF_MAX <= 4
/* See: bug [11ae2be95dac9417] */
- if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
+ if ((first + 1 > 1) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
++first;
}
- if ((last + 1 < (int)stringPtr->numChars)
+ if ((last + 1 < stringPtr->numChars)
&& ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
&& ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
++last;
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0b31370..65dc55c 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -3436,6 +3436,7 @@ TclGetIntForIndex(
const char *bytes;
if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
+ if (*indexPtr < -1) *indexPtr = -1;
return TCL_OK;
}
@@ -3480,6 +3481,7 @@ TclGetIntForIndex(
} else {
*indexPtr = first - second;
}
+ if (*indexPtr < -1) *indexPtr = -1;
return TCL_OK;
}
@@ -3533,6 +3535,7 @@ GetEndOffsetFromObj(
/* TODO: Handle overflow cases sensibly */
*indexPtr = endValue + (int)objPtr->internalRep.wideValue;
+ if ((*indexPtr < -1) && (endValue < 0)) *indexPtr = -1;
return TCL_OK;
}
diff --git a/tests/all.tcl b/tests/all.tcl
index 69a16ba..ad372db 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 3d1cd56..dfc44c4 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 cab4e97..ae58025 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 0000000..48ab71b
--- /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
+}
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index cf6345f..20d673a 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -91,11 +91,13 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
for i in `ls -d ${libdir} 2>/dev/null` \
`ls -d ${exec_prefix}/lib 2>/dev/null` \
`ls -d ${prefix}/lib 2>/dev/null` \
- `ls -d /usr/contrib/lib 2>/dev/null` \
`ls -d /usr/local/lib 2>/dev/null` \
+ `ls -d /usr/contrib/lib 2>/dev/null` \
`ls -d /usr/pkg/lib 2>/dev/null` \
`ls -d /usr/lib 2>/dev/null` \
`ls -d /usr/lib64 2>/dev/null` \
+ `ls -d /usr/local/lib/tcl9.0 2>/dev/null` \
+ `ls -d /usr/local/lib/tcl/tcl9.0 2>/dev/null` \
; do
if test -f "$i/tclConfig.sh" ; then
ac_cv_c_tclconfig="`(cd $i; pwd)`"
@@ -224,8 +226,11 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
`ls -d ${prefix}/lib 2>/dev/null` \
`ls -d /usr/local/lib 2>/dev/null` \
`ls -d /usr/contrib/lib 2>/dev/null` \
+ `ls -d /usr/pkg/lib 2>/dev/null` \
`ls -d /usr/lib 2>/dev/null` \
`ls -d /usr/lib64 2>/dev/null` \
+ `ls -d /usr/local/lib/tk9.0 2>/dev/null` \
+ `ls -d /usr/local/lib/tcl/tk9.0 2>/dev/null` \
; do
if test -f "$i/tkConfig.sh" ; then
ac_cv_c_tkconfig="`(cd $i; pwd)`"
generated by cgit v0.12 at 2025-03-23 21:13:22 (GMT)