summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--.fossil-settings/ignore-glob3
-rw-r--r--.gitignore3
-rw-r--r--doc/LinkVar.36
-rw-r--r--doc/Notifier.35
-rw-r--r--doc/Tcl_Main.36
-rw-r--r--generic/tcl.decls43
-rw-r--r--generic/tclBasic.c163
-rw-r--r--generic/tclCompile.c87
-rw-r--r--generic/tclProc.c2
-rw-r--r--generic/tclStringObj.c2
-rw-r--r--generic/tclStubLib.c9
-rw-r--r--generic/tclTestObj.c18
-rw-r--r--library/http/http.tcl165
-rw-r--r--library/http/pkgIndex.tcl2
-rw-r--r--library/manifest.txt2
-rw-r--r--tests/http.test9
-rw-r--r--tests/listObj.test10
-rw-r--r--tests/stringObj.test25
-rw-r--r--unix/Makefile.in4
-rw-r--r--unix/dltest/pkga.c4
-rw-r--r--unix/dltest/pkgb.c20
-rw-r--r--unix/dltest/pkgc.c4
-rw-r--r--unix/dltest/pkgd.c4
-rw-r--r--unix/dltest/pkgooa.c8
-rw-r--r--unix/dltest/pkgua.c6
-rw-r--r--win/Makefile.in8
-rw-r--r--win/makefile.vc1
27 files changed, 368 insertions, 251 deletions
diff --git a/.fossil-settings/ignore-glob b/.fossil-settings/ignore-glob
index 651d616..306d5a5 100644
--- a/.fossil-settings/ignore-glob
+++ b/.fossil-settings/ignore-glob
@@ -24,7 +24,8 @@
*/versions.vc
*/version.vc
*/libtcl.vfs
-*/libtcl_*.zip
+*/libtcl*.zip
+*/tclUuid.h
html
libtommath/bn.ilg
libtommath/bn.ind
diff --git a/.gitignore b/.gitignore
index 33579cf..74bf502 100644
--- a/.gitignore
+++ b/.gitignore
@@ -30,7 +30,8 @@ _FOSSIL_
*/versions.vc
*/version.vc
*/libtcl.vfs
-*/libtcl_*.zip
+*/libtcl*.zip
+*/tclUuid.h
libtommath/bn.ilg
libtommath/bn.ind
libtommath/pretty.build
diff --git a/doc/LinkVar.3 b/doc/LinkVar.3
index 92e7d03..3a41582 100644
--- a/doc/LinkVar.3
+++ b/doc/LinkVar.3
@@ -53,7 +53,7 @@ used.
.sp
.VS "TIP 312"
In \fBTcl_LinkArray\fR, the additional linked types \fBTCL_LINK_CHARS\fR and
-\fBTCL_LINK_BYTES\fR may be used.
+\fBTCL_LINK_BINARY\fR may be used.
.VE "TIP 312"
.sp
All the above for both functions may be
@@ -146,11 +146,11 @@ prefix) are accepted as if they are valid too.
.RS
.PP
.VS "TIP 312"
-If using an array of these, consider using \fBTCL_LINK_BYTES\fR instead.
+If using an array of these, consider using \fBTCL_LINK_BINARY\fR instead.
.VE "TIP 312"
.RE
.TP
-\fBTCL_LINK_BYTES\fR
+\fBTCL_LINK_BINARY\fR
.VS "TIP 312"
The C array is of type \fBunsigned char *\fR and is mapped into Tcl
as a bytearray.
diff --git a/doc/Notifier.3 b/doc/Notifier.3
index e34e6ed..3b547ff 100644
--- a/doc/Notifier.3
+++ b/doc/Notifier.3
@@ -413,10 +413,7 @@ threads for those threads to be able to add events to its queue.)
After adding an event to another thread's queue, you then typically
need to call \fBTcl_ThreadAlert\fR to
.QW "wake up"
-that thread's notifier to alert it to the new event. Alternatively,
-the queue positions \fBTCL_QUEUE_TAIL_ALERT_IF_EMPTY\fR and
-\fBTCL_QUEUE_HEAD_ALERT_IF_EMPTY\fR can be used which automatically
-call \fBTcl_ThreadAlert\fR if the thread's queue was empty.
+that thread's notifier to alert it to the new event.
.PP
\fBTcl_DeleteEvents\fR can be used to explicitly remove one or more
events from the event queue. \fBTcl_DeleteEvents\fR calls \fIproc\fR
diff --git a/doc/Tcl_Main.3 b/doc/Tcl_Main.3
index 904ecbe..6a37cda 100644
--- a/doc/Tcl_Main.3
+++ b/doc/Tcl_Main.3
@@ -85,8 +85,10 @@ that does nothing but invoke \fBTcl_Main\fR.
.PP
\fBTcl_Main\fR is not provided by the public interface of Tcl's
stub library. Programs that call \fBTcl_Main\fR must be linked
-against the standard Tcl library. Extensions (stub-enabled or
-not) are not intended to call \fBTcl_Main\fR.
+against the standard Tcl library. If the standard Tcl library is
+a dll (so, not a static .lib/.a) , then the program must be linked
+against the stub library as well. Extensions
+(stub-enabled or not) are not intended to call \fBTcl_Main\fR.
.PP
\fBTcl_Main\fR is not thread-safe. It should only be called by
a single main thread of a multi-threaded application. This
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 705b92e..6d24ae5 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -108,8 +108,8 @@ declare 22 {deprecated {No longer in use, changed to macro}} {
Tcl_Obj *Tcl_DbNewBooleanObj(int intValue, const char *file, int line)
}
declare 23 {
- Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes, int numBytes,
- const char *file, int line)
+ Tcl_Obj *Tcl_DbNewByteArrayObj(const unsigned char *bytes,
+ int numBytes, const char *file, int line)
}
declare 24 {
Tcl_Obj *Tcl_DbNewDoubleObj(double doubleValue, const char *file,
@@ -142,6 +142,7 @@ declare 32 {
int Tcl_GetBooleanFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
int *intPtr)
}
+# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 33 {
unsigned char *Tcl_GetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr)
}
@@ -299,6 +300,7 @@ declare 79 {
declare 80 {
void Tcl_CancelIdleCall(Tcl_IdleProc *idleProc, ClientData clientData)
}
+# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 81 {
int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan)
}
@@ -598,8 +600,8 @@ declare 166 {
# generic interface, so we include it here for compatibility reasons.
declare 167 unix {
- int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID, int forWriting,
- int checkUsage, ClientData *filePtr)
+ int Tcl_GetOpenFile(Tcl_Interp *interp, const char *chanID,
+ int forWriting, int checkUsage, ClientData *filePtr)
}
# Obsolete. Should now use Tcl_FSGetPathType which is objectified
# and therefore usually faster.
@@ -1121,8 +1123,8 @@ declare 312 {
int Tcl_NumUtfChars(const char *src, int length)
}
declare 313 {
- int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr, int charsToRead,
- int appendFlag)
+ int Tcl_ReadChars(Tcl_Channel channel, Tcl_Obj *objPtr,
+ int charsToRead, int appendFlag)
}
declare 314 {
void Tcl_RestoreResult(Tcl_Interp *interp, Tcl_SavedResult *statePtr)
@@ -1275,16 +1277,17 @@ declare 359 {
const char *command, int length)
}
declare 360 {
- int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes,
- Tcl_Parse *parsePtr, int append, const char **termPtr)
+ int Tcl_ParseBraces(Tcl_Interp *interp, const char *start,
+ int numBytes, Tcl_Parse *parsePtr, int append,
+ const char **termPtr)
}
declare 361 {
- int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes,
- int nested, Tcl_Parse *parsePtr)
+ int Tcl_ParseCommand(Tcl_Interp *interp, const char *start,
+ int numBytes, int nested, Tcl_Parse *parsePtr)
}
declare 362 {
- int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, int numBytes,
- Tcl_Parse *parsePtr)
+ int Tcl_ParseExpr(Tcl_Interp *interp, const char *start,
+ int numBytes, Tcl_Parse *parsePtr)
}
declare 363 {
int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start,
@@ -1292,8 +1295,8 @@ declare 363 {
const char **termPtr)
}
declare 364 {
- int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes,
- Tcl_Parse *parsePtr, int append)
+ int Tcl_ParseVarName(Tcl_Interp *interp, const char *start,
+ int numBytes, Tcl_Parse *parsePtr, int append)
}
# These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir,
# Tcl_FSAccess and Tcl_FSStat
@@ -2089,8 +2092,8 @@ declare 574 {
void Tcl_AppendObjToErrorInfo(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 575 {
- void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes, int length,
- int limit, const char *ellipsis)
+ void Tcl_AppendLimitedToObj(Tcl_Obj *objPtr, const char *bytes,
+ int length, int limit, const char *ellipsis)
}
declare 576 {
Tcl_Obj *Tcl_Format(Tcl_Interp *interp, const char *format, int objc,
@@ -2135,8 +2138,8 @@ declare 584 {
int Tcl_NREvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}
declare 585 {
- int Tcl_NREvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
- int flags)
+ int Tcl_NREvalObjv(Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[], int flags)
}
declare 586 {
int Tcl_NRCmdSwap(Tcl_Interp *interp, Tcl_Command cmd, int objc,
@@ -2269,7 +2272,8 @@ declare 618 {
int Tcl_ZlibStreamPut(Tcl_ZlibStream zshandle, Tcl_Obj *data, int flush)
}
declare 619 {
- int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data, int count)
+ int Tcl_ZlibStreamGet(Tcl_ZlibStream zshandle, Tcl_Obj *data,
+ int count)
}
declare 620 {
int Tcl_ZlibStreamClose(Tcl_ZlibStream zshandle)
@@ -2419,6 +2423,7 @@ declare 651 {
declare 652 {
unsigned short *TclGetUnicodeFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
}
+# Only available in Tcl 8.x, NULL in Tcl 9.0
declare 653 {
unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *numBytesPtr)
}
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f87e1e1..a78a768 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -86,7 +86,7 @@ typedef struct OldMathFuncData {
Tcl_MathProc *proc; /* Handler function */
int numArgs; /* Number of args expected */
Tcl_ValueType *argTypes; /* Types of the args */
- ClientData clientData; /* Client data for the handler function */
+ void *clientData; /* Client data for the handler function */
} OldMathFuncData;
/*
@@ -105,8 +105,8 @@ typedef struct {
* cancellation. */
char *result; /* The script cancellation result or NULL for
* a default result. */
- int length; /* Length of the above error message. */
- ClientData clientData; /* Not used. */
+ int length; /* Length of the above error message. */
+ void *clientData; /* Not used. */
int flags; /* Additional flags */
} CancelInfo;
static Tcl_HashTable cancelTable;
@@ -149,12 +149,12 @@ static Tcl_ObjCmdProc BadEnsembleSubcommand;
static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr,
const char *oldName, const char *newName,
int flags);
-static int CancelEvalProc(ClientData clientData,
+static int CancelEvalProc(void *clientData,
Tcl_Interp *interp, int code);
static int CheckDoubleResult(Tcl_Interp *interp, double dResult);
-static void DeleteCoroutine(ClientData clientData);
+static void DeleteCoroutine(void *clientData);
static void DeleteInterpProc(Tcl_Interp *interp);
-static void DeleteOpCmdClientData(ClientData clientData);
+static void DeleteOpCmdClientData(void *clientData);
#ifdef USE_DTRACE
static Tcl_ObjCmdProc DTraceObjCmd;
static Tcl_NRPostProc DTraceCmdReturn;
@@ -192,7 +192,7 @@ static Tcl_NRPostProc NRCommand;
#if !defined(TCL_NO_DEPRECATED)
static Tcl_ObjCmdProc OldMathFuncProc;
-static void OldMathFuncDeleteProc(ClientData clientData);
+static void OldMathFuncDeleteProc(void *clientData);
#endif /* !defined(TCL_NO_DEPRECATED) */
static void ProcessUnexpectedResult(Tcl_Interp *interp,
int returnCode);
@@ -1314,7 +1314,7 @@ Tcl_CreateInterp(void)
static void
DeleteOpCmdClientData(
- ClientData clientData)
+ void *clientData)
{
TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
@@ -1479,7 +1479,7 @@ TclHideUnsafeCommands(
static int
BadEnsembleSubcommand(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
TCL_UNUSED(int) /*objc*/,
TCL_UNUSED(Tcl_Obj *const *) /* objv */)
@@ -1519,7 +1519,7 @@ Tcl_CallWhenDeleted(
Tcl_Interp *interp, /* Interpreter to watch. */
Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about
* to be deleted. */
- ClientData clientData) /* One-word value to pass to proc. */
+ void *clientData) /* One-word value to pass to proc. */
{
Interp *iPtr = (Interp *) interp;
static Tcl_ThreadDataKey assocDataCounterKey;
@@ -1567,7 +1567,7 @@ Tcl_DontCallWhenDeleted(
Tcl_Interp *interp, /* Interpreter to watch. */
Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about
* to be deleted. */
- ClientData clientData) /* One-word value to pass to proc. */
+ void *clientData) /* One-word value to pass to proc. */
{
Interp *iPtr = (Interp *) interp;
Tcl_HashTable *hTablePtr;
@@ -1615,7 +1615,7 @@ Tcl_SetAssocData(
const char *name, /* Name for association. */
Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to
* be deleted. */
- ClientData clientData) /* One-word value to pass to proc. */
+ void *clientData) /* One-word value to pass to proc. */
{
Interp *iPtr = (Interp *) interp;
AssocData *dPtr;
@@ -1697,7 +1697,7 @@ Tcl_DeleteAssocData(
*----------------------------------------------------------------------
*/
-ClientData
+void *
Tcl_GetAssocData(
Tcl_Interp *interp, /* Interpreter associated with. */
const char *name, /* Name of association. */
@@ -2070,7 +2070,7 @@ DeleteInterpProc(
if (eclPtr->type == TCL_LOCATION_SOURCE) {
Tcl_DecrRefCount(eclPtr->path);
}
- for (i=0; i< eclPtr->nuloc; i++) {
+ for (i=0; i<eclPtr->nuloc; i++) {
ckfree(eclPtr->loc[i].line);
}
@@ -2501,7 +2501,7 @@ Tcl_CreateCommand(
* specified namespace; otherwise it is put in
* the global namespace. */
Tcl_CmdProc *proc, /* Function to associate with cmdName. */
- ClientData clientData, /* Arbitrary value passed to string proc. */
+ void *clientData, /* Arbitrary value passed to string proc. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
* this command is deleted. */
@@ -2699,7 +2699,7 @@ Tcl_CreateObjCommand(
* the global namespace. */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
- ClientData clientData, /* Arbitrary value to pass to object
+ void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc
/* If not NULL, gives a function to call when
@@ -2749,7 +2749,7 @@ TclCreateObjCommandInNs(
Tcl_Namespace *namesp, /* The namespace to create the command in */
Tcl_ObjCmdProc *proc, /* Object-based function to associate with
* name. */
- ClientData clientData, /* Arbitrary value to pass to object
+ void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
@@ -2935,7 +2935,7 @@ TclCreateObjCommandInNs(
int
TclInvokeStringCommand(
- ClientData clientData, /* Points to command's Command structure. */
+ void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -2983,7 +2983,7 @@ TclInvokeStringCommand(
int
TclInvokeObjectCommand(
- ClientData clientData, /* Points to command's Command structure. */
+ void *clientData, /* Points to command's Command structure. */
Tcl_Interp *interp, /* Current interpreter. */
int argc, /* Number of arguments. */
const char **argv) /* Argument strings. */
@@ -3872,7 +3872,7 @@ CallCommandTraces(
static int
CancelEvalProc(
- ClientData clientData, /* Interp to cancel the script in progress. */
+ void *clientData, /* Interp to cancel the script in progress. */
TCL_UNUSED(Tcl_Interp *),
int code) /* Current return code from command. */
{
@@ -3992,7 +3992,7 @@ Tcl_CreateMathFunc(
* argument. */
Tcl_MathProc *proc, /* C function that implements the math
* function. */
- ClientData clientData) /* Additional value to pass to the
+ void *clientData) /* Additional value to pass to the
* function. */
{
Tcl_DString bigName;
@@ -4033,7 +4033,7 @@ Tcl_CreateMathFunc(
static int
OldMathFuncProc(
- ClientData clientData, /* Pointer to OldMathFuncData describing the
+ void *clientData, /* Pointer to OldMathFuncData describing the
* function being called */
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Actual parameter count */
@@ -4180,7 +4180,7 @@ OldMathFuncProc(
static void
OldMathFuncDeleteProc(
- ClientData clientData)
+ void *clientData)
{
OldMathFuncData *dataPtr = (OldMathFuncData *)clientData;
@@ -4219,7 +4219,7 @@ Tcl_GetMathFuncInfo(
int *numArgsPtr,
Tcl_ValueType **argTypesPtr,
Tcl_MathProc **procPtr,
- ClientData *clientDataPtr)
+ void **clientDataPtr)
{
Tcl_Obj *cmdNameObj;
Command *cmdPtr;
@@ -4382,7 +4382,7 @@ TclInterpReady(
* probably because of an infinite loop somewhere.
*/
- if (((iPtr->numLevels) <= iPtr->maxNestingDepth)) {
+ if ((iPtr->numLevels <= iPtr->maxNestingDepth)) {
return TCL_OK;
}
@@ -4561,7 +4561,7 @@ Tcl_CancelEval(
* script. */
Tcl_Obj *resultObjPtr, /* The script cancellation error message or
* NULL for a default error message. */
- ClientData clientData, /* Passed to CancelEvalProc. */
+ void *clientData, /* Passed to CancelEvalProc. */
int flags) /* Collection of OR-ed bits that control
* the cancellation of the script. Only
* TCL_CANCEL_UNWIND is currently
@@ -4720,7 +4720,7 @@ TclNREvalObjv(
static int
EvalObjvCore(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
@@ -4880,12 +4880,12 @@ EvalObjvCore(
static int
Dispatch(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
Tcl_ObjCmdProc *objProc = (Tcl_ObjCmdProc *)data[0];
- ClientData clientData = data[1];
+ void *clientData = data[1];
int objc = PTR2INT(data[2]);
Tcl_Obj **objv = (Tcl_Obj **)data[3];
Interp *iPtr = (Interp *) interp;
@@ -4968,7 +4968,7 @@ TclNRRunCallbacks(
static int
NRCommand(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -5041,7 +5041,7 @@ TEOV_PushExceptionHandlers(
*/
TclNRAddCallback(interp, TEOV_Error, INT2PTR(objc),
- (ClientData) objv, NULL, NULL);
+ objv, NULL, NULL);
}
if (iPtr->numLevels == 1) {
@@ -5072,7 +5072,7 @@ TEOV_SwitchVarFrame(
static int
TEOV_RestoreVarFrame(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -5082,7 +5082,7 @@ TEOV_RestoreVarFrame(
static int
TEOV_Exception(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -5111,7 +5111,7 @@ TEOV_Exception(
static int
TEOV_Error(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -5237,7 +5237,7 @@ TEOV_NotFound(
static int
TEOV_NotFoundCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -5317,7 +5317,7 @@ TEOV_RunEnterTraces(
static int
TEOV_RunLeaveTraces(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -5539,7 +5539,8 @@ TclEvalEx(
Tcl_Obj **objv, **objvSpace;
int *expand, *lines, *lineSpace;
Tcl_Token *tokenPtr;
- int commandLength, bytesLeft, expandRequested, code = TCL_OK;
+ int bytesLeft, expandRequested, code = TCL_OK;
+ int commandLength;
CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
* TCL_EVAL_GLOBAL was set. */
int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
@@ -5716,7 +5717,7 @@ TclEvalEx(
wordStart = tokenPtr->start;
lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
- ? wordLine : -1;
+ ? wordLine : TCL_INDEX_NONE;
if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
iPtr->evalFlags |= TCL_EVAL_FILE;
@@ -6708,7 +6709,7 @@ TclNREvalObjEx(
static int
TEOEx_ByteCodeCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -6754,7 +6755,7 @@ TEOEx_ByteCodeCallback(
static int
TEOEx_ListCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -6961,7 +6962,7 @@ Tcl_ExprLongObj(
Tcl_Obj *resultPtr;
int result, type;
double d;
- ClientData internalPtr;
+ void *internalPtr;
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result != TCL_OK) {
@@ -7007,7 +7008,7 @@ Tcl_ExprDoubleObj(
{
Tcl_Obj *resultPtr;
int result, type;
- ClientData internalPtr;
+ void *internalPtr;
result = Tcl_ExprObj(interp, objPtr, &resultPtr);
if (result != TCL_OK) {
@@ -7188,7 +7189,7 @@ TclNRInvoke(
static int
NRPostInvoke(
- TCL_UNUSED(ClientData *),
+ TCL_UNUSED(void **),
Tcl_Interp *interp,
int result)
{
@@ -7390,7 +7391,7 @@ Tcl_AddObjErrorInfo(
}
/*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*
* Tcl_VarEvalVA --
*
@@ -7399,12 +7400,12 @@ Tcl_AddObjErrorInfo(
*
* Results:
* A standard Tcl return result. An error message or other result may be
- * left in the interp's result.
+ * left in the interp.
*
* Side effects:
* Depends on what was done by the command.
*
- *---------------------------------------------------------------------------
+ *----------------------------------------------------------------------
*/
int
@@ -7712,7 +7713,7 @@ ExprIsqrtFunc(
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Actual parameter list. */
{
- ClientData ptr;
+ void *ptr;
int type;
double d;
Tcl_WideInt w;
@@ -7865,7 +7866,7 @@ ExprSqrtFunc(
static int
ExprUnaryFunc(
- ClientData clientData, /* Contains the address of a function that
+ void *clientData, /* Contains the address of a function that
* takes one double argument and returns a
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
@@ -7929,7 +7930,7 @@ CheckDoubleResult(
static int
ExprBinaryFunc(
- ClientData clientData, /* Contains the address of a function that
+ void *clientData, /* Contains the address of a function that
* takes two double arguments and returns a
* double result. */
Tcl_Interp *interp, /* The interpreter in which to execute the
@@ -7987,7 +7988,7 @@ ExprAbsFunc(
int objc, /* Actual parameter count. */
Tcl_Obj *const *objv) /* Parameter vector. */
{
- ClientData ptr;
+ void *ptr;
int type;
mp_int big;
@@ -8145,7 +8146,7 @@ ExprIntFunc(
{
double d;
int type;
- ClientData ptr;
+ void *ptr;
if (objc != 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
@@ -8224,7 +8225,7 @@ ExprMaxMinFunc(
Tcl_Obj *res;
double d;
int type, i;
- ClientData ptr;
+ void *ptr;
if (objc < 2) {
MathFuncWrongNumArgs(interp, 2, objc, objv);
@@ -8376,7 +8377,7 @@ ExprRoundFunc(
Tcl_Obj *const *objv) /* Parameter vector. */
{
double d;
- ClientData ptr;
+ void *ptr;
int type;
if (objc != 2) {
@@ -8644,7 +8645,7 @@ ExprIsFiniteFunc(
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
- ClientData ptr;
+ void *ptr;
int type, result = 0;
if (objc != 2) {
@@ -8675,7 +8676,7 @@ ExprIsInfinityFunc(
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
- ClientData ptr;
+ void *ptr;
int type, result = 0;
if (objc != 2) {
@@ -8705,7 +8706,7 @@ ExprIsNaNFunc(
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
- ClientData ptr;
+ void *ptr;
int type, result = 1;
if (objc != 2) {
@@ -8735,7 +8736,7 @@ ExprIsNormalFunc(
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
- ClientData ptr;
+ void *ptr;
int type, result = 0;
if (objc != 2) {
@@ -8765,7 +8766,7 @@ ExprIsSubnormalFunc(
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
- ClientData ptr;
+ void *ptr;
int type, result = 0;
if (objc != 2) {
@@ -8795,7 +8796,7 @@ ExprIsUnorderedFunc(
Tcl_Obj *const *objv) /* Actual parameter list */
{
double d;
- ClientData ptr;
+ void *ptr;
int type, result = 0;
if (objc != 3) {
@@ -8837,7 +8838,7 @@ FloatClassifyObjCmd(
{
double d;
Tcl_Obj *objPtr;
- ClientData ptr;
+ void *ptr;
int type;
if (objc != 2) {
@@ -9041,7 +9042,7 @@ TclDTraceInfo(
static int
DTraceCmdReturn(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -9086,7 +9087,7 @@ int
Tcl_NRCallObjProc(
Tcl_Interp *interp,
Tcl_ObjCmdProc *objProc,
- ClientData clientData,
+ void *clientData,
int objc,
Tcl_Obj *const objv[])
{
@@ -9138,7 +9139,7 @@ Tcl_NRCreateCommand(
* calls. */
Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with
* name, provides NR implementation */
- ClientData clientData, /* Arbitrary value to pass to object
+ void *clientData, /* Arbitrary value to pass to object
* function. */
Tcl_CmdDeleteProc *deleteProc)
/* If not NULL, gives a function to call when
@@ -9159,7 +9160,7 @@ TclNRCreateCommandInNs(
Tcl_Namespace *nsPtr,
Tcl_ObjCmdProc *proc,
Tcl_ObjCmdProc *nreProc,
- ClientData clientData,
+ void *clientData,
Tcl_CmdDeleteProc *deleteProc)
{
Command *cmdPtr = (Command *)
@@ -9387,7 +9388,7 @@ TclNRTailcallObjCmd(
int
TclNRTailcallEval(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -9426,7 +9427,7 @@ TclNRTailcallEval(
int
TclNRReleaseValues(
- ClientData data[],
+ void *data[],
TCL_UNUSED(Tcl_Interp *),
int result)
{
@@ -9447,10 +9448,10 @@ void
Tcl_NRAddCallback(
Tcl_Interp *interp,
Tcl_NRPostProc *postProcPtr,
- ClientData data0,
- ClientData data1,
- ClientData data2,
- ClientData data3)
+ void *data0,
+ void *data1,
+ void *data2,
+ void *data3)
{
if (!(postProcPtr)) {
Tcl_Panic("Adding a callback without an objProc?!");
@@ -9484,7 +9485,7 @@ Tcl_NRAddCallback(
int
TclNRYieldObjCmd(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
@@ -9568,7 +9569,7 @@ TclNRYieldToObjCmd(
static int
RewindCoroutineCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
@@ -9595,7 +9596,7 @@ RewindCoroutine(
static void
DeleteCoroutine(
- ClientData clientData)
+ void *clientData)
{
CoroutineData *corPtr = (CoroutineData *)clientData;
Tcl_Interp *interp = corPtr->eePtr->interp;
@@ -9608,7 +9609,7 @@ DeleteCoroutine(
static int
NRCoroutineCallerCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -9654,7 +9655,7 @@ NRCoroutineCallerCallback(
static int
NRCoroutineExitCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -9719,7 +9720,7 @@ NRCoroutineExitCallback(
int
TclNRCoroutineActivateCallback(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
@@ -9813,7 +9814,7 @@ TclNRCoroutineActivateCallback(
static int
TclNREvalList(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
@@ -10071,7 +10072,7 @@ TclNRCoroProbeObjCmd(
static int
InjectHandler(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
TCL_UNUSED(int) /*result*/)
{
@@ -10117,7 +10118,7 @@ InjectHandler(
static int
InjectHandlerPostCall(
- ClientData data[],
+ void *data[],
Tcl_Interp *interp,
int result)
{
@@ -10211,7 +10212,7 @@ NRInjectObjCmd(
int
TclNRInterpCoroutine(
- ClientData clientData,
+ void *clientData,
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -10242,7 +10243,7 @@ TclNRInterpCoroutine(
}
break;
default:
- if (corPtr->nargs != objc-1) {
+ if (corPtr->nargs + 1 != objc) {
Tcl_SetObjResult(interp,
Tcl_NewStringObj("wrong coro nargs; how did we get here? "
"not implemented!", -1));
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index f7479f0..80d8a09 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -780,12 +780,12 @@ TclSetByteCodeFromAny(
* compiled. Must not be NULL. */
Tcl_Obj *objPtr, /* The object to make a ByteCode object. */
CompileHookProc *hookProc, /* Procedure to invoke after compilation. */
- ClientData clientData) /* Hook procedure private data. */
+ void *clientData) /* Hook procedure private data. */
{
Interp *iPtr = (Interp *) interp;
CompileEnv compEnv; /* Compilation environment structure allocated
* in frame. */
- size_t length;
+ int length;
int result = TCL_OK;
const char *stringPtr;
Proc *procPtr = iPtr->compiledProcPtr;
@@ -801,8 +801,7 @@ TclSetByteCodeFromAny(
}
#endif
- stringPtr = TclGetString(objPtr);
- length = objPtr->length;
+ stringPtr = TclGetStringFromObj(objPtr, &length);
/*
* TIP #280: Pick up the CmdFrame in which the BC compiler was invoked, and
@@ -1055,7 +1054,7 @@ CleanupByteCode(
statsPtr = &iPtr->stats;
statsPtr->numByteCodesFreed++;
- statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes;
+ statsPtr->currentSrcBytes -= (double)codePtr->numSrcBytes;
statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize;
statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes;
@@ -1149,7 +1148,7 @@ CleanupByteCode(
}
}
- if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) {
+ if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) {
TclFreeLocalCache(interp, codePtr->localCachePtr);
}
@@ -1819,10 +1818,10 @@ CompileCmdLiteral(
Tcl_Obj *cmdObj,
CompileEnv *envPtr)
{
- int numBytes;
const char *bytes;
Command *cmdPtr;
int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME;
+ int numBytes;
cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj);
if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) {
@@ -1847,7 +1846,8 @@ TclCompileInvocation(
CompileEnv *envPtr)
{
DefineLineInformation;
- int wordIdx = 0, depth = TclGetStackDepth(envPtr);
+ int wordIdx = 0;
+ int depth = TclGetStackDepth(envPtr);
if (cmdObj) {
CompileCmdLiteral(interp, cmdObj, envPtr);
@@ -2332,8 +2332,8 @@ TclCompileVarSubst(
CompileEnv *envPtr)
{
const char *p, *name = tokenPtr[1].start;
- int nameBytes = tokenPtr[1].size;
- int i, localVar, localVarName = 1;
+ int i, localVar, nameBytes = tokenPtr[1].size;
+ int localVarName = 1;
/*
* Determine how the variable name should be handled: if it contains any
@@ -2360,7 +2360,7 @@ TclCompileVarSubst(
* of local variables in a procedure frame.
*/
- localVar = -1;
+ localVar = TCL_INDEX_NONE;
if (localVarName != -1) {
localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr);
}
@@ -2407,7 +2407,8 @@ TclCompileTokens(
Tcl_DString textBuffer; /* Holds concatenated chars from adjacent
* TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
char buffer[4] = "";
- int i, numObjsToConcat, length, adjust;
+ int i, numObjsToConcat, adjust;
+ int length;
unsigned char *entryCodeNext = envPtr->codeNext;
#define NUM_STATIC_POS 20
int isLiteral, maxNumCL, numCL;
@@ -3003,7 +3004,7 @@ TclFindCompiledLocal(
CompileEnv *envPtr) /* Points to the current compile environment*/
{
CompiledLocal *localPtr;
- int localVar = -1;
+ int localVar = TCL_INDEX_NONE;
int i;
Proc *procPtr;
@@ -3026,20 +3027,19 @@ TclFindCompiledLocal(
int len;
if (!cachePtr || !name) {
- return -1;
+ return TCL_INDEX_NONE;
}
varNamePtr = &cachePtr->varName0;
for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
if (*varNamePtr) {
- localName = TclGetString(*varNamePtr);
- len = (*varNamePtr)->length;
+ localName = TclGetStringFromObj(*varNamePtr, &len);
if ((len == nameBytes) && !strncmp(name, localName, len)) {
return i;
}
}
}
- return -1;
+ return TCL_INDEX_NONE;
}
if (name != NULL) {
@@ -3131,8 +3131,8 @@ TclExpandCodeArray(
envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes);
} else {
/*
- * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so
- * perform the equivalent of Tcl_Realloc directly.
+ * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so
+ * perform the equivalent of Tcl_Realloc directly.
*/
unsigned char *newPtr = (unsigned char *)ckalloc(newBytes);
@@ -3220,8 +3220,8 @@ EnterCmdStartData(
cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex];
cmdLocPtr->codeOffset = codeOffset;
cmdLocPtr->srcOffset = srcOffset;
- cmdLocPtr->numSrcBytes = -1;
- cmdLocPtr->numCodeBytes = -1;
+ cmdLocPtr->numSrcBytes = TCL_INDEX_NONE;
+ cmdLocPtr->numCodeBytes = TCL_INDEX_NONE;
}
/*
@@ -3307,7 +3307,8 @@ EnterCmdWordData(
{
ECL *ePtr;
const char *last;
- int wordIdx, wordLine, *wwlines, *wordNext;
+ int wordIdx, wordLine;
+ int *wwlines, *wordNext;
if (eclPtr->nuloc >= eclPtr->nloc) {
/*
@@ -3342,7 +3343,7 @@ EnterCmdWordData(
/* See Ticket 4b61afd660 */
wwlines[wordIdx] =
((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
- ? wordLine : -1;
+ ? wordLine : TCL_INDEX_NONE;
ePtr->line[wordIdx] = wordLine;
ePtr->next[wordIdx] = wordNext;
last = tokenPtr->start;
@@ -3392,7 +3393,7 @@ TclCreateExceptRange(
size_t currBytes =
envPtr->exceptArrayNext * sizeof(ExceptionRange);
size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux);
- int newElems = 2*envPtr->exceptArrayEnd;
+ size_t newElems = 2*envPtr->exceptArrayEnd;
size_t newBytes = newElems * sizeof(ExceptionRange);
size_t newBytes2 = newElems * sizeof(ExceptionAux);
@@ -3423,16 +3424,16 @@ TclCreateExceptRange(
rangePtr = &envPtr->exceptArrayPtr[index];
rangePtr->type = type;
rangePtr->nestingLevel = envPtr->exceptDepth;
- rangePtr->codeOffset = -1;
- rangePtr->numCodeBytes = -1;
- rangePtr->breakOffset = -1;
- rangePtr->continueOffset = -1;
- rangePtr->catchOffset = -1;
+ rangePtr->codeOffset = TCL_INDEX_NONE;
+ rangePtr->numCodeBytes = TCL_INDEX_NONE;
+ rangePtr->breakOffset = TCL_INDEX_NONE;
+ rangePtr->continueOffset = TCL_INDEX_NONE;
+ rangePtr->catchOffset = TCL_INDEX_NONE;
auxPtr = &envPtr->exceptAuxArrayPtr[index];
auxPtr->supportsContinue = 1;
auxPtr->stackDepth = envPtr->currStackDepth;
auxPtr->expandTarget = envPtr->expandCount;
- auxPtr->expandTargetDepth = -1;
+ auxPtr->expandTargetDepth = TCL_INDEX_NONE;
auxPtr->numBreakTargets = 0;
auxPtr->breakTargets = NULL;
auxPtr->allocBreakTargets = 0;
@@ -3462,14 +3463,14 @@ TclGetInnermostExceptionRange(
int returnCode,
ExceptionAux **auxPtrPtr)
{
- int i = envPtr->exceptArrayNext;
+ size_t i = envPtr->exceptArrayNext;
ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i;
while (i > 0) {
rangePtr--; i--;
if (CurrentOffset(envPtr) >= rangePtr->codeOffset &&
- (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) <
+ (rangePtr->numCodeBytes == TCL_INDEX_NONE || CurrentOffset(envPtr) <
rangePtr->codeOffset+rangePtr->numCodeBytes) &&
(returnCode != TCL_CONTINUE ||
envPtr->exceptAuxArrayPtr[i].supportsContinue)) {
@@ -3566,7 +3567,7 @@ TclCleanupStackForBreakContinue(
CompileEnv *envPtr,
ExceptionAux *auxPtr)
{
- int savedStackDepth = envPtr->currStackDepth;
+ size_t savedStackDepth = envPtr->currStackDepth;
int toPop = envPtr->expandCount - auxPtr->expandTarget;
if (toPop > 0) {
@@ -3620,7 +3621,7 @@ StartExpanding(
if (rangePtr->codeOffset > CurrentOffset(envPtr)) {
continue;
}
- if (rangePtr->numCodeBytes != -1) {
+ if (rangePtr->numCodeBytes != TCL_INDEX_NONE) {
continue;
}
@@ -3680,7 +3681,7 @@ TclFinalizeLoopExceptionRange(
}
for (i=0 ; i<auxPtr->numContinueTargets ; i++) {
site = envPtr->codeStart + auxPtr->continueTargets[i];
- if (rangePtr->continueOffset == -1) {
+ if (rangePtr->continueOffset == TCL_INDEX_NONE) {
int j;
/*
@@ -3735,7 +3736,7 @@ TclFinalizeLoopExceptionRange(
int
TclCreateAuxData(
- ClientData clientData, /* The compilation auxiliary data to store in
+ void *clientData, /* The compilation auxiliary data to store in
* the new aux data record. */
const AuxDataType *typePtr, /* Pointer to the type to attach to this
* AuxData */
@@ -3755,7 +3756,7 @@ TclCreateAuxData(
*/
size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData);
- int newElems = 2*envPtr->auxDataArrayEnd;
+ size_t newElems = 2*envPtr->auxDataArrayEnd;
size_t newBytes = newElems * sizeof(AuxData);
if (envPtr->mallocedAuxDataArray) {
@@ -3844,7 +3845,7 @@ TclExpandJumpFixupArray(
*/
size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup);
- int newElems = 2*(fixupArrayPtr->end + 1);
+ size_t newElems = 2*(fixupArrayPtr->end + 1);
size_t newBytes = newElems * sizeof(JumpFixup);
if (fixupArrayPtr->mallocedArray) {
@@ -3989,7 +3990,7 @@ TclFixupForwardJump(
{
unsigned char *jumpPc, *p;
int firstCmd, lastCmd, firstRange, lastRange, k;
- unsigned numBytes;
+ size_t numBytes;
if (jumpDist <= distThreshold) {
jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset;
@@ -4058,7 +4059,7 @@ TclFixupForwardJump(
switch (rangePtr->type) {
case LOOP_EXCEPTION_RANGE:
rangePtr->breakOffset += 3;
- if (rangePtr->continueOffset != -1) {
+ if (rangePtr->continueOffset != TCL_INDEX_NONE) {
rangePtr->continueOffset += 3;
}
break;
@@ -4175,7 +4176,7 @@ TclEmitInvoke(
if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
auxContinuePtr = NULL;
} else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
- && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
+ && (auxContinuePtr->expandTarget+expandCount == envPtr->expandCount)) {
auxContinuePtr = NULL;
} else {
continueRange = auxContinuePtr - envPtr->exceptAuxArrayPtr;
@@ -4185,8 +4186,8 @@ TclEmitInvoke(
if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
auxBreakPtr = NULL;
} else if (auxContinuePtr == NULL
- && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
- && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
+ && auxBreakPtr->stackDepth+wordCount == envPtr->currStackDepth
+ && auxBreakPtr->expandTarget+expandCount == envPtr->expandCount) {
auxBreakPtr = NULL;
} else {
breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index f2dd98a..17635e7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2277,7 +2277,7 @@ TclUpdateReturnInfo(
Tcl_ObjCmdProc *
TclGetObjInterpProc(void)
{
- return (Tcl_ObjCmdProc *) TclObjInterpProc;
+ return TclObjInterpProc;
}
/*
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 2fbf854..13d91d9 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1046,7 +1046,7 @@ Tcl_GetRange(
int numChars = Tcl_NumUtfChars(objPtr->bytes, objPtr->length);
- if (last >= numChars) {
+ if (last < 0 || last >= numChars) {
last = numChars - 1;
}
if (last < first) {
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 46d2f90..f06b2d1 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -17,11 +17,13 @@ MODULE_SCOPE const TclStubs *tclStubsPtr;
MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
+MODULE_SCOPE void *tclStubsHandle;
const TclStubs *tclStubsPtr = NULL;
const TclPlatStubs *tclPlatStubsPtr = NULL;
const TclIntStubs *tclIntStubsPtr = NULL;
const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
+void *tclStubsHandle = NULL;
/*
* Use our own ISDIGIT to avoid linking to libc on windows
@@ -56,10 +58,12 @@ Tcl_InitStubs(
{
Interp *iPtr = (Interp *)interp;
const char *actualVersion = NULL;
- ClientData pkgData = NULL;
+ void *pkgData = NULL;
const TclStubs *stubsPtr = iPtr->stubTable;
const char *tclName = (((exact&0xFF00) >= 0x900) ? "tcl" : "Tcl");
+#undef TCL_STUB_MAGIC /* We need the TCL_STUB_MAGIC from Tcl 8.x here */
+#define TCL_STUB_MAGIC ((int) 0xFCA3BACF)
/*
* We can't optimize this check by caching tclStubsPtr because that
* prevents apps from being able to load/unload Tcl dynamically multiple
@@ -106,6 +110,9 @@ Tcl_InitStubs(
/* We are running Tcl 8.x */
stubsPtr = (TclStubs *)pkgData;
}
+ if (tclStubsHandle == NULL) {
+ tclStubsHandle = INT2PTR(-1);
+ }
tclStubsPtr = stubsPtr;
if (stubsPtr->hooks) {
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 223eb98..a03a60a 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -1164,7 +1164,7 @@ TeststringobjCmd(
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
- "set", "set2", "setlength", "maxchars", "appendself",
+ "set", "set2", "setlength", "maxchars", "range", "appendself",
"appendself2", NULL
};
@@ -1335,7 +1335,19 @@ TeststringobjCmd(
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
break;
- case 10: /* appendself */
+ case 10: { /* range */
+ int first, last;
+ if (objc != 5) {
+ goto wrongNumArgs;
+ }
+ if ((Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK)
+ || (Tcl_GetIntFromObj(interp, objv[4], &last) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last));
+ break;
+ }
+ case 11: /* appendself */
if (objc != 4) {
goto wrongNumArgs;
}
@@ -1366,7 +1378,7 @@ TeststringobjCmd(
Tcl_AppendToObj(varPtr[varIndex], string + length, size - length);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
- case 11: /* appendself2 */
+ case 12: /* appendself2 */
if (objc != 4) {
goto wrongNumArgs;
}
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 87003e4..48e1b4b 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
package require Tcl 8.6-
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
-package provide http 2.10a3
+package provide http 2.10a4
namespace eval http {
# Allow resourcing to not clobber existing data
@@ -270,26 +270,11 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
}
# Is this an upgrade request/response?
- set upgradeResponse 0
- if { [info exists state(upgradeRequest)]
- && [info exists state(http)]
- && $state(upgradeRequest)
- && ([ncode $token] eq {101})
- } {
- # An upgrade must be requested by the client.
- # If 101 response, test server response headers for an upgrade.
- set connectionHd {}
- set upgradeHd {}
- if {[dict exists $state(meta) connection]} {
- set connectionHd [string tolower [dict get $state(meta) connection]]
- }
- if {[dict exists $state(meta) upgrade]} {
- set upgradeHd [string tolower [dict get $state(meta) upgrade]]
- }
- if {($connectionHd eq {upgrade}) && ($upgradeHd ne {})} {
- set upgradeResponse 1
- }
- }
+ set upgradeResponse \
+ [expr { [info exists state(upgradeRequest)] && $state(upgradeRequest)
+ && [info exists state(http)] && [ncode $token] eq {101}
+ && [info exists state(connection)] && "upgrade" in $state(connection)
+ && [info exists state(upgrade)] && "" ne $state(upgrade)}]
if { ($state(status) eq "timeout")
|| ($state(status) eq "error")
@@ -311,7 +296,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
catch {fileevent $state(sock) writable {}}
} elseif {
([info exists state(-keepalive)] && !$state(-keepalive))
- || ([info exists state(connection)] && ($state(connection) eq "close"))
+ || ([info exists state(connection)] && ("close" in $state(connection)))
} {
set closeQueue 1
set connId $state(socketinfo)
@@ -319,7 +304,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
CloseSocket $state(sock) $token
} elseif {
([info exists state(-keepalive)] && $state(-keepalive))
- && ([info exists state(connection)] && ($state(connection) ne "close"))
+ && ([info exists state(connection)] && ("close" ni $state(connection)))
} {
KeepSocket $token
}
@@ -350,7 +335,7 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
# queued task if possible. Otherwise leave it idle and ready for its next
# use.
#
-# If $socketClosing(*), then ($state(connection) eq "close") and therefore
+# If $socketClosing(*), then ("close" in $state(connection)) and therefore
# this command will not be called by Finish.
#
# Arguments:
@@ -499,7 +484,7 @@ proc http::KeepSocket {token} {
(!$state(-pipeline))
&& [info exists socketWrQueue($connId)]
&& [llength $socketWrQueue($connId)]
- && ($state(connection) ne "close")
+ && ("close" ni $state(connection))
} {
# If not pipelined, (socketRdState eq Rready) tells us that we are
# ready for the next write - there is no need to check
@@ -785,7 +770,7 @@ proc http::geturl {url args} {
-strict boolean
-timeout integer
-validate boolean
- -headers dict
+ -headers list
}
set state(charset) $defaultCharset
set options {
@@ -799,13 +784,18 @@ proc http::geturl {url args} {
foreach {flag value} $args {
if {[regexp -- $pat $flag]} {
# Validate numbers
- if {($flag eq "-headers") ? [catch {dict size $value}] :
- ([info exists type($flag)] && ![string is $type($flag) -strict $value])
+ if { [info exists type($flag)]
+ && (![string is $type($flag) -strict $value])
} {
unset $token
return -code error \
"Bad value for $flag ($value), must be $type($flag)"
}
+ if {($flag eq "-headers") && ([llength $value] % 2 != 0)} {
+ unset $token
+ return -code error \
+ "Bad value for $flag ($value), number of list elements must be even"
+ }
set state($flag) $value
} else {
unset $token
@@ -1002,12 +992,14 @@ proc http::geturl {url args} {
# c11a51c482]
set state(accept-types) $http(-accept)
- set state(upgradeRequest) [expr {
- [dict exists $state(-headers) Upgrade]
- && [dict exists $state(-headers) Connection]
- && ([dict get $state(-headers) Connection] eq {Upgrade})
- && ([dict get $state(-headers) Upgrade] ne {})
- }]
+ # Check whether this is an Upgrade request.
+ set connectionValues [SplitCommaSeparatedFieldValue \
+ [GetFieldValue $state(-headers) Connection]]
+ set connectionValues [string tolower $connectionValues]
+ set upgradeValues [SplitCommaSeparatedFieldValue \
+ [GetFieldValue $state(-headers) Upgrade]]
+ set state(upgradeRequest) [expr { "upgrade" in $connectionValues
+ && [llength $upgradeValues] >= 1}]
if {$isQuery || $isQueryChannel} {
# It's a POST.
@@ -1424,11 +1416,11 @@ proc http::Connected {token proto phost srvurl} {
if {[catch {
set state(method) $how
puts $sock "$how $srvurl HTTP/$state(-protocol)"
- if {[dict exists $state(-headers) Host]} {
+ set hostValue [GetFieldValue $state(-headers) Host]
+ if {$hostValue ne {}} {
# Allow Host spoofing. [Bug 928154]
- set hostHdr [dict get $state(-headers) Host]
- regexp {^[^:]+} $hostHdr state(host)
- puts $sock "Host: $hostHdr"
+ regexp {^[^:]+} $hostValue state(host)
+ puts $sock "Host: $hostValue"
} elseif {$port == $defport} {
# Don't add port in this case, to handle broken servers. [Bug
# #504508]
@@ -1460,7 +1452,7 @@ proc http::Connected {token proto phost srvurl} {
# Proxy-Connection header field in any requests"
set accept_encoding_seen 0
set content_type_seen 0
- dict for {key value} $state(-headers) {
+ foreach {key value} $state(-headers) {
set value [string map [list \n "" \r ""] $value]
set key [string map {" " -} [string trim $key]]
if {[string equal -nocase $key "host"]} {
@@ -2673,7 +2665,7 @@ proc http::Event {sock token} {
if { ([info exists state(connection)])
&& ([info exists socketMapping($state(socketinfo))])
- && ($state(connection) eq "keep-alive")
+ && ("keep-alive" in $state(connection))
&& ($state(-keepalive))
&& (!$state(reusing))
&& ($state(-pipeline))
@@ -2695,7 +2687,7 @@ proc http::Event {sock token} {
if { ([info exists state(connection)])
&& ([info exists socketMapping($state(socketinfo))])
- && ($state(connection) eq "close")
+ && ("close" in $state(connection))
&& ($state(-keepalive))
} {
# The server warns that it will close the socket after this
@@ -2743,6 +2735,19 @@ proc http::Event {sock token} {
set state(state) body
+ # According to
+ # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
+ # any comma-separated "Connection:" list implies keep-alive, but I
+ # don't see this in the RFC so we'll play safe and
+ # scan any list for "close".
+ # Done here to support combining duplicate header field's values.
+ if { [info exists state(connection)]
+ && ("close" ni $state(connection))
+ && ("keep-alive" ni $state(connection))
+ } {
+ lappend state(connection) "keep-alive"
+ }
+
# If doing a HEAD, then we won't get any body
if {$state(-validate)} {
Log ^F$tk end of response for HEAD request - token $token
@@ -2766,7 +2771,7 @@ proc http::Event {sock token} {
# (totalsize == 0).
if { (!( [info exists state(connection)]
- && ($state(connection) eq "close")
+ && ("close" in $state(connection))
)
)
&& (![info exists state(transfer)])
@@ -2832,32 +2837,14 @@ proc http::Event {sock token} {
}
proxy-connection -
connection {
- set tmpHeader [string trim [string tolower $value]]
# RFC 7230 Section 6.1 states that a comma-separated
- # list is an acceptable value. According to
- # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Connection
- # any comma-separated list implies keep-alive, but I
- # don't see this in the RFC so we'll play safe and
- # scan any list for "close".
- if {$tmpHeader in {close keep-alive}} {
- # The common cases, continue.
- } elseif {[string first , $tmpHeader] < 0} {
- # Not a comma-separated list, not "close",
- # therefore "keep-alive".
- set tmpHeader keep-alive
- } else {
- set tmpResult keep-alive
- set tmpCsl [split $tmpHeader ,]
- # Optional whitespace either side of separator.
- foreach el $tmpCsl {
- if {[string trim $el] eq {close}} {
- set tmpResult close
- break
- }
- }
- set tmpHeader $tmpResult
+ # list is an acceptable value.
+ foreach el [SplitCommaSeparatedFieldValue $value] {
+ lappend state(connection) [string tolower $el]
}
- set state(connection) $tmpHeader
+ }
+ upgrade {
+ set state(upgrade) [string trim $value]
}
set-cookie {
if {$http(-cookiejar) ne ""} {
@@ -3662,6 +3649,52 @@ proc http::ReceiveChunked {chan command} {
}
}
+# http::SplitCommaSeparatedFieldValue --
+# Return the individual values of a comma-separated field value.
+#
+# Arguments:
+# fieldValue Comma-separated header field value.
+#
+# Results:
+# List of values.
+proc http::SplitCommaSeparatedFieldValue {fieldValue} {
+ set r {}
+ foreach el [split $fieldValue ,] {
+ lappend r [string trim $el]
+ }
+ return $r
+}
+
+
+# http::GetFieldValue --
+# Return the value of a header field.
+#
+# Arguments:
+# headers Headers key-value list
+# fieldName Name of header field whose value to return.
+#
+# Results:
+# The value of the fieldName header field
+#
+# Field names are matched case-insensitively (RFC 7230 Section 3.2).
+#
+# If the field is present multiple times, it is assumed that the field is
+# defined as a comma-separated list and the values are combined (by separating
+# them with commas, see RFC 7230 Section 3.2.2) and returned at once.
+proc http::GetFieldValue {headers fieldName} {
+ set r {}
+ foreach {field value} $headers {
+ if {[string equal -nocase $fieldName $field]} {
+ if {$r eq {}} {
+ set r $value
+ } else {
+ append r ", $value"
+ }
+ }
+ }
+ return $r
+}
+
proc http::make-transformation-chunked {chan command} {
coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
chan event $chan readable [namespace current]::dechunk$chan
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index aaa37f9..5437859 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
-package ifneeded http 2.10a3 [list tclPkgSetup $dir http 2.10a3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.10a4 [list tclPkgSetup $dir http 2.10a4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/manifest.txt b/library/manifest.txt
index 1cf251d..6b70b24 100644
--- a/library/manifest.txt
+++ b/library/manifest.txt
@@ -5,7 +5,7 @@ apply {{dir} {
set ::test [info script]
set isafe [interp issafe]
foreach {safe package version file} {
- 0 http 2.10a3 {http http.tcl}
+ 0 http 2.10a4 {http http.tcl}
1 msgcat 1.7.1 {msgcat msgcat.tcl}
1 opt 0.4.8 {opt optparse.tcl}
0 cookiejar 0.2.0 {cookiejar cookiejar.tcl}
diff --git a/tests/http.test b/tests/http.test
index e8f8405..a6f1ce6 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -463,9 +463,12 @@ test http-3.33 {http::geturl application/xml is text} -body {
} -cleanup {
catch { http::cleanup $token }
} -result {test 4660 /test}
-test http-3.34 {http::geturl -headers not a dict} -returnCodes error -body {
- http::geturl http://test/t -headers NoDict
-} -result {Bad value for -headers (NoDict), must be dict}
+test http-3.34 {http::geturl -headers not a list} -returnCodes error -body {
+ http::geturl http://test/t -headers \"
+} -result {Bad value for -headers ("), must be list}
+test http-3.35 {http::geturl -headers not even number of elements} -returnCodes error -body {
+ http::geturl http://test/t -headers {List Length 3}
+} -result {Bad value for -headers (List Length 3), number of list elements must be even}
test http-4.1 {http::Event} -body {
set token [http::geturl $url -keepalive 0]
diff --git a/tests/listObj.test b/tests/listObj.test
index f17f085..0b64635 100644
--- a/tests/listObj.test
+++ b/tests/listObj.test
@@ -195,6 +195,16 @@ test listobj-10.1 {Bug [2971669]} {*}{
}
-result {{a b c d e} {} {a b c d e f}}
}
+test listobj-10.2 {Tcl_ListObjReplace with negative start value} testobj {
+ testlistobj set 1 a b c d e
+ testlistobj replace 1 -1 2 f
+ testlistobj get 1
+} {f c d e}
+test listobj-10.3 {Tcl_ListObjReplace with negative count value} testobj {
+ testlistobj set 1 a b c d e
+ testlistobj replace 1 1 -1 f
+ testlistobj get 1
+} {a f b c d e}
test listobj-11.1 {Bug 3598580: Tcl_ListObjReplace refcount management} testobj {
testobj bug3598580
diff --git a/tests/stringObj.test b/tests/stringObj.test
index 0aa9a47..c1633bf 100644
--- a/tests/stringObj.test
+++ b/tests/stringObj.test
@@ -472,6 +472,31 @@ test stringObj-15.8 {Tcl_Append*ToObj: self appends} {testobj tip389 deprecated}
teststringobj set 1 foo
teststringobj appendself2 1 3
} foo
+
+test stringObj-16.0 {Tcl_GetRange: normal case} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 1 3
+} bcd
+test stringObj-16.1 {Tcl_GetRange: first > end} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 10 5
+} {}
+test stringObj-16.2 {Tcl_GetRange: last > end} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 3 13
+} de
+test stringObj-16.3 {Tcl_GetRange: first = -1} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 -1 3
+} abcd
+test stringObj-16.4 {Tcl_GetRange: last = -1} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 1 -1
+} bcde
+test stringObj-16.5 {Tcl_GetRange: fist = last = -1} {testobj deprecated} {
+ teststringobj set 1 abcde
+ teststringobj range 1 -1 -1
+} abcde
if {[testConstraint testobj]} {
testobj freeallvars
diff --git a/unix/Makefile.in b/unix/Makefile.in
index f6e442f..d0a9d86 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -1039,9 +1039,9 @@ install-libraries: libraries
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done
- @echo "Installing package http 2.10a3 as a Tcl Module"
+ @echo "Installing package http 2.10a4 as a Tcl Module"
@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \
- "$(MODULE_INSTALL_DIR)/8.6/http-2.10a3.tm"
+ "$(MODULE_INSTALL_DIR)/8.6/http-2.10a4.tm"
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/"
@for i in $(TOP_DIR)/library/opt/*.tcl; do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
index 37782ea..579c323 100644
--- a/unix/dltest/pkga.c
+++ b/unix/dltest/pkga.c
@@ -33,7 +33,7 @@
static int
Pkga_EqObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -78,7 +78,7 @@ Pkga_EqObjCmd(
static int
Pkga_QuoteObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index 2d525bc..e9645a4 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -37,7 +37,7 @@
static int
Pkgb_SubObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -79,7 +79,7 @@ Pkgb_SubObjCmd(
static int
Pkgb_UnsafeObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -93,12 +93,24 @@ Pkgb_UnsafeObjCmd(
static int
Pkgb_DemoObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetEncodingSearchPath(), -1));
+ Tcl_WideInt numChars;
+ int result;
+ (void)dummy;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "arg1 arg2 num");
+ return TCL_ERROR;
+ }
+ if (Tcl_GetWideIntFromObj(interp, objv[3], &numChars) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ result = Tcl_UtfNcmp(Tcl_GetString(objv[1]), Tcl_GetString(objv[2]), numChars);
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(result));
return TCL_OK;
}
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
index cd92cf7..8e9c829 100644
--- a/unix/dltest/pkgc.c
+++ b/unix/dltest/pkgc.c
@@ -33,7 +33,7 @@
static int
Pkgc_SubObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -72,7 +72,7 @@ Pkgc_SubObjCmd(
static int
Pkgc_UnsafeObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
index 0c98ec4..1b97d4c 100644
--- a/unix/dltest/pkgd.c
+++ b/unix/dltest/pkgd.c
@@ -33,7 +33,7 @@
static int
Pkgd_SubObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -72,7 +72,7 @@ Pkgd_SubObjCmd(
static int
Pkgd_UnsafeObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index 5aa48a5..369d894 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -33,7 +33,7 @@
static int
Pkgooa_StubsOKObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -88,6 +88,12 @@ static TclOOStubs stubsCopy = {
#ifdef Tcl_MethodIsPrivate
,NULL
#endif
+#ifdef Tcl_GetClassOfObject
+ ,NULL
+#endif
+#ifdef Tcl_GetObjectClassName
+ ,NULL
+#endif
};
DLLEXPORT int
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index 6d64352..16684a8 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -31,7 +31,7 @@ static Tcl_ThreadDataKey dataKey;
#define MAX_REGISTERED_COMMANDS 2
static void
-CommandDeleted(ClientData clientData)
+CommandDeleted(void *clientData)
{
Tcl_Command *cmdToken = (Tcl_Command *)clientData;
*cmdToken = NULL;
@@ -120,7 +120,7 @@ PkguaDeleteTokens(
static int
PkguaEqObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -165,7 +165,7 @@ PkguaEqObjCmd(
static int
PkguaQuoteObjCmd(
- ClientData dummy, /* Not used. */
+ void *dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument strings. */
diff --git a/win/Makefile.in b/win/Makefile.in
index edeb46f..cf1ea7b 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -573,9 +573,9 @@ ${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ ${TCL
|| echo 'ignore zip-error by adjust sfx process (not executable?)'; \
fi
-${TCL_LIB_FILE}: ${TCL_OBJS}
+${TCL_LIB_FILE}: ${TCL_OBJS} tclWinPanic.$(OBJEXT) ${DDE_OBJS} ${REG_OBJS}
@$(RM) ${TCL_LIB_FILE}
- @MAKE_LIB@ ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
+ @MAKE_LIB@ ${TCL_OBJS} tclWinPanic.$(OBJEXT) ${DDE_OBJS} ${REG_OBJS}
@POST_MAKE_LIB@
${DDE_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${DDE_OBJS}
@@ -878,8 +878,8 @@ install-libraries: libraries install-tzdata install-msgs
$(ROOT_DIR)/library/cookiejar/*.gz; do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \
done;
- @echo "Installing package http 2.10a3 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a3.tm";
+ @echo "Installing package http 2.10a4 as a Tcl Module";
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10a4.tm";
@echo "Installing package opt 0.4.7";
@for j in $(ROOT_DIR)/library/opt/*.tcl; do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
diff --git a/win/makefile.vc b/win/makefile.vc
index 6ff6118..7c61580 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -428,6 +428,7 @@ PLATFORMOBJS = \
$(TMP_DIR)\tclWinThrd.obj \
$(TMP_DIR)\tclWinTime.obj \
!if $(STATIC_BUILD)
+ $(TMP_DIR)\tclWinPanic.obj \
$(TMP_DIR)\tclWinReg.obj \
$(TMP_DIR)\tclWinDde.obj \
!else