summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2017-02-16 18:48:56 (GMT)
committerdgp <dgp@users.sourceforge.net>2017-02-16 18:48:56 (GMT)
commit674ed242bc26f2a7d7e773dfd456fd95164f8bac (patch)
tree9940afb84ebd36d050d00448f4c79363c87ecac5 /generic
parent44a6a03d757bee64987fa31d866bf56b2f2e143c (diff)
parent3b5e7e9792b9b34111146557a3353756711b8133 (diff)
downloadtcl-674ed242bc26f2a7d7e773dfd456fd95164f8bac.zip
tcl-674ed242bc26f2a7d7e773dfd456fd95164f8bac.tar.gz
tcl-674ed242bc26f2a7d7e773dfd456fd95164f8bac.tar.bz2
merge trunk
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h5
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCompile.h2
-rw-r--r--generic/tclEnsemble.c2
-rw-r--r--generic/tclHistory.c5
-rw-r--r--generic/tclIO.c2
-rw-r--r--generic/tclIO.h2
-rw-r--r--generic/tclInt.h12
-rw-r--r--generic/tclLink.c197
-rw-r--r--generic/tclObj.c6
-rw-r--r--generic/tclPkg.c18
-rw-r--r--generic/tclStrToD.c27
12 files changed, 151 insertions, 129 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index c0cee27..d678229 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -1147,8 +1147,13 @@ typedef struct Tcl_DString {
#define TCL_LINK_SHORT 8
#define TCL_LINK_USHORT 9
#define TCL_LINK_UINT 10
+#if defined(TCL_WIDE_INT_IS_LONG) || defined(_WIN32) || defined(__CYGWIN__)
+#define TCL_LINK_LONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_INT : TCL_LINK_INT)
+#define TCL_LINK_ULONG ((sizeof(long) != sizeof(int)) ? TCL_LINK_WIDE_UINT : TCL_LINK_UINT)
+#else
#define TCL_LINK_LONG 11
#define TCL_LINK_ULONG 12
+#endif
#define TCL_LINK_FLOAT 13
#define TCL_LINK_WIDE_UINT 14
#define TCL_LINK_READ_ONLY 0x80
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 63c5590..6ff5faa 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -4705,7 +4705,7 @@ TEOV_RunEnterTraces(
{
Interp *iPtr = (Interp *) interp;
Command *cmdPtr = *cmdPtrPtr;
- int newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
+ size_t newEpoch, cmdEpoch = cmdPtr->cmdEpoch;
int length, traceCode = TCL_OK;
const char *command = TclGetStringFromObj(commandPtr, &length);
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 5ef154e..5bc3e81 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -425,7 +425,7 @@ typedef struct ByteCode {
* compiled. If the code is executed if a
* different namespace, it must be
* recompiled. */
- int nsEpoch; /* Value of nsPtr->resolverEpoch when this
+ size_t nsEpoch; /* Value of nsPtr->resolverEpoch when this
* ByteCode was compiled. Used to invalidate
* code when new namespace resolution rules
* are put into effect. */
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 6ada155..f3e8187 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -92,7 +92,7 @@ static const Tcl_ObjType ensembleCmdType = {
*/
typedef struct {
- int epoch; /* Used to confirm when the data in this
+ size_t epoch; /* Used to confirm when the data in this
* really structure matches up with the
* ensemble. */
Command *token; /* Reference to the command for which this
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index b08e352..47806d4 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -62,15 +62,14 @@ Tcl_RecordAndEval(
* instead of Tcl_Eval. */
{
register Tcl_Obj *cmdPtr;
- int length = strlen(cmd);
int result;
- if (length > 0) {
+ if (cmd[0]) {
/*
* Call Tcl_RecordAndEvalObj to do the actual work.
*/
- cmdPtr = Tcl_NewStringObj(cmd, length);
+ cmdPtr = Tcl_NewStringObj(cmd, -1);
Tcl_IncrRefCount(cmdPtr);
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 506e6d5..6bf8451 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -321,7 +321,7 @@ static int WillRead(Channel *chanPtr);
typedef struct ResolvedChanName {
ChannelState *statePtr; /* The saved lookup result */
Tcl_Interp *interp; /* The interp in which the lookup was done. */
- int epoch; /* The epoch of the channel when the lookup
+ size_t epoch; /* The epoch of the channel when the lookup
* was done. Use to verify validity. */
size_t refCount; /* Share this struct among many Tcl_Obj. */
} ResolvedChanName;
diff --git a/generic/tclIO.h b/generic/tclIO.h
index ffbfa31..07c54fa 100644
--- a/generic/tclIO.h
+++ b/generic/tclIO.h
@@ -214,7 +214,7 @@ typedef struct ChannelState {
* because it happened in the background. The
* value is the chanMg, if any. #219's
* companion to 'unreportedError'. */
- int epoch; /* Used to test validity of stored channelname
+ size_t epoch; /* Used to test validity of stored channelname
* lookup results. */
} ChannelState;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 4b87962..f078d18 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -265,7 +265,7 @@ typedef struct Namespace {
* strings; values have type (Namespace *). If
* NULL, there are no children. */
#endif
- long nsId; /* Unique id for the namespace. */
+ size_t nsId; /* Unique id for the namespace. */
Tcl_Interp *interp; /* The interpreter containing this
* namespace. */
int flags; /* OR-ed combination of the namespace status
@@ -299,12 +299,12 @@ typedef struct Namespace {
* registered using "namespace export". */
int maxExportPatterns; /* Mumber of export patterns for which space
* is currently allocated. */
- int cmdRefEpoch; /* Incremented if a newly added command
+ size_t cmdRefEpoch; /* Incremented if a newly added command
* shadows a command for which this namespace
* has already cached a Command* pointer; this
* causes all its cached Command* pointers to
* be invalidated. */
- int resolverEpoch; /* Incremented whenever (a) the name
+ size_t resolverEpoch; /* Incremented whenever (a) the name
* resolution rules change for this namespace
* or (b) a newly added command shadows a
* command that is compiled to bytecodes. This
@@ -331,7 +331,7 @@ typedef struct Namespace {
* LookupCompiledLocal to resolve variable
* references within the namespace at compile
* time. */
- int exportLookupEpoch; /* Incremented whenever a command is added to
+ size_t exportLookupEpoch; /* Incremented whenever a command is added to
* a namespace, removed from a namespace or
* the exports of a namespace are changed.
* Allows TIP#112-driven command lists to be
@@ -432,7 +432,7 @@ typedef struct EnsembleConfig {
* if the command has been deleted (or never
* existed; the global namespace never has an
* ensemble command.) */
- int epoch; /* The epoch at which this ensemble's table of
+ size_t epoch; /* The epoch at which this ensemble's table of
* exported commands is valid. */
char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all
* consistent points, this will have the same
@@ -1639,7 +1639,7 @@ typedef struct Command {
* representing a command's name in a ByteCode
* instruction sequence. This structure can be
* freed when refCount becomes zero. */
- int cmdEpoch; /* Incremented to invalidate any references
+ size_t cmdEpoch; /* Incremented to invalidate any references
* that point to this command when it is
* renamed, deleted, hidden, or exposed. */
CompileProc *compileProc; /* Procedure called to compile command. NULL
diff --git a/generic/tclLink.c b/generic/tclLink.c
index 88c98df..a39dfcd 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -36,8 +36,10 @@ typedef struct Link {
unsigned int ui;
short s;
unsigned short us;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
long l;
unsigned long ul;
+#endif
Tcl_WideInt w;
Tcl_WideUInt uw;
float f;
@@ -68,6 +70,7 @@ static char * LinkTraceProc(ClientData clientData,Tcl_Interp *interp,
const char *name1, const char *name2, int flags);
static Tcl_Obj * ObjValue(Link *linkPtr);
static int GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr);
+static int GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr);
static int GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr);
/*
@@ -128,6 +131,14 @@ Tcl_LinkVar(
Tcl_IncrRefCount(linkPtr->varName);
linkPtr->addr = addr;
linkPtr->type = type & ~TCL_LINK_READ_ONLY;
+#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
+ || defined(_WIN32) || defined(__CYGWIN__))
+ if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
+ linkPtr->type = TCL_LINK_LONG;
+ } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
+ linkPtr->type = TCL_LINK_ULONG;
+ }
+#endif
if (type & TCL_LINK_READ_ONLY) {
linkPtr->flags = LINK_READ_ONLY;
} else {
@@ -334,12 +345,14 @@ LinkTraceProc(
case TCL_LINK_UINT:
changed = (LinkedVar(unsigned int) != linkPtr->lastValue.ui);
break;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
case TCL_LINK_LONG:
changed = (LinkedVar(long) != linkPtr->lastValue.l);
break;
case TCL_LINK_ULONG:
changed = (LinkedVar(unsigned long) != linkPtr->lastValue.ul);
break;
+#endif
case TCL_LINK_FLOAT:
changed = (LinkedVar(float) != linkPtr->lastValue.f);
break;
@@ -381,38 +394,31 @@ LinkTraceProc(
switch (linkPtr->type) {
case TCL_LINK_INT:
- if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i)
- != TCL_OK) {
- if (GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ if (Tcl_GetIntFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK
+ && GetInvalidIntFromObj(valueObj, &linkPtr->lastValue.i) != TCL_OK) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have integer value";
- }
+ return (char *) "variable must have integer value";
}
LinkedVar(int) = linkPtr->lastValue.i;
break;
case TCL_LINK_WIDE_INT:
- if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w)
- != TCL_OK) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ if (Tcl_GetWideIntFromObj(NULL, valueObj, &linkPtr->lastValue.w) != TCL_OK
+ && GetInvalidWideFromObj(valueObj, &linkPtr->lastValue.w) != TCL_OK) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
- return (char *) "variable must have integer value";
- }
- linkPtr->lastValue.w = (Tcl_WideInt) valueInt;
+ return (char *) "variable must have integer value";
}
LinkedVar(Tcl_WideInt) = linkPtr->lastValue.w;
break;
case TCL_LINK_DOUBLE:
- if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
- != TCL_OK) {
+ if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
#ifdef ACCEPT_NAN
if (valueObj->typePtr != &tclDoubleType) {
#endif
- if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d)
- != TCL_OK) {
+ if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have real value";
@@ -426,8 +432,7 @@ LinkTraceProc(
break;
case TCL_LINK_BOOLEAN:
- if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i)
- != TCL_OK) {
+ if (Tcl_GetBooleanFromObj(NULL, valueObj, &linkPtr->lastValue.i) != TCL_OK) {
Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
TCL_GLOBAL_ONLY);
return (char *) "variable must have boolean value";
@@ -436,131 +441,106 @@ LinkTraceProc(
break;
case TCL_LINK_CHAR:
- if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|| valueInt < SCHAR_MIN || valueInt > SCHAR_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have char value";
- }
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have char value";
}
- linkPtr->lastValue.c = (char)valueInt;
- LinkedVar(char) = linkPtr->lastValue.c;
+ LinkedVar(char) = linkPtr->lastValue.c = (char)valueInt;
break;
case TCL_LINK_UCHAR:
- if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|| valueInt < 0 || valueInt > UCHAR_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned char value";
- }
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have unsigned char value";
}
- linkPtr->lastValue.uc = (unsigned char) valueInt;
- LinkedVar(unsigned char) = linkPtr->lastValue.uc;
+ LinkedVar(unsigned char) = linkPtr->lastValue.uc = (unsigned char) valueInt;
break;
case TCL_LINK_SHORT:
- if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|| valueInt < SHRT_MIN || valueInt > SHRT_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have short value";
- }
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have short value";
}
- linkPtr->lastValue.s = (short)valueInt;
- LinkedVar(short) = linkPtr->lastValue.s;
+ LinkedVar(short) = linkPtr->lastValue.s = (short)valueInt;
break;
case TCL_LINK_USHORT:
- if (Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ if ((Tcl_GetIntFromObj(NULL, valueObj, &valueInt) != TCL_OK
+ && GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK)
|| valueInt < 0 || valueInt > USHRT_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned short value";
- }
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have unsigned short value";
}
- linkPtr->lastValue.us = (unsigned short)valueInt;
- LinkedVar(unsigned short) = linkPtr->lastValue.us;
+ LinkedVar(unsigned short) = linkPtr->lastValue.us = (unsigned short)valueInt;
break;
case TCL_LINK_UINT:
- if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
|| valueWide < 0 || valueWide > UINT_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned int value";
- }
- linkPtr->lastValue.ui = (unsigned int)valueInt;
- } else {
- linkPtr->lastValue.ui = (unsigned int)valueWide;
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have unsigned int value";
}
- LinkedVar(unsigned int) = linkPtr->lastValue.ui;
+ LinkedVar(unsigned int) = linkPtr->lastValue.ui = (unsigned int)valueWide;
break;
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
case TCL_LINK_LONG:
- if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
|| valueWide < LONG_MIN || valueWide > LONG_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have long value";
- }
- linkPtr->lastValue.l = (long)valueInt;
- } else {
- linkPtr->lastValue.l = (long)valueWide;
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have long value";
}
- LinkedVar(long) = linkPtr->lastValue.l;
+ LinkedVar(long) = linkPtr->lastValue.l = (long)valueWide;
break;
case TCL_LINK_ULONG:
- if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ if ((Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK)
|| valueWide < 0 || (Tcl_WideUInt) valueWide > ULONG_MAX) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned long value";
- }
- linkPtr->lastValue.ul = (unsigned long)valueInt;
- } else {
- linkPtr->lastValue.ul = (unsigned long)valueWide;
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have unsigned long value";
}
- LinkedVar(unsigned long) = linkPtr->lastValue.ul;
+ LinkedVar(unsigned long) = linkPtr->lastValue.ul = (unsigned long)valueWide;
break;
+#endif
case TCL_LINK_WIDE_UINT:
/*
* FIXME: represent as a bignum.
*/
- if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK) {
- if (GetInvalidIntFromObj(valueObj, &valueInt) != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have unsigned wide int value";
- }
- linkPtr->lastValue.uw = (Tcl_WideUInt)valueInt;
- } else {
- linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
+ if (Tcl_GetWideIntFromObj(NULL, valueObj, &valueWide) != TCL_OK
+ && GetInvalidWideFromObj(valueObj, &valueWide) != TCL_OK) {
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have unsigned wide int value";
}
- LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw;
+ LinkedVar(Tcl_WideUInt) = linkPtr->lastValue.uw = (Tcl_WideUInt)valueWide;
break;
case TCL_LINK_FLOAT:
- if (Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
+ if ((Tcl_GetDoubleFromObj(NULL, valueObj, &valueDouble) != TCL_OK
+ && GetInvalidDoubleFromObj(valueObj, &valueDouble) != TCL_OK)
|| valueDouble < -FLT_MAX || valueDouble > FLT_MAX) {
- if (GetInvalidDoubleFromObj(valueObj, &valueDouble)
- != TCL_OK) {
- Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
- TCL_GLOBAL_ONLY);
- return (char *) "variable must have float value";
- }
+ Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
+ TCL_GLOBAL_ONLY);
+ return (char *) "variable must have float value";
}
- linkPtr->lastValue.f = (float)valueDouble;
- LinkedVar(float) = linkPtr->lastValue.f;
+ LinkedVar(float) = linkPtr->lastValue.f = (float)valueDouble;
break;
case TCL_LINK_STRING:
@@ -631,12 +611,14 @@ ObjValue(
case TCL_LINK_UINT:
linkPtr->lastValue.ui = LinkedVar(unsigned int);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ui);
+#if !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__CYGWIN__)
case TCL_LINK_LONG:
linkPtr->lastValue.l = LinkedVar(long);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.l);
case TCL_LINK_ULONG:
linkPtr->lastValue.ul = LinkedVar(unsigned long);
return Tcl_NewWideIntObj((Tcl_WideInt) linkPtr->lastValue.ul);
+#endif
case TCL_LINK_FLOAT:
linkPtr->lastValue.f = LinkedVar(float);
return Tcl_NewDoubleObj(linkPtr->lastValue.f);
@@ -729,6 +711,18 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
return TCL_ERROR;
}
+int
+GetInvalidWideFromObj(Tcl_Obj *objPtr, Tcl_WideInt *widePtr)
+{
+ int intValue;
+
+ if (GetInvalidIntFromObj(objPtr, &intValue) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *widePtr = intValue;
+ return TCL_OK;
+}
+
/*
* This function checks for double representations, which are valid
* when linking with C variables, but which are invalid in other
@@ -736,8 +730,7 @@ GetInvalidIntFromObj(Tcl_Obj *objPtr, int *intPtr)
* (upper- and lowercase) and sequences like "1e-". See bug [39f6304c2e].
*/
int
-GetInvalidDoubleFromObj(Tcl_Obj *objPtr,
- double *doublePtr)
+GetInvalidDoubleFromObj(Tcl_Obj *objPtr, double *doublePtr)
{
int intValue;
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 1abbb31..7ec259f 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -344,17 +344,17 @@ typedef struct ResolvedCmdName {
* reference (not the namespace that contains
* the referenced command). NULL if the name
* is fully qualified.*/
- long refNsId; /* refNsPtr's unique namespace id. Used to
+ size_t refNsId; /* refNsPtr's unique namespace id. Used to
* verify that refNsPtr is still valid (e.g.,
* it's possible that the cmd's containing
* namespace was deleted and a new one created
* at the same address). */
- int refNsCmdEpoch; /* Value of the referencing namespace's
+ size_t refNsCmdEpoch; /* Value of the referencing namespace's
* cmdRefEpoch when the pointer was cached.
* Before using the cached pointer, we check
* if the namespace's epoch was incremented;
* if so, this cached pointer is invalid. */
- int cmdEpoch; /* Value of the command's cmdEpoch when this
+ size_t cmdEpoch; /* Value of the command's cmdEpoch when this
* pointer was cached. Before using the cached
* pointer, we check if the cmd's epoch was
* incremented; if so, the cmd was renamed,
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 0759faa..9ad3cb7 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -32,6 +32,7 @@ typedef struct PkgAvail {
char *script; /* Script to invoke to provide this version of
* the package. Malloc'ed and protected by
* Tcl_Preserve and Tcl_Release. */
+ char *pkgIndex; /* Full file name of pkgIndex file */
struct PkgAvail *nextPtr; /* Next in list of available versions of the
* same package. */
} PkgAvail;
@@ -573,6 +574,9 @@ PkgRequireCore(
pkgName->nextPtr = pkgFiles->names;
strcpy(pkgName->name, name);
pkgFiles->names = pkgName;
+ if (bestPtr->pkgIndex) {
+ TclPkgFileSeen(interp, bestPtr->pkgIndex);
+ }
code = Tcl_EvalEx(interp, script, -1, TCL_EVAL_GLOBAL);
/* Pop the "ifneeded" package name from "tclPkgFiles" assocdata*/
pkgFiles->names = pkgName->nextPtr;
@@ -921,6 +925,9 @@ Tcl_PackageObjCmd(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ if (availPtr->pkgIndex) {
+ Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+ }
ckfree(availPtr);
}
ckfree(pkgPtr);
@@ -971,6 +978,9 @@ Tcl_PackageObjCmd(
return TCL_OK;
}
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ if (availPtr->pkgIndex) {
+ Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+ }
break;
}
}
@@ -981,6 +991,7 @@ Tcl_PackageObjCmd(
}
if (availPtr == NULL) {
availPtr = ckalloc(sizeof(PkgAvail));
+ availPtr->pkgIndex = 0;
DupBlock(availPtr->version, argv3, (unsigned) length + 1);
if (prevPtr == NULL) {
@@ -991,6 +1002,10 @@ Tcl_PackageObjCmd(
prevPtr->nextPtr = availPtr;
}
}
+ if (iPtr->scriptFile) {
+ argv4 = TclGetStringFromObj(iPtr->scriptFile, &length);
+ DupBlock(availPtr->pkgIndex, argv4, (unsigned) length + 1);
+ }
argv4 = TclGetStringFromObj(objv[4], &length);
DupBlock(availPtr->script, argv4, (unsigned) length + 1);
break;
@@ -1346,6 +1361,9 @@ TclFreePackageInfo(
pkgPtr->availPtr = availPtr->nextPtr;
Tcl_EventuallyFree(availPtr->version, TCL_DYNAMIC);
Tcl_EventuallyFree(availPtr->script, TCL_DYNAMIC);
+ if (availPtr->pkgIndex) {
+ Tcl_EventuallyFree(availPtr->pkgIndex, TCL_DYNAMIC);
+ }
ckfree(availPtr);
}
ckfree(pkgPtr);
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 6da6df3..77e1839 100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -18,13 +18,6 @@
#include <math.h>
/*
- * Define KILL_OCTAL to suppress interpretation of numbers with leading zero
- * as octal. (Ceterum censeo: numeros octonarios delendos esse.)
- */
-
-#undef KILL_OCTAL
-
-/*
* This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
* floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
* uniquely determined by radix and by the widths of significand and exponent.
@@ -546,6 +539,20 @@ TclParseNumber(
*/
if (bytes == NULL) {
+ if (endPtrPtr == NULL) {
+ if (objPtr->typePtr == &tclDictType) {
+ /* A dict can never be a (single) number */
+ return TCL_ERROR;
+ }
+ if (objPtr->typePtr == &tclListType) {
+ int length;
+ /* A list can only be a (single) number if its length == 1 */
+ TclListObjLength(NULL, objPtr, &length);
+ if (length != 1) {
+ return TCL_ERROR;
+ }
+ }
+ }
bytes = TclGetString(objPtr);
}
@@ -657,7 +664,7 @@ TclParseNumber(
state = ZERO_O;
break;
}
-#ifdef KILL_OCTAL
+#ifdef TCL_NO_DEPRECATED
goto decimal;
#endif
/* FALLTHROUGH */
@@ -740,7 +747,7 @@ TclParseNumber(
goto endgame;
}
-#ifndef KILL_OCTAL
+#ifndef TCL_NO_DEPRECATED
/*
* Scanned a number with a leading zero that contains an 8, 9,
@@ -879,7 +886,7 @@ TclParseNumber(
* digits.
*/
-#ifdef KILL_OCTAL
+#ifdef TCL_NO_DEPRECATED
decimal:
#endif
acceptState = state;