summaryrefslogtreecommitdiffstats
path: root/generic/tclUtil.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclUtil.c')
-rw-r--r--generic/tclUtil.c308
1 files changed, 153 insertions, 155 deletions
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 3565165..f41830a 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -13,7 +13,6 @@
*/
#include "tclInt.h"
-#include <float.h>
#include <math.h>
/*
@@ -42,11 +41,11 @@ static ProcessGlobalValue executableName = {
* BRACES_UNMATCHED - 1 means that braces aren't properly matched in
* the argument.
* TCL_DONT_QUOTE_HASH - 1 means the caller insists that a leading hash
- * character ('#') should *not* be quoted. This
- * is appropriate when the caller can guarantee
- * the element is not the first element of a
- * list, so [eval] cannot mis-parse the element
- * as a comment.
+ * character ('#') should *not* be quoted. This
+ * is appropriate when the caller can guarantee
+ * the element is not the first element of a
+ * list, so [eval] cannot mis-parse the element
+ * as a comment.
*/
#define USE_BRACES 2
@@ -67,9 +66,9 @@ static void ClearHash(Tcl_HashTable *tablePtr);
static void FreeProcessGlobalValue(ClientData clientData);
static void FreeThreadHash(ClientData clientData);
static Tcl_HashTable * GetThreadHash(Tcl_ThreadDataKey *keyPtr);
-static int SetEndOffsetFromAny(Tcl_Interp* interp,
- Tcl_Obj* objPtr);
-static void UpdateStringOfEndOffset(Tcl_Obj* objPtr);
+static int SetEndOffsetFromAny(Tcl_Interp *interp,
+ Tcl_Obj *objPtr);
+static void UpdateStringOfEndOffset(Tcl_Obj *objPtr);
/*
* The following is the Tcl object type definition for an object that
@@ -78,7 +77,7 @@ static void UpdateStringOfEndOffset(Tcl_Obj* objPtr);
* integer, so no memory management is required for it.
*/
-Tcl_ObjType tclEndOffsetType = {
+const Tcl_ObjType tclEndOffsetType = {
"end-offset", /* name */
NULL, /* freeIntRepProc */
NULL, /* dupIntRepProc */
@@ -125,13 +124,13 @@ TclFindElement(
Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
- CONST char *list, /* Points to the first byte of a string
+ const char *list, /* Points to the first byte of a string
* containing a Tcl list with zero or more
* elements (possibly in braces). */
int listLength, /* Number of bytes in the list's string. */
- CONST char **elementPtr, /* Where to put address of first significant
+ const char **elementPtr, /* Where to put address of first significant
* character in first element of list. */
- CONST char **nextPtr, /* Fill in with location of character just
+ const char **nextPtr, /* Fill in with location of character just
* after all white space following end of
* argument (next arg or end of list). */
int *sizePtr, /* If non-zero, fill in with size of
@@ -139,14 +138,14 @@ TclFindElement(
int *bracePtr) /* If non-zero, fill in with non-zero/zero to
* indicate that arg was/wasn't in braces. */
{
- CONST char *p = list;
- CONST char *elemStart; /* Points to first byte of first element. */
- CONST char *limit; /* Points just after list's last byte. */
+ const char *p = list;
+ const char *elemStart; /* Points to first byte of first element. */
+ const char *limit; /* Points just after list's last byte. */
int openBraces = 0; /* Brace nesting level during parse. */
int inQuotes = 0;
int size = 0; /* lint. */
int numChars;
- CONST char *p2;
+ const char *p2;
/*
* Skim off leading white space and check for an opening brace or quote.
@@ -344,7 +343,7 @@ TclFindElement(
int
TclCopyAndCollapse(
int count, /* Number of byte to copy from src. */
- CONST char *src, /* Copy from here... */
+ const char *src, /* Copy from here... */
char *dst) /* ... to here. */
{
int newCount = 0;
@@ -403,13 +402,13 @@ int
Tcl_SplitList(
Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, no error message is left. */
- CONST char *list, /* Pointer to string with list structure. */
+ const char *list, /* Pointer to string with list structure. */
int *argcPtr, /* Pointer to location to fill in with the
* number of elements in the list. */
- CONST char ***argvPtr) /* Pointer to place to store pointer to array
+ const char ***argvPtr) /* Pointer to place to store pointer to array
* of pointers to list elements. */
{
- CONST char **argv, *l, *element;
+ const char **argv, *l, *element;
char *p;
int length, size, i, result, elSize, brace;
@@ -434,7 +433,7 @@ Tcl_SplitList(
if (next == '\0') {
break;
}
- ++l;
+ l++;
if (isspace(UCHAR(next))) { /* INTL: ISO space. */
continue;
}
@@ -443,24 +442,26 @@ Tcl_SplitList(
}
}
length = l - list;
- argv = (CONST char **) ckalloc((unsigned)
- ((size * sizeof(char *)) + length + 1));
+ argv = ckalloc((size * sizeof(char *)) + length + 1);
for (i = 0, p = ((char *) argv) + size*sizeof(char *);
*list != 0; i++) {
- CONST char *prevList = list;
+ const char *prevList = list;
result = TclFindElement(interp, list, length, &element, &list,
&elSize, &brace);
length -= (list - prevList);
if (result != TCL_OK) {
- ckfree((char *) argv);
+ if (interp != NULL) {
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "LIST", NULL);
+ }
+ ckfree(argv);
return result;
}
if (*element == 0) {
break;
}
if (i >= size) {
- ckfree((char *) argv);
+ ckfree(argv);
if (interp != NULL) {
Tcl_SetResult(interp, "internal error in Tcl_SplitList",
TCL_STATIC);
@@ -508,7 +509,7 @@ Tcl_SplitList(
int
Tcl_ScanElement(
- register CONST char *string,/* String to convert to list element. */
+ register const char *string,/* String to convert to list element. */
register int *flagPtr) /* Where to store information to guide
* Tcl_ConvertCountedElement. */
{
@@ -540,13 +541,13 @@ Tcl_ScanElement(
int
Tcl_ScanCountedElement(
- CONST char *string, /* String to convert to Tcl list element. */
+ const char *string, /* String to convert to Tcl list element. */
int length, /* Number of bytes in string, or -1. */
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
int flags, nestingLevel;
- register CONST char *p, *lastChar;
+ register const char *p, *lastChar;
/*
* This function and Tcl_ConvertElement together do two things:
@@ -561,7 +562,7 @@ Tcl_ScanCountedElement(
* "{abc": the leading brace will have to be backslashed. For each
* element, one of three things must be done:
*
- * (a) Use the element as-is (it doesn't contain any special
+ * (a) Use the element as-is (it doesn't contain any special
* characters). This is the most desirable option.
*
* (b) Enclose the element in braces, but leave the contents alone.
@@ -673,7 +674,7 @@ Tcl_ScanCountedElement(
int
Tcl_ConvertElement(
- register CONST char *src, /* Source information for list element. */
+ register const char *src, /* Source information for list element. */
register char *dst, /* Place to put list-ified element. */
register int flags) /* Flags produced by Tcl_ScanElement. */
{
@@ -703,13 +704,13 @@ Tcl_ConvertElement(
int
Tcl_ConvertCountedElement(
- register CONST char *src, /* Source information for list element. */
+ register const char *src, /* Source information for list element. */
int length, /* Number of bytes in src, or -1. */
char *dst, /* Place to put list-ified element. */
int flags) /* Flags produced by Tcl_ScanElement. */
{
register char *p = dst;
- register CONST char *lastChar;
+ register const char *lastChar;
/*
* See the comment block at the beginning of the Tcl_ScanElement code for
@@ -852,7 +853,7 @@ Tcl_ConvertCountedElement(
char *
Tcl_Merge(
int argc, /* How many strings to merge. */
- CONST char * CONST *argv) /* Array of string values. */
+ const char *const *argv) /* Array of string values. */
{
# define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr;
@@ -868,7 +869,7 @@ Tcl_Merge(
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
} else {
- flagPtr = (int *) ckalloc((unsigned) argc*sizeof(int));
+ flagPtr = ckalloc(argc * sizeof(int));
}
numChars = 1;
for (i = 0; i < argc; i++) {
@@ -879,7 +880,7 @@ Tcl_Merge(
* Pass two: copy into the result area.
*/
- result = (char *) ckalloc((unsigned) numChars);
+ result = ckalloc(numChars);
dst = result;
for (i = 0; i < argc; i++) {
numChars = Tcl_ConvertElement(argv[i], dst,
@@ -895,7 +896,7 @@ Tcl_Merge(
}
if (flagPtr != localFlags) {
- ckfree((char *) flagPtr);
+ ckfree(flagPtr);
}
return result;
}
@@ -921,7 +922,7 @@ Tcl_Merge(
char
Tcl_Backslash(
- CONST char *src, /* Points to the backslash character of a
+ const char *src, /* Points to the backslash character of a
* backslash sequence. */
int *readPtr) /* Fill in with number of characters read from
* src, unless NULL. */
@@ -956,7 +957,7 @@ Tcl_Backslash(
char *
Tcl_Concat(
int argc, /* Number of strings to concatenate. */
- CONST char * CONST *argv) /* Array of strings to concatenate. */
+ const char *const *argv) /* Array of strings to concatenate. */
{
int totalSize, i;
char *p;
@@ -965,13 +966,13 @@ Tcl_Concat(
for (totalSize = 1, i = 0; i < argc; i++) {
totalSize += strlen(argv[i]) + 1;
}
- result = (char *) ckalloc((unsigned) totalSize);
+ result = ckalloc(totalSize);
if (argc == 0) {
*result = '\0';
return result;
}
for (p = result, i = 0; i < argc; i++) {
- CONST char *element;
+ const char *element;
int length;
/*
@@ -1027,11 +1028,11 @@ Tcl_Concat(
Tcl_Obj *
Tcl_ConcatObj(
int objc, /* Number of objects to concatenate. */
- Tcl_Obj *CONST objv[]) /* Array of objects to concatenate. */
+ Tcl_Obj *const objv[]) /* Array of objects to concatenate. */
{
int allocSize, finalSize, length, elemLength, i;
char *p;
- char *element;
+ const char *element;
char *concatStr;
Tcl_Obj *objPtr, *resPtr;
@@ -1118,7 +1119,7 @@ Tcl_ConcatObj(
* the terminating NULL byte.
*/
- concatStr = ckalloc((unsigned) allocSize);
+ concatStr = ckalloc(allocSize);
/*
* Now concatenate the elements. Clip white space off the front and back
@@ -1195,8 +1196,8 @@ Tcl_ConcatObj(
int
Tcl_StringMatch(
- CONST char *str, /* String. */
- CONST char *pattern) /* Pattern, which may contain special
+ const char *str, /* String. */
+ const char *pattern) /* Pattern, which may contain special
* characters. */
{
return Tcl_StringCaseMatch(str, pattern, 0);
@@ -1223,13 +1224,13 @@ Tcl_StringMatch(
int
Tcl_StringCaseMatch(
- CONST char *str, /* String. */
- CONST char *pattern, /* Pattern, which may contain special
+ const char *str, /* String. */
+ const char *pattern, /* Pattern, which may contain special
* characters. */
int nocase) /* 0 for case sensitive, 1 for insensitive */
{
int p, charLen;
- CONST char *pstart = pattern;
+ const char *pstart = pattern;
Tcl_UniChar ch1, ch2;
while (1) {
@@ -1456,11 +1457,12 @@ Tcl_StringCaseMatch(
int
TclByteArrayMatch(
- const unsigned char *string, /* String. */
- int strLen, /* Length of String */
- const unsigned char *pattern, /* Pattern, which may contain special
- * characters. */
- int ptnLen, /* Length of Pattern */
+ const unsigned char *string,/* String. */
+ int strLen, /* Length of String */
+ const unsigned char *pattern,
+ /* Pattern, which may contain special
+ * characters. */
+ int ptnLen, /* Length of Pattern */
int flags)
{
const unsigned char *stringEnd, *patternEnd;
@@ -1631,9 +1633,10 @@ TclByteArrayMatch(
int
TclStringMatchObj(
- Tcl_Obj *strObj, /* string object. */
- Tcl_Obj *ptnObj, /* pattern object. */
- int flags) /* Only TCL_MATCH_NOCASE should be passed or 0. */
+ Tcl_Obj *strObj, /* string object. */
+ Tcl_Obj *ptnObj, /* pattern object. */
+ int flags) /* Only TCL_MATCH_NOCASE should be passed, or
+ * 0. */
{
int match, length, plen;
@@ -1644,13 +1647,13 @@ TclStringMatchObj(
trivial = nocase ? 0 : TclMatchIsTrivial(TclGetString(ptnObj));
*/
- if ((strObj->typePtr == &tclStringType)) {
+ if ((strObj->typePtr == &tclStringType) || (strObj->typePtr == NULL)) {
Tcl_UniChar *udata, *uptn;
udata = Tcl_GetUnicodeFromObj(strObj, &length);
uptn = Tcl_GetUnicodeFromObj(ptnObj, &plen);
match = TclUniCharMatch(udata, length, uptn, plen, flags);
- } else if ((strObj->typePtr == &tclByteArrayType) && !flags) {
+ } else if (TclIsPureByteArray(strObj) && !flags) {
unsigned char *data, *ptn;
data = Tcl_GetByteArrayFromObj(strObj, &length);
@@ -1712,15 +1715,13 @@ Tcl_DStringInit(
char *
Tcl_DStringAppend(
Tcl_DString *dsPtr, /* Structure describing dynamic string. */
- CONST char *bytes, /* String to append. If length is -1 then this
+ const char *bytes, /* String to append. If length is -1 then this
* must be null-terminated. */
int length) /* Number of bytes from "bytes" to append. If
* < 0, then append all of bytes, up to null
* at end. */
{
int newSize;
- char *dst;
- CONST char *end;
if (length < 0) {
length = strlen(bytes);
@@ -1736,13 +1737,12 @@ Tcl_DStringAppend(
if (newSize >= dsPtr->spaceAvl) {
dsPtr->spaceAvl = newSize * 2;
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+ char *newString = ckalloc(dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
- dsPtr->string = ckrealloc((void *) dsPtr->string,
- (size_t) dsPtr->spaceAvl);
+ dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
}
}
@@ -1750,12 +1750,9 @@ Tcl_DStringAppend(
* Copy the new string into the buffer at the end of the old one.
*/
- for (dst = dsPtr->string + dsPtr->length, end = bytes+length;
- bytes < end; bytes++, dst++) {
- *dst = *bytes;
- }
- *dst = '\0';
+ memcpy(dsPtr->string + dsPtr->length, bytes, length);
dsPtr->length += length;
+ dsPtr->string[dsPtr->length] = '\0';
return dsPtr->string;
}
@@ -1780,7 +1777,7 @@ Tcl_DStringAppend(
char *
Tcl_DStringAppendElement(
Tcl_DString *dsPtr, /* Structure describing dynamic string. */
- CONST char *element) /* String to append. Must be
+ const char *element) /* String to append. Must be
* null-terminated. */
{
int newSize, flags, strSize;
@@ -1801,13 +1798,12 @@ Tcl_DStringAppendElement(
if (newSize >= dsPtr->spaceAvl) {
dsPtr->spaceAvl = newSize * 2;
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+ char *newString = ckalloc(dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
- dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
- (size_t) dsPtr->spaceAvl);
+ dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
}
}
@@ -1883,13 +1879,12 @@ Tcl_DStringSetLength(
dsPtr->spaceAvl = length + 1;
}
if (dsPtr->string == dsPtr->staticSpace) {
- char *newString = ckalloc((unsigned) dsPtr->spaceAvl);
+ char *newString = ckalloc(dsPtr->spaceAvl);
memcpy(newString, dsPtr->string, (size_t) dsPtr->length);
dsPtr->string = newString;
} else {
- dsPtr->string = (char *) ckrealloc((void *) dsPtr->string,
- (size_t) dsPtr->spaceAvl);
+ dsPtr->string = ckrealloc(dsPtr->string, dsPtr->spaceAvl);
}
}
dsPtr->length = length;
@@ -1952,14 +1947,16 @@ Tcl_DStringResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the
* result of interp. */
{
+ Interp *iPtr = (Interp *) interp;
+
Tcl_ResetResult(interp);
if (dsPtr->string != dsPtr->staticSpace) {
- interp->result = dsPtr->string;
- interp->freeProc = TCL_DYNAMIC;
+ iPtr->result = dsPtr->string;
+ iPtr->freeProc = TCL_DYNAMIC;
} else if (dsPtr->length < TCL_RESULT_SIZE) {
- interp->result = ((Interp *) interp)->resultSpace;
- strcpy(interp->result, dsPtr->string);
+ iPtr->result = iPtr->resultSpace;
+ memcpy(iPtr->result, dsPtr->string, dsPtr->length + 1);
} else {
Tcl_SetResult(interp, dsPtr->string, TCL_VOLATILE);
}
@@ -2015,9 +2012,9 @@ Tcl_DStringGetResult(
dsPtr->string = iPtr->result;
dsPtr->spaceAvl = dsPtr->length+1;
} else {
- dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length+1));
+ dsPtr->string = ckalloc(dsPtr->length+1);
memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
- (*iPtr->freeProc)(iPtr->result);
+ iPtr->freeProc(iPtr->result);
}
dsPtr->spaceAvl = dsPtr->length+1;
iPtr->freeProc = NULL;
@@ -2026,7 +2023,7 @@ Tcl_DStringGetResult(
dsPtr->string = dsPtr->staticSpace;
dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
} else {
- dsPtr->string = (char *) ckalloc((unsigned) (dsPtr->length + 1));
+ dsPtr->string = ckalloc(dsPtr->length+1);
dsPtr->spaceAvl = dsPtr->length + 1;
}
memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
@@ -2128,35 +2125,35 @@ Tcl_PrintDouble(
int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int)sizeof(int));
/*
- * Handle NaN.
- */
-
- if (TclIsNaN(value)) {
- TclFormatNaN(value, dst);
- return;
- }
-
- /*
- * Handle infinities.
- */
+ * Handle NaN.
+ */
+
+ if (TclIsNaN(value)) {
+ TclFormatNaN(value, dst);
+ return;
+ }
- if (TclIsInfinite(value)) {
+ /*
+ * Handle infinities.
+ */
+
+ if (TclIsInfinite(value)) {
/*
* Remember to copy the terminating NUL too.
*/
- if (value < 0) {
+ if (value < 0) {
memcpy(dst, "-Inf", 5);
- } else {
+ } else {
memcpy(dst, "Inf", 4);
- }
- return;
}
+ return;
+ }
- /*
- * Ordinary (normal and denormal) values.
- */
-
+ /*
+ * Ordinary (normal and denormal) values.
+ */
+
if (*precisionPtr == 0) {
digits = TclDoubleDigits(value, -1, TCL_DD_SHORTEST,
&exponent, &signum, &end);
@@ -2204,9 +2201,9 @@ Tcl_PrintDouble(
TCL_DD_E_FORMAT /* | TCL_DD_SHORTEN_FLAG */,
&exponent, &signum, &end);
}
- if (signum) {
- *dst++ = '-';
- }
+ if (signum) {
+ *dst++ = '-';
+ }
p = digits;
if (exponent < -4 || exponent > 16) {
/*
@@ -2222,8 +2219,8 @@ Tcl_PrintDouble(
c = *++p;
}
}
- /*
- * Tcl 8.4 appears to format with at least a two-digit exponent; \
+ /*
+ * Tcl 8.4 appears to format with at least a two-digit exponent;
* preserve that behaviour when tcl_precision != 0
*/
if (*precisionPtr == 0) {
@@ -2290,11 +2287,11 @@ char *
TclPrecTraceProc(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Interpreter containing variable. */
- CONST char *name1, /* Name of variable. */
- CONST char *name2, /* Second part of variable name. */
+ const char *name1, /* Name of variable. */
+ const char *name2, /* Second part of variable name. */
int flags) /* Information about what happened. */
{
- Tcl_Obj* value;
+ Tcl_Obj *value;
int prec;
int *precisionPtr = Tcl_GetThreadData(&precisionKey, (int) sizeof(int));
@@ -2331,13 +2328,13 @@ TclPrecTraceProc(
*/
if (Tcl_IsSafe(interp)) {
- return "can't modify precision from a safe interpreter";
+ return (char *) "can't modify precision from a safe interpreter";
}
value = Tcl_GetVar2Ex(interp, name1, name2, flags & TCL_GLOBAL_ONLY);
if (value == NULL
- || Tcl_GetIntFromObj((Tcl_Interp*) NULL, value, &prec) != TCL_OK
+ || Tcl_GetIntFromObj(NULL, value, &prec) != TCL_OK
|| prec < 0 || prec > TCL_MAX_PREC) {
- return "improper value for precision";
+ return (char *) "improper value for precision";
}
*precisionPtr = prec;
return NULL;
@@ -2362,8 +2359,8 @@ TclPrecTraceProc(
int
TclNeedSpace(
- CONST char *start, /* First character in string. */
- CONST char *end) /* End of string (place where space will be
+ const char *start, /* First character in string. */
+ const char *end) /* End of string (place where space will be
* added, if appropriate). */
{
/*
@@ -2463,7 +2460,7 @@ TclFormatInt(buffer, n)
long intVal;
int i;
int numFormatted, j;
- char *digits = "0123456789";
+ const char *digits = "0123456789";
/*
* Check first whether "n" is zero.
@@ -2552,7 +2549,8 @@ TclGetIntForIndex(
* representing an index. */
{
int length;
- char *opPtr, *bytes;
+ char *opPtr;
+ const char *bytes;
if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
return TCL_OK;
@@ -2613,14 +2611,13 @@ TclGetIntForIndex(
parseError:
if (interp != NULL) {
- char *bytes = Tcl_GetString(objPtr);
-
/*
* The result might not be empty; this resets it which should be both
* a cheap operation, and of little problem because this is an
* error-generation path anyway.
*/
+ bytes = Tcl_GetString(objPtr);
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad index \"", bytes,
"\": must be integer?[+-]integer? or end?[+-]integer?", NULL);
@@ -2628,6 +2625,7 @@ TclGetIntForIndex(
bytes += 4;
}
TclCheckBadOctal(interp, bytes);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
@@ -2655,12 +2653,12 @@ TclGetIntForIndex(
static void
UpdateStringOfEndOffset(
- register Tcl_Obj* objPtr)
+ register Tcl_Obj *objPtr)
{
char buffer[TCL_INTEGER_SPACE + sizeof("end") + 1];
register int len;
- strcpy(buffer, "end");
+ memcpy(buffer, "end", sizeof("end") + 1);
len = sizeof("end") - 1;
if (objPtr->internalRep.longValue != 0) {
buffer[len++] = '-';
@@ -2695,7 +2693,7 @@ SetEndOffsetFromAny(
Tcl_Obj *objPtr) /* Pointer to the object to parse */
{
int offset; /* Offset in the "end-offset" expression */
- register char* bytes; /* String rep of the object */
+ register const char *bytes; /* String rep of the object */
int length; /* Length of the object's string rep */
/*
@@ -2717,6 +2715,7 @@ SetEndOffsetFromAny(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad index \"", bytes,
"\": must be end?[+-]integer?", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
}
@@ -2751,6 +2750,7 @@ SetEndOffsetFromAny(
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, "bad index \"", bytes,
"\": must be end?[+-]integer?", NULL);
+ Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
return TCL_ERROR;
}
@@ -2789,9 +2789,9 @@ TclCheckBadOctal(
Tcl_Interp *interp, /* Interpreter to use for error reporting. If
* NULL, then no error message is left after
* errors. */
- CONST char *value) /* String to check. */
+ const char *value) /* String to check. */
{
- register CONST char *p = value;
+ register const char *p = value;
/*
* A frequent mistake is invalid octal values due to an unwanted leading
@@ -2806,7 +2806,7 @@ TclCheckBadOctal(
}
if (*p == '0') {
if ((p[1] == 'o') || p[1] == 'O') {
- p+=2;
+ p += 2;
}
while (isdigit(UCHAR(*p))) { /* INTL: digit. */
p++;
@@ -2881,12 +2881,12 @@ static Tcl_HashTable *
GetThreadHash(
Tcl_ThreadDataKey *keyPtr)
{
- Tcl_HashTable **tablePtrPtr = (Tcl_HashTable **)
- Tcl_GetThreadData(keyPtr, (int) sizeof(Tcl_HashTable *));
+ Tcl_HashTable **tablePtrPtr =
+ Tcl_GetThreadData(keyPtr, sizeof(Tcl_HashTable *));
if (NULL == *tablePtrPtr) {
- *tablePtrPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
- Tcl_CreateThreadExitHandler(FreeThreadHash, (ClientData)*tablePtrPtr);
+ *tablePtrPtr = ckalloc(sizeof(Tcl_HashTable));
+ Tcl_CreateThreadExitHandler(FreeThreadHash, *tablePtrPtr);
Tcl_InitHashTable(*tablePtrPtr, TCL_ONE_WORD_KEYS);
}
return *tablePtrPtr;
@@ -2914,7 +2914,7 @@ FreeThreadHash(
ClearHash(tablePtr);
Tcl_DeleteHashTable(tablePtr);
- ckfree((char *) tablePtr);
+ ckfree(tablePtr);
}
/*
@@ -2932,7 +2932,7 @@ static void
FreeProcessGlobalValue(
ClientData clientData)
{
- ProcessGlobalValue *pgvPtr = (ProcessGlobalValue *) clientData;
+ ProcessGlobalValue *pgvPtr = clientData;
pgvPtr->epoch++;
pgvPtr->numBytes = 0;
@@ -2962,7 +2962,7 @@ TclSetProcessGlobalValue(
Tcl_Obj *newValue,
Tcl_Encoding encoding)
{
- CONST char *bytes;
+ const char *bytes;
Tcl_HashTable *cacheMap;
Tcl_HashEntry *hPtr;
int dummy;
@@ -2980,7 +2980,7 @@ TclSetProcessGlobalValue(
Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData) pgvPtr);
}
bytes = Tcl_GetStringFromObj(newValue, &pgvPtr->numBytes);
- pgvPtr->value = ckalloc((unsigned) pgvPtr->numBytes + 1);
+ pgvPtr->value = ckalloc(pgvPtr->numBytes + 1);
memcpy(pgvPtr->value, bytes, (unsigned) pgvPtr->numBytes + 1);
if (pgvPtr->encoding) {
Tcl_FreeEncoding(pgvPtr->encoding);
@@ -2997,8 +2997,8 @@ TclSetProcessGlobalValue(
cacheMap = GetThreadHash(&pgvPtr->key);
ClearHash(cacheMap);
hPtr = Tcl_CreateHashEntry(cacheMap,
- (char *) INT2PTR(pgvPtr->epoch), &dummy);
- Tcl_SetHashValue(hPtr, (ClientData) newValue);
+ INT2PTR(pgvPtr->epoch), &dummy);
+ Tcl_SetHashValue(hPtr, newValue);
Tcl_MutexUnlock(&pgvPtr->mutex);
}
@@ -3046,8 +3046,7 @@ TclGetProcessGlobalValue(
Tcl_DStringLength(&native), &newValue);
Tcl_DStringFree(&native);
ckfree(pgvPtr->value);
- pgvPtr->value = ckalloc((unsigned int)
- Tcl_DStringLength(&newValue) + 1);
+ pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
(size_t) Tcl_DStringLength(&newValue) + 1);
Tcl_DStringFree(&newValue);
@@ -3079,12 +3078,11 @@ TclGetProcessGlobalValue(
Tcl_MutexLock(&pgvPtr->mutex);
if ((NULL == pgvPtr->value) && (pgvPtr->proc)) {
pgvPtr->epoch++;
- (*(pgvPtr->proc))(&pgvPtr->value, &pgvPtr->numBytes,
- &pgvPtr->encoding);
+ pgvPtr->proc(&pgvPtr->value,&pgvPtr->numBytes,&pgvPtr->encoding);
if (pgvPtr->value == NULL) {
Tcl_Panic("PGV Initializer did not initialize");
}
- Tcl_CreateExitHandler(FreeProcessGlobalValue, (ClientData)pgvPtr);
+ Tcl_CreateExitHandler(FreeProcessGlobalValue, pgvPtr);
}
/*
@@ -3093,12 +3091,12 @@ TclGetProcessGlobalValue(
value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes);
hPtr = Tcl_CreateHashEntry(cacheMap,
- (char *) INT2PTR(pgvPtr->epoch), &dummy);
+ INT2PTR(pgvPtr->epoch), &dummy);
Tcl_MutexUnlock(&pgvPtr->mutex);
- Tcl_SetHashValue(hPtr, (ClientData) value);
+ Tcl_SetHashValue(hPtr, value);
Tcl_IncrRefCount(value);
}
- return (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ return Tcl_GetHashValue(hPtr);
}
/*
@@ -3110,7 +3108,7 @@ TclGetProcessGlobalValue(
* (normally as computed by TclpFindExecutable).
*
* Results:
- * None.
+ * None.
*
* Side effects:
* Stores the executable name.
@@ -3141,7 +3139,7 @@ TclSetObjNameOfExecutable(
* pathname of the application is unknown.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -3160,20 +3158,20 @@ TclGetObjNameOfExecutable(void)
* This function retrieves the absolute pathname of the application in
* which the Tcl library is running, and returns it in string form.
*
- * The returned string belongs to Tcl and should be copied if the caller
- * plans to keep it, to guard against it becoming invalid.
+ * The returned string belongs to Tcl and should be copied if the caller
+ * plans to keep it, to guard against it becoming invalid.
*
* Results:
* A pointer to the internal string or NULL if the internal full path
* name has not been computed or unknown.
*
* Side effects:
- * None.
+ * None.
*
*----------------------------------------------------------------------
*/
-CONST char *
+const char *
Tcl_GetNameOfExecutable(void)
{
int numBytes;
@@ -3263,8 +3261,8 @@ TclReToGlob(
int *exactPtr)
{
int anchorLeft, anchorRight, lastIsStar, numStars;
- char *dsStr, *dsStrStart, *msg;
- const char *p, *strEnd;
+ char *dsStr, *dsStrStart;
+ const char *msg, *p, *strEnd;
strEnd = reStr + reStrLen;
Tcl_DStringInit(dsPtr);
@@ -3278,7 +3276,7 @@ TclReToGlob(
* At most, the glob pattern has length 2*reStrLen + 2 to
* backslash escape every character and have * at each end.
*/
- Tcl_DStringSetLength(dsPtr, 2*reStrLen + 2);
+ Tcl_DStringSetLength(dsPtr, reStrLen + 2);
dsStr = dsStrStart = Tcl_DStringValue(dsPtr);
*dsStr++ = '*';
for (p = reStr + 4; p < strEnd; p++) {
generated by cgit v0.12 at 2024-11-18 01:41:54 (GMT)