summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c4
-rw-r--r--generic/tclCkalloc.c6
-rw-r--r--generic/tclEvent.c7
-rw-r--r--generic/tclIOSock.c6
-rw-r--r--generic/tclProc.c6
-rw-r--r--generic/tclScan.c41
-rw-r--r--generic/tclStringObj.c44
7 files changed, 81 insertions, 33 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 8de3a0d..20b37dc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.21 1999/05/14 23:16:54 surles Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.22 1999/11/19 06:34:22 hobbs Exp $
*/
#include "tclInt.h"
@@ -2581,7 +2581,6 @@ Tcl_EvalObjEx(interp, objPtr, flags)
iPtr->numLevels++;
if (iPtr->numLevels > iPtr->maxNestingDepth) {
- iPtr->numLevels--;
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
result = TCL_ERROR;
@@ -2595,7 +2594,6 @@ Tcl_EvalObjEx(interp, objPtr, flags)
if (TclpCheckStackSpace() == 0) {
/*NOTREACHED*/
- iPtr->numLevels--;
Tcl_AppendToObj(Tcl_GetObjResult(interp),
"too many nested calls to Tcl_EvalObj (infinite loop?)", -1);
result = TCL_ERROR;
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index c24d9e0..a12f0cd 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -13,7 +13,7 @@
*
* This code contributed by Karl Lehenbauer and Mark Diekhans
*
- * RCS: @(#) $Id: tclCkalloc.c,v 1.6 1999/09/21 04:20:39 hobbs Exp $
+ * RCS: @(#) $Id: tclCkalloc.c,v 1.7 1999/11/19 06:34:23 hobbs Exp $
*/
#include "tclInt.h"
@@ -451,7 +451,7 @@ Tcl_DbCkfree(ptr, file, line)
struct mem_header *memp;
if (ptr == NULL) {
- return;
+ return 0;
}
/*
@@ -546,7 +546,7 @@ Tcl_DbCkrealloc(ptr, size, file, line)
new = Tcl_DbCkalloc(size, file, line);
memcpy((VOID *) new, (VOID *) ptr, (size_t) copySize);
Tcl_DbCkfree(ptr, file, line);
- return(new);
+ return new;
}
diff --git a/generic/tclEvent.c b/generic/tclEvent.c
index f237cd2..95f0abb 100644
--- a/generic/tclEvent.c
+++ b/generic/tclEvent.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclEvent.c,v 1.5 1999/04/23 01:57:08 stanton Exp $
+ * RCS: @(#) $Id: tclEvent.c,v 1.6 1999/11/19 06:34:23 hobbs Exp $
*/
#include "tclInt.h"
@@ -453,11 +453,12 @@ Tcl_DeleteExitHandler(proc, clientData)
} else {
prevPtr->nextPtr = exitPtr->nextPtr;
}
- Tcl_MutexUnlock(&exitMutex);
ckfree((char *) exitPtr);
- return;
+ break;
}
}
+ Tcl_MutexUnlock(&exitMutex);
+ return;
}
/*
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 3fb9e8d..1d6c642 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOSock.c,v 1.3 1999/04/16 00:46:47 stanton Exp $
+ * RCS: @(#) $Id: tclIOSock.c,v 1.4 1999/11/19 06:34:23 hobbs Exp $
*/
#include "tclInt.h"
@@ -91,8 +91,8 @@ TclSockMinimumBuffers(sock, size)
int size; /* Minimum buffer size */
{
int current;
- int len;
-
+ size_t len;
+
len = sizeof(int);
getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
if (current < size) {
diff --git a/generic/tclProc.c b/generic/tclProc.c
index ac07cae..901476a 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.20 1999/09/02 16:26:33 hobbs Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.21 1999/11/19 06:34:24 hobbs Exp $
*/
#include "tclInt.h"
@@ -502,8 +502,8 @@ TclGetFrame(interp, string, framePtrPtr)
}
if (level < 0) {
levelError:
- Tcl_AppendResult(interp, "bad level \"", string, "\"",
- (char *) NULL);
+ Tcl_AppendResult(interp, "bad level \"",
+ (result ? string : "1"), "\"", (char *) NULL);
return -1;
}
} else if (isdigit(UCHAR(*string))) { /* INTL: digit */
diff --git a/generic/tclScan.c b/generic/tclScan.c
index be4f8c4..3d7b37e 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclScan.c,v 1.4 1999/10/29 04:34:22 hobbs Exp $
+ * RCS: @(#) $Id: tclScan.c,v 1.5 1999/11/19 06:34:24 hobbs Exp $
*/
#include "tclInt.h"
@@ -269,7 +269,7 @@ ValidateFormat(interp, format, numVars, totalSubs)
Tcl_UniChar ch;
int staticAssign[STATIC_LIST_SIZE];
int *nassign = staticAssign;
- int objIndex, nspace = STATIC_LIST_SIZE;
+ int objIndex, xpgSize, nspace = STATIC_LIST_SIZE;
/*
* Initialize an array that records the number of times a variable
@@ -285,7 +285,7 @@ ValidateFormat(interp, format, numVars, totalSubs)
nassign[i] = 0;
}
- objIndex = gotXpg = gotSequential = 0;
+ xpgSize = objIndex = gotXpg = gotSequential = 0;
while (*format != '\0') {
format += Tcl_UtfToUniChar(format, &ch);
@@ -323,8 +323,16 @@ ValidateFormat(interp, format, numVars, totalSubs)
goto mixedXPG;
}
objIndex = value - 1;
- if ((objIndex < 0) || (objIndex >= numVars)) {
+ if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
goto badIndex;
+ } else if (numVars == 0) {
+ /*
+ * In the case where no vars are specified, the user can
+ * specify %9999$ legally, so we have to consider special
+ * rules for growing the assign array. 'value' is
+ * guaranteed to be > 0.
+ */
+ xpgSize = (xpgSize > value) ? xpgSize : value;
}
goto xpgCheckDone;
}
@@ -425,9 +433,16 @@ ValidateFormat(interp, format, numVars, totalSubs)
if (!(flags & SCAN_SUPPRESS)) {
if (objIndex >= nspace) {
/*
- * Expand the nassign buffer
+ * Expand the nassign buffer. If we are using XPG specifiers,
+ * make sure that we grow to a large enough size. xpgSize is
+ * guaranteed to be at least one larger than objIndex.
*/
- nspace += STATIC_LIST_SIZE;
+ value = nspace;
+ if (xpgSize) {
+ nspace = xpgSize;
+ } else {
+ nspace += STATIC_LIST_SIZE;
+ }
if (nassign == staticAssign) {
nassign = (void *)ckalloc(nspace * sizeof(int));
for (i = 0; i < STATIC_LIST_SIZE; ++i) {
@@ -437,7 +452,7 @@ ValidateFormat(interp, format, numVars, totalSubs)
nassign = (void *)ckrealloc((void *)nassign,
nspace * sizeof(int));
}
- for (i = nspace-STATIC_LIST_SIZE; i < nspace; i++) {
+ for (i = value; i < nspace; i++) {
nassign[i] = 0;
}
}
@@ -451,7 +466,11 @@ ValidateFormat(interp, format, numVars, totalSubs)
*/
if (numVars == 0) {
- numVars = objIndex;
+ if (xpgSize) {
+ numVars = xpgSize;
+ } else {
+ numVars = objIndex;
+ }
}
if (totalSubs) {
*totalSubs = numVars;
@@ -460,7 +479,11 @@ ValidateFormat(interp, format, numVars, totalSubs)
if (nassign[i] > 1) {
Tcl_SetResult(interp, "variable is assigned by multiple \"%n$\" conversion specifiers", TCL_STATIC);
goto error;
- } else if (nassign[i] == 0) {
+ } else if (!xpgSize && (nassign[i] == 0)) {
+ /*
+ * If the space is empty, and xpgSize is 0 (means XPG wasn't
+ * used, and/or numVars != 0), then too many vars were given
+ */
Tcl_SetResult(interp, "variable is not assigned by any conversion specifiers", TCL_STATIC);
goto error;
}
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index f9c9589..62cdef1 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStringObj.c,v 1.14 1999/10/29 03:04:00 hobbs Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.15 1999/11/19 06:34:25 hobbs Exp $ */
#include "tclInt.h"
@@ -275,7 +275,15 @@ Tcl_NewUnicodeObj(unicode, numChars)
{
Tcl_Obj *objPtr;
String *stringPtr;
- int uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
+ size_t uallocated;
+
+ if (numChars < 0) {
+ numChars = 0;
+ if (unicode) {
+ while (unicode[numChars] != 0) { numChars++; }
+ }
+ }
+ uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
/*
* Create a new obj with an invalid string rep.
@@ -289,8 +297,7 @@ Tcl_NewUnicodeObj(unicode, numChars)
stringPtr->numChars = numChars;
stringPtr->uallocated = uallocated;
stringPtr->allocated = 0;
- memcpy((VOID *) stringPtr->unicode, (VOID *) unicode,
- (size_t) (numChars * sizeof(Tcl_UniChar)));
+ memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
stringPtr->unicode[numChars] = 0;
SET_STRING(objPtr, stringPtr);
return objPtr;
@@ -338,7 +345,7 @@ Tcl_GetCharLength(objPtr)
* UTF chars are 1-byte long, we don't need to store the
* unicode string.
*/
-
+
stringPtr->uallocated = 0;
} else {
@@ -427,7 +434,7 @@ Tcl_GetUniChar(objPtr, index)
*
* Tcl_GetUnicode --
*
- * Get the index'th Unicode character from the String object. If
+ * 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 string format.
@@ -703,7 +710,15 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
{
Tcl_ObjType *typePtr;
String *stringPtr;
- size_t uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
+ size_t uallocated;
+
+ if (numChars < 0) {
+ numChars = 0;
+ if (unicode) {
+ while (unicode[numChars] != 0) { numChars++; }
+ }
+ }
+ uallocated = (numChars + 1) * sizeof(Tcl_UniChar);
/*
* Free the internal rep if one exists, and invalidate the string rep.
@@ -723,8 +738,7 @@ Tcl_SetUnicodeObj(objPtr, unicode, numChars)
stringPtr->numChars = numChars;
stringPtr->uallocated = uallocated;
stringPtr->allocated = 0;
- memcpy((VOID *) stringPtr->unicode, (VOID *) unicode,
- (size_t) (numChars * sizeof(Tcl_UniChar)));
+ memcpy((VOID *) stringPtr->unicode, (VOID *) unicode, uallocated);
stringPtr->unicode[numChars] = 0;
SET_STRING(objPtr, stringPtr);
Tcl_InvalidateStringRep(objPtr);
@@ -963,6 +977,12 @@ AppendUnicodeToUnicodeRep(objPtr, unicode, appendNumChars)
int numChars;
size_t newSize;
+ if (appendNumChars < 0) {
+ appendNumChars = 0;
+ if (unicode) {
+ while (unicode[appendNumChars] != 0) { appendNumChars++; }
+ }
+ }
if (appendNumChars == 0) {
return;
}
@@ -1027,6 +1047,12 @@ AppendUnicodeToUtfRep(objPtr, unicode, numChars)
Tcl_DString dsPtr;
char *bytes;
+ if (numChars < 0) {
+ numChars = 0;
+ if (unicode) {
+ while (unicode[numChars] != 0) { numChars++; }
+ }
+ }
if (numChars == 0) {
return;
}
generated by cgit v0.12 at 2024-11-07 05:38:45 (GMT)