summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compat/float.h14
-rw-r--r--doc/Object.32
-rw-r--r--doc/SaveResult.34
-rw-r--r--generic/tcl.decls17
-rw-r--r--generic/tclBasic.c2
-rw-r--r--generic/tclCmdMZ.c7
-rw-r--r--generic/tclDecls.h35
-rw-r--r--generic/tclDictObj.c9
-rw-r--r--generic/tclIOUtil.c1
-rw-r--r--generic/tclIndexObj.c3
-rw-r--r--generic/tclInt.decls56
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclIntDecls.h57
-rw-r--r--generic/tclListObj.c6
-rw-r--r--generic/tclMain.c6
-rw-r--r--generic/tclPkg.c91
-rw-r--r--generic/tclStubInit.c5
-rw-r--r--generic/tclUtil.c27
-rw-r--r--tests/package.test159
-rw-r--r--tests/split.test3
-rwxr-xr-xunix/configure10
-rw-r--r--unix/tcl.m41
-rw-r--r--unix/tclConfig.h.in3
-rw-r--r--unix/tclUnixPort.h5
-rw-r--r--win/tcl.dsp4
-rw-r--r--win/tclWinError.c2
-rw-r--r--win/tclWinThrd.c2
27 files changed, 299 insertions, 236 deletions
diff --git a/compat/float.h b/compat/float.h
deleted file mode 100644
index 411edbf..0000000
--- a/compat/float.h
+++ /dev/null
@@ -1,14 +0,0 @@
-/*
- * float.h --
- *
- * This is a dummy header file to #include in Tcl when there
- * is no float.h in /usr/include. Right now this file is empty:
- * Tcl contains #ifdefs to deal with the lack of definitions;
- * all it needs is for the #include statement to work.
- *
- * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
diff --git a/doc/Object.3 b/doc/Object.3
index bf80fe2..eadd041 100644
--- a/doc/Object.3
+++ b/doc/Object.3
@@ -257,7 +257,7 @@ The \fBincr\fR command first gets an integer from \fIx\fR's value
by calling \fBTcl_GetIntFromObj\fR.
This procedure checks whether the value is already an integer value.
Since it is not, it converts the value
-by setting the value's \fIinternalRep.longValue\fR member
+by setting the value's internal representation
to the integer \fB123\fR
and setting the value's \fItypePtr\fR
to point to the integer Tcl_ObjType structure.
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index b2270a2..6dd6cb6 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -54,9 +54,9 @@ is called, Tcl will take care of memory management.
.PP
The second triplet stores the snapshot of only the interpreter
result (not its complete state) in memory allocated by the caller.
-These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
+These routines are passed a pointer to \fBTcl_SavedResult\fR
that is used to store enough information to restore the interpreter result.
-This structure can be allocated on the stack of the calling
+\fBTcl_SavedResult\fR can be allocated on the stack of the calling
procedure. These routines do not save the state of any error
information in the interpreter (e.g. the \fB\-errorcode\fR or
\fB\-errorinfo\fR return options, when an error is in progress).
diff --git a/generic/tcl.decls b/generic/tcl.decls
index e3ea9bc..6142cfe 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -469,7 +469,6 @@ declare 128 {
declare 129 {
int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
-# This is obsolete, use Tcl_FSEvalFile
declare 130 {
int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
@@ -780,8 +779,7 @@ declare 218 {
declare 219 {
int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
-# Obsolete
-declare 220 {
+declare 220 {deprecated {}} {
int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 {
@@ -868,8 +866,7 @@ declare 244 {
declare 245 {
int Tcl_StringMatch(const char *str, const char *pattern)
}
-# Obsolete
-declare 246 {
+declare 246 {deprecated {}} {
int Tcl_TellOld(Tcl_Channel chan)
}
declare 247 {
@@ -945,10 +942,10 @@ declare 265 {
declare 266 {
void Tcl_ValidateAllMemory(const char *file, int line)
}
-declare 267 {
+declare 267 {deprecated {see TIP #422}} {
void Tcl_AppendResultVA(Tcl_Interp *interp, va_list argList)
}
-declare 268 {
+declare 268 {deprecated {see TIP #422}} {
void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList)
}
declare 269 {
@@ -976,16 +973,16 @@ declare 274 {
CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
const char *version, int exact)
}
-declare 275 {
+declare 275 {deprecated {see TIP #422}} {
void Tcl_SetErrorCodeVA(Tcl_Interp *interp, va_list argList)
}
-declare 276 {
+declare 276 {deprecated {see TIP #422}} {
int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList)
}
declare 277 {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
-declare 278 {
+declare 278 {deprecated {see TIP #422}} {
TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList)
}
declare 279 {
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index e6022ac..fe29db0 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -7722,7 +7722,7 @@ ExprRandFunc(
iPtr->flags |= RAND_SEED_INITIALIZED;
/*
- * To ensure different seeds in different threads (bug #416643),
+ * To ensure different seeds in different threads (bug #416643),
* take into consideration the thread this interp is running in.
*/
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index b6a8fe9..ad1dd5f 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1216,11 +1216,14 @@ Tcl_SplitObjCmd(
Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
for ( ; stringPtr < end; stringPtr += len) {
+ int fullchar;
len = TclUtfToUniChar(stringPtr, &ch);
+ fullchar = ch;
#if TCL_UTF_MAX == 4
if (!len) {
- continue;
+ len += TclUtfToUniChar(stringPtr, &ch);
+ fullchar = (((fullchar & 0x3ff) << 10) | (ch & 0x3ff)) + 0x10000;
}
#endif
@@ -1228,7 +1231,7 @@ Tcl_SplitObjCmd(
* Assume Tcl_UniChar is an integral type...
*/
- hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR((int) ch),
+ hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(fullchar),
&isNew);
if (isNew) {
TclNewStringObj(objPtr, stringPtr, len);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 5f83636..3dc6627 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -669,7 +669,8 @@ EXTERN int Tcl_ScanElement(const char *src, int *flagPtr);
EXTERN int Tcl_ScanCountedElement(const char *src, int length,
int *flagPtr);
/* 220 */
-EXTERN int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
+TCL_DEPRECATED("")
+int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode);
/* 221 */
EXTERN int Tcl_ServiceAll(void);
/* 222 */
@@ -741,7 +742,8 @@ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp,
/* 245 */
EXTERN int Tcl_StringMatch(const char *str, const char *pattern);
/* 246 */
-EXTERN int Tcl_TellOld(Tcl_Channel chan);
+TCL_DEPRECATED("")
+int Tcl_TellOld(Tcl_Channel chan);
/* 247 */
EXTERN int Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
int flags, Tcl_VarTraceProc *proc,
@@ -812,10 +814,12 @@ EXTERN int Tcl_DumpActiveMemory(const char *fileName);
/* 266 */
EXTERN void Tcl_ValidateAllMemory(const char *file, int line);
/* 267 */
-EXTERN void Tcl_AppendResultVA(Tcl_Interp *interp,
+TCL_DEPRECATED("see TIP #422")
+void Tcl_AppendResultVA(Tcl_Interp *interp,
va_list argList);
/* 268 */
-EXTERN void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
+TCL_DEPRECATED("see TIP #422")
+void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr,
va_list argList);
/* 269 */
EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr);
@@ -838,14 +842,17 @@ EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp,
const char *name, const char *version,
int exact);
/* 275 */
-EXTERN void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
+TCL_DEPRECATED("see TIP #422")
+void Tcl_SetErrorCodeVA(Tcl_Interp *interp,
va_list argList);
/* 276 */
-EXTERN int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
+TCL_DEPRECATED("see TIP #422")
+int Tcl_VarEvalVA(Tcl_Interp *interp, va_list argList);
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options);
/* 278 */
-EXTERN TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
+TCL_DEPRECATED("see TIP #422")
+TCL_NORETURN void Tcl_PanicVA(const char *format, va_list argList);
/* 279 */
EXTERN void Tcl_GetVersion(int *major, int *minor,
int *patchLevel, int *type);
@@ -2086,7 +2093,7 @@ typedef struct TclStubs {
void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */
int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */
int (*tcl_ScanCountedElement) (const char *src, int length, int *flagPtr); /* 219 */
- int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
+ TCL_DEPRECATED_API("") int (*tcl_SeekOld) (Tcl_Channel chan, int offset, int mode); /* 220 */
int (*tcl_ServiceAll) (void); /* 221 */
int (*tcl_ServiceEvent) (int flags); /* 222 */
void (*tcl_SetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 223 */
@@ -2112,7 +2119,7 @@ typedef struct TclStubs {
void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */
void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
- int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
+ TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
@@ -2133,18 +2140,18 @@ typedef struct TclStubs {
void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
int (*tcl_DumpActiveMemory) (const char *fileName); /* 265 */
void (*tcl_ValidateAllMemory) (const char *file, int line); /* 266 */
- void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
- void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
+ TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */
+ TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */
CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
- void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
- int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
+ TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
+ TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
- TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
+ TCL_DEPRECATED_API("see TIP #422") TCL_NORETURN1 void (*tcl_PanicVA) (const char *format, va_list argList); /* 278 */
void (*tcl_GetVersion) (int *major, int *minor, int *patchLevel, int *type); /* 279 */
void (*tcl_InitMemory) (Tcl_Interp *interp); /* 280 */
Tcl_Channel (*tcl_StackChannel) (Tcl_Interp *interp, const Tcl_ChannelType *typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan); /* 281 */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index b1962e6..3b983e3 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -487,15 +487,14 @@ static void
UpdateStringOfDict(
Tcl_Obj *dictPtr)
{
-#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+#define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE], *flagPtr = NULL;
Dict *dict = DICT(dictPtr);
ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int i, length, bytesNeeded = 0;
const char *elem;
char *dst;
- const int maxFlags = UINT_MAX / sizeof(int);
/*
* This field is the most useful one in the whole hash structure, and it
@@ -517,10 +516,8 @@ UpdateStringOfDict(
if (numElems <= LOCAL_SIZE) {
flagPtr = localFlags;
- } else if (numElems > maxFlags) {
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = ckalloc(numElems * sizeof(int));
+ flagPtr = ckalloc(numElems);
}
for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 2c389c6..4f2288e 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -412,7 +412,6 @@ Tcl_GetCwd(
return Tcl_DStringValue(cwdPtr);
}
-/* Obsolete */
int
Tcl_EvalFile(
Tcl_Interp *interp, /* Interpreter in which to process file. */
diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c
index 9f38638..eeed0e5 100644
--- a/generic/tclIndexObj.c
+++ b/generic/tclIndexObj.c
@@ -876,7 +876,8 @@ Tcl_WrongNumArgs(
* NULL. */
{
Tcl_Obj *objPtr;
- int i, len, elemLen, flags;
+ int i, len, elemLen;
+ char flags;
Interp *iPtr = (Interp *) interp;
const char *elementStr;
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index dea698c..b683a29 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -50,7 +50,7 @@ declare 6 {
declare 7 {
int TclCopyAndCollapse(int count, const char *src, char *dst)
}
-declare 8 {
+declare 8 {deprecated {}} {
int TclCopyChannelOld(Tcl_Interp *interp, Tcl_Channel inChan,
Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr)
}
@@ -73,7 +73,7 @@ declare 11 {
declare 12 {
void TclDeleteVars(Interp *iPtr, TclVarHashTable *tablePtr)
}
-# Removed in 8.5
+# Removed in 8.5:
#declare 13 {
# int TclDoGlob(Tcl_Interp *interp, char *separators,
# Tcl_DString *headPtr, char *tail, Tcl_GlobTypeData *types)
@@ -88,7 +88,7 @@ declare 14 {
declare 16 {
void TclExprFloatError(Tcl_Interp *interp, double value)
}
-# Removed in 8.4
+# Removed in 8.4:
#declare 17 {
# int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
#}
@@ -123,7 +123,7 @@ declare 25 {
# declare 26 {
# char *TclGetCwd(Tcl_Interp *interp)
# }
-# Removed in 8.5
+# Removed in 8.5:
#declare 27 {
# int TclGetDate(char *p, unsigned long now, long zone,
# unsigned long *timePtr)
@@ -147,7 +147,7 @@ declare 32 {
int TclGetFrame(Tcl_Interp *interp, const char *str,
CallFrame **framePtrPtr)
}
-# Removed in Tcl 8.5
+# Removed in 8.5:
#declare 33 {
# TclCmdProcType TclGetInterpProc(void)
#}
@@ -160,7 +160,7 @@ declare 34 {
# Tcl_Obj *TclGetIndexedScalar(Tcl_Interp *interp, int localIndex,
# int flags)
#}
-# Removed in 8.6a2
+# Removed in 8.6a2:
#declare 36 {
# int TclGetLong(Tcl_Interp *interp, const char *str, long *longPtr)
#}
@@ -185,7 +185,7 @@ declare 41 {
declare 42 {
CONST86 char *TclpGetUserHome(const char *name, Tcl_DString *bufferPtr)
}
-# Removed in Tcl 8.5a2
+# Removed in 8.5a2:
#declare 43 {
# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int flags)
@@ -220,7 +220,7 @@ declare 50 {
declare 51 {
int TclInterpInit(Tcl_Interp *interp)
}
-# Removed in Tcl 8.5a2
+# Removed in 8.5a2:
#declare 52 {
# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv,
# int flags)
@@ -273,7 +273,7 @@ declare 64 {
int TclObjInvoke(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[],
int flags)
}
-# Removed in Tcl 8.5a2
+# Removed in 8.5a2:
#declare 65 {
# int TclObjInvokeGlobal(Tcl_Interp *interp, int objc,
# Tcl_Obj *const objv[], int flags)
@@ -313,9 +313,7 @@ declare 75 {
declare 76 {
unsigned long TclpGetSeconds(void)
}
-
-# deprecated
-declare 77 {
+declare 77 {deprecated {}} {
void TclpGetTime(Tcl_Time *time)
}
# Removed in 8.6:
@@ -380,7 +378,7 @@ declare 92 {
declare 93 {
void TclProcDeleteProc(ClientData clientData)
}
-# Removed in Tcl 8.5:
+# Removed in 8.5:
#declare 94 {
# int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp,
# int argc, const char **argv)
@@ -419,7 +417,7 @@ declare 103 {
int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
int *portPtr)
}
-declare 104 {
+declare 104 {deprecated {}} {
int TclSockMinimumBuffersOld(int sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
@@ -532,7 +530,7 @@ declare 131 {
declare 132 {
int TclpHasSockets(Tcl_Interp *interp)
}
-declare 133 {
+declare 133 {deprecated {}} {
struct tm *TclpGetDate(const time_t *time, int useGMT)
}
# Removed in 8.5
@@ -625,12 +623,10 @@ declare 156 {
declare 157 {
Var *TclVarTraceExists(Tcl_Interp *interp, const char *varName)
}
-# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
-declare 158 {
+declare 158 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptFileName(const char *filename)
}
-# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
-declare 159 {
+declare 159 {deprecated {use public Tcl_GetStartupScript()}} {
const char *TclGetStartupScriptFileName(void)
}
#declare 160 {
@@ -676,13 +672,10 @@ declare 166 {
int index, Tcl_Obj *valuePtr)
}
-# VFS-aware versions of Tcl*StartupScriptFileName (158 and 159 above)
-# REMOVED (except from stub table) - use public Tcl_SetStartupScript()
-declare 167 {
+declare 167 {deprecated {use public Tcl_SetStartupScript()}} {
void TclSetStartupScriptPath(Tcl_Obj *pathPtr)
}
-# REMOVED (except from stub table) - use public Tcl_GetStartupScript()
-declare 168 {
+declare 168 {deprecated {use public Tcl_GetStartupScript()}} {
Tcl_Obj *TclGetStartupScriptPath(void)
}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
@@ -730,7 +723,6 @@ declare 177 {
void TclVarErrMsg(Tcl_Interp *interp, const char *part1, const char *part2,
const char *operation, const char *reason)
}
-# TIP 338 made these public - now declared in tcl.h too
declare 178 {
void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
}
@@ -748,12 +740,10 @@ declare 179 {
# const char *file, int line)
#}
-# TclpGmtime and TclpLocaltime promoted to the generic interface from unix
-
-declare 182 {
+declare 182 {deprecated {}} {
struct tm *TclpLocaltime(const time_t *clock)
}
-declare 183 {
+declare 183 {deprecated {}} {
struct tm *TclpGmtime(const time_t *clock)
}
@@ -937,10 +927,7 @@ declare 234 {
declare 235 {
void TclInitVarHashTable(TclVarHashTable *tablePtr, Namespace *nsPtr)
}
-
-
-# TIP 337 made this one public
-declare 236 {
+declare 236 {deprecated {use Tcl_BackgroundException}} {
void TclBackgroundException(Tcl_Interp *interp, int code)
}
@@ -1090,7 +1077,7 @@ declare 9 win {
declare 10 win {
Tcl_DirEntry *TclpReaddir(DIR *dir)
}
-# Removed in 8.3.1 (for Win32s only)
+# Removed in 8.3.1 (for Win32s only):
#declare 10 win {
# int TclWinSynchSpawn(void *args, int type, void **trans, Tcl_Pid *pidPtr)
#}
@@ -1140,7 +1127,6 @@ declare 19 win {
declare 20 win {
void TclWinAddProcess(HANDLE hProcess, DWORD id)
}
-# new for 8.4.20+/8.5.12+
declare 21 win {
char *TclpInetNtoa(struct in_addr addr)
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 29392b6..23a20e6 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2922,7 +2922,7 @@ MODULE_SCOPE int TclFindDictElement(Tcl_Interp *interp,
const char *dict, int dictLength,
const char **elementPtr, const char **nextPtr,
int *sizePtr, int *literalPtr);
-/* TIP #280 - Modified token based evulation, with line information. */
+/* TIP #280 - Modified token based evaluation, with line information. */
MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script,
int numBytes, int flags, int line,
int *clNextOuter, const char *outerScript);
@@ -3145,7 +3145,7 @@ MODULE_SCOPE int TclReToGlob(Tcl_Interp *interp, const char *reStr,
int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
int *quantifiersFoundPtr);
MODULE_SCOPE int TclScanElement(const char *string, int length,
- int *flagPtr);
+ char *flagPtr);
MODULE_SCOPE void TclSetBgErrorHandler(Tcl_Interp *interp,
Tcl_Obj *cmdPrefix);
MODULE_SCOPE void TclSetBignumIntRep(Tcl_Obj *objPtr,
diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h
index 5bccfe5..4244362 100644
--- a/generic/tclIntDecls.h
+++ b/generic/tclIntDecls.h
@@ -75,7 +75,8 @@ EXTERN void TclCleanupCommand(Command *cmdPtr);
EXTERN int TclCopyAndCollapse(int count, const char *src,
char *dst);
/* 8 */
-EXTERN int TclCopyChannelOld(Tcl_Interp *interp,
+TCL_DEPRECATED("")
+int TclCopyChannelOld(Tcl_Interp *interp,
Tcl_Channel inChan, Tcl_Channel outChan,
int toRead, Tcl_Obj *cmdPtr);
/* 9 */
@@ -218,7 +219,8 @@ EXTERN unsigned long TclpGetClicks(void);
/* 76 */
EXTERN unsigned long TclpGetSeconds(void);
/* 77 */
-EXTERN void TclpGetTime(Tcl_Time *time);
+TCL_DEPRECATED("")
+void TclpGetTime(Tcl_Time *time);
/* Slot 78 is reserved */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
@@ -267,7 +269,8 @@ EXTERN void TclSetupEnv(Tcl_Interp *interp);
EXTERN int TclSockGetPort(Tcl_Interp *interp, const char *str,
const char *proto, int *portPtr);
/* 104 */
-EXTERN int TclSockMinimumBuffersOld(int sock, int size);
+TCL_DEPRECATED("")
+int TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
@@ -350,7 +353,8 @@ EXTERN void Tcl_SetNamespaceResolvers(
/* 132 */
EXTERN int TclpHasSockets(Tcl_Interp *interp);
/* 133 */
-EXTERN struct tm * TclpGetDate(const time_t *time, int useGMT);
+TCL_DEPRECATED("")
+struct tm * TclpGetDate(const time_t *time, int useGMT);
/* Slot 134 is reserved */
/* Slot 135 is reserved */
/* Slot 136 is reserved */
@@ -401,9 +405,11 @@ EXTERN void TclRegError(Tcl_Interp *interp, const char *msg,
EXTERN Var * TclVarTraceExists(Tcl_Interp *interp,
const char *varName);
/* 158 */
-EXTERN void TclSetStartupScriptFileName(const char *filename);
+TCL_DEPRECATED("use public Tcl_SetStartupScript()")
+void TclSetStartupScriptFileName(const char *filename);
/* 159 */
-EXTERN const char * TclGetStartupScriptFileName(void);
+TCL_DEPRECATED("use public Tcl_GetStartupScript()")
+const char * TclGetStartupScriptFileName(void);
/* Slot 160 is reserved */
/* 161 */
EXTERN int TclChannelTransform(Tcl_Interp *interp,
@@ -422,9 +428,11 @@ EXTERN int TclListObjSetElement(Tcl_Interp *interp,
Tcl_Obj *listPtr, int index,
Tcl_Obj *valuePtr);
/* 167 */
-EXTERN void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
+TCL_DEPRECATED("use public Tcl_SetStartupScript()")
+void TclSetStartupScriptPath(Tcl_Obj *pathPtr);
/* 168 */
-EXTERN Tcl_Obj * TclGetStartupScriptPath(void);
+TCL_DEPRECATED("use public Tcl_GetStartupScript()")
+Tcl_Obj * TclGetStartupScriptPath(void);
/* 169 */
EXTERN int TclpUtfNcmp2(const char *s1, const char *s2,
unsigned long n);
@@ -464,9 +472,11 @@ EXTERN Tcl_Obj * Tcl_GetStartupScript(const char **encodingNamePtr);
/* Slot 180 is reserved */
/* Slot 181 is reserved */
/* 182 */
-EXTERN struct tm * TclpLocaltime(const time_t *clock);
+TCL_DEPRECATED("")
+struct tm * TclpLocaltime(const time_t *clock);
/* 183 */
-EXTERN struct tm * TclpGmtime(const time_t *clock);
+TCL_DEPRECATED("")
+struct tm * TclpGmtime(const time_t *clock);
/* Slot 184 is reserved */
/* Slot 185 is reserved */
/* Slot 186 is reserved */
@@ -570,7 +580,8 @@ EXTERN Var * TclVarHashCreateVar(TclVarHashTable *tablePtr,
EXTERN void TclInitVarHashTable(TclVarHashTable *tablePtr,
Namespace *nsPtr);
/* 236 */
-EXTERN void TclBackgroundException(Tcl_Interp *interp, int code);
+TCL_DEPRECATED("use Tcl_BackgroundException")
+void TclBackgroundException(Tcl_Interp *interp, int code);
/* 237 */
EXTERN int TclResetCancellation(Tcl_Interp *interp, int force);
/* 238 */
@@ -652,7 +663,7 @@ typedef struct TclIntStubs {
int (*tclCleanupChildren) (Tcl_Interp *interp, int numPids, Tcl_Pid *pidPtr, Tcl_Channel errorChan); /* 5 */
void (*tclCleanupCommand) (Command *cmdPtr); /* 6 */
int (*tclCopyAndCollapse) (int count, const char *src, char *dst); /* 7 */
- int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
+ TCL_DEPRECATED_API("") int (*tclCopyChannelOld) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, int toRead, Tcl_Obj *cmdPtr); /* 8 */
int (*tclCreatePipeline) (Tcl_Interp *interp, int argc, const char **argv, Tcl_Pid **pidArrayPtr, TclFile *inPipePtr, TclFile *outPipePtr, TclFile *errFilePtr); /* 9 */
int (*tclCreateProc) (Tcl_Interp *interp, Namespace *nsPtr, const char *procName, Tcl_Obj *argsPtr, Tcl_Obj *bodyPtr, Proc **procPtrPtr); /* 10 */
void (*tclDeleteCompiledLocalVars) (Interp *iPtr, CallFrame *framePtr); /* 11 */
@@ -721,7 +732,7 @@ typedef struct TclIntStubs {
void (*tclpFree) (char *ptr); /* 74 */
unsigned long (*tclpGetClicks) (void); /* 75 */
unsigned long (*tclpGetSeconds) (void); /* 76 */
- void (*tclpGetTime) (Tcl_Time *time); /* 77 */
+ TCL_DEPRECATED_API("") void (*tclpGetTime) (Tcl_Time *time); /* 77 */
void (*reserved78)(void);
void (*reserved79)(void);
void (*reserved80)(void);
@@ -748,7 +759,7 @@ typedef struct TclIntStubs {
CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
- int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
+ TCL_DEPRECATED_API("") int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
void (*reserved105)(void);
void (*reserved106)(void);
void (*reserved107)(void);
@@ -777,7 +788,7 @@ typedef struct TclIntStubs {
int (*tcl_RemoveInterpResolvers) (Tcl_Interp *interp, const char *name); /* 130 */
void (*tcl_SetNamespaceResolvers) (Tcl_Namespace *namespacePtr, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 131 */
int (*tclpHasSockets) (Tcl_Interp *interp); /* 132 */
- struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
+ TCL_DEPRECATED_API("") struct tm * (*tclpGetDate) (const time_t *time, int useGMT); /* 133 */
void (*reserved134)(void);
void (*reserved135)(void);
void (*reserved136)(void);
@@ -802,8 +813,8 @@ typedef struct TclIntStubs {
void (*reserved155)(void);
void (*tclRegError) (Tcl_Interp *interp, const char *msg, int status); /* 156 */
Var * (*tclVarTraceExists) (Tcl_Interp *interp, const char *varName); /* 157 */
- void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
- const char * (*tclGetStartupScriptFileName) (void); /* 159 */
+ TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptFileName) (const char *filename); /* 158 */
+ TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") const char * (*tclGetStartupScriptFileName) (void); /* 159 */
void (*reserved160)(void);
int (*tclChannelTransform) (Tcl_Interp *interp, Tcl_Channel chan, Tcl_Obj *cmdObjPtr); /* 161 */
void (*tclChannelEventScriptInvoker) (ClientData clientData, int flags); /* 162 */
@@ -811,8 +822,8 @@ typedef struct TclIntStubs {
void (*tclExpandCodeArray) (void *envPtr); /* 164 */
void (*tclpSetInitialEncodings) (void); /* 165 */
int (*tclListObjSetElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj *valuePtr); /* 166 */
- void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
- Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
+ TCL_DEPRECATED_API("use public Tcl_SetStartupScript()") void (*tclSetStartupScriptPath) (Tcl_Obj *pathPtr); /* 167 */
+ TCL_DEPRECATED_API("use public Tcl_GetStartupScript()") Tcl_Obj * (*tclGetStartupScriptPath) (void); /* 168 */
int (*tclpUtfNcmp2) (const char *s1, const char *s2, unsigned long n); /* 169 */
int (*tclCheckInterpTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 170 */
int (*tclCheckExecutionTraces) (Tcl_Interp *interp, const char *command, int numChars, Command *cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *const objv[]); /* 171 */
@@ -826,8 +837,8 @@ typedef struct TclIntStubs {
Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingNamePtr); /* 179 */
void (*reserved180)(void);
void (*reserved181)(void);
- struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
- struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
+ TCL_DEPRECATED_API("") struct tm * (*tclpLocaltime) (const time_t *clock); /* 182 */
+ TCL_DEPRECATED_API("") struct tm * (*tclpGmtime) (const time_t *clock); /* 183 */
void (*reserved184)(void);
void (*reserved185)(void);
void (*reserved186)(void);
@@ -880,7 +891,7 @@ typedef struct TclIntStubs {
void (*tclGetSrcInfoForPc) (CmdFrame *contextPtr); /* 233 */
Var * (*tclVarHashCreateVar) (TclVarHashTable *tablePtr, const char *key, int *newPtr); /* 234 */
void (*tclInitVarHashTable) (TclVarHashTable *tablePtr, Namespace *nsPtr); /* 235 */
- void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
+ TCL_DEPRECATED_API("use Tcl_BackgroundException") void (*tclBackgroundException) (Tcl_Interp *interp, int code); /* 236 */
int (*tclResetCancellation) (Tcl_Interp *interp, int force); /* 237 */
int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 238 */
int (*tclNRInterpProcCore) (Tcl_Interp *interp, Tcl_Obj *procNameObj, int skip, ProcErrorProc *errorProc); /* 239 */
@@ -1356,7 +1367,7 @@ extern const TclIntStubs *tclIntStubsPtr;
#undef TclSetStartupScriptPath
#undef TclBackgroundException
-#if defined(USE_TCL_STUBS) && defined(TCL_NO_DEPRECATED)
+#if defined(USE_TCL_STUBS)
# undef Tcl_SetStartupScript
# define Tcl_SetStartupScript \
(tclStubsPtr->tcl_SetStartupScript) /* 622 */
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index 11374cc..43d90ab 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -1957,8 +1957,8 @@ static void
UpdateStringOfList(
Tcl_Obj *listPtr) /* List object with string rep to update. */
{
-# define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+# define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE], *flagPtr = NULL;
List *listRepPtr = ListRepPtr(listPtr);
int numElems = listRepPtr->elemCount;
int i, length, bytesNeeded = 0;
@@ -1995,7 +1995,7 @@ UpdateStringOfList(
* We know numElems <= LIST_MAX, so this is safe.
*/
- flagPtr = ckalloc(numElems * sizeof(int));
+ flagPtr = ckalloc(numElems);
}
elemPtrs = &listRepPtr->elements;
for (i = 0; i < numElems; i++) {
diff --git a/generic/tclMain.c b/generic/tclMain.c
index f89bd5e..9380fb2 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -266,18 +266,14 @@ Tcl_SourceRCFile(
c = Tcl_OpenFileChannel(NULL, fullName, "r", 0);
if (c != NULL) {
- Tcl_Obj *fullNameObj = Tcl_NewStringObj(fullName, -1);
-
Tcl_Close(NULL, c);
- Tcl_IncrRefCount(fullNameObj);
- if (Tcl_FSEvalFileEx(interp, fullNameObj, NULL) != TCL_OK) {
+ if (Tcl_EvalFile(interp, fullName) != TCL_OK) {
chan = Tcl_GetStdChannel(TCL_STDERR);
if (chan) {
Tcl_WriteObj(chan, Tcl_GetObjResult(interp));
Tcl_WriteChars(chan, "\n", 1);
}
}
- Tcl_DecrRefCount(fullNameObj);
}
}
Tcl_DStringFree(&temp);
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index eb4dc9b..fb721a0 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -418,7 +418,7 @@ PkgRequireCore(
Interp *iPtr = (Interp *) interp;
Package *pkgPtr;
PkgAvail *availPtr, *bestPtr, *bestStablePtr;
- char *availVersion, *bestVersion;
+ char *availVersion, *bestVersion, *bestStableVersion;
/* Internal rep. of versions */
int availStable, code, satisfies, pass;
char *script, *pkgVersionI;
@@ -466,6 +466,7 @@ PkgRequireCore(
bestPtr = NULL;
bestStablePtr = NULL;
bestVersion = NULL;
+ bestStableVersion = NULL;
for (availPtr = pkgPtr->availPtr; availPtr != NULL;
availPtr = availPtr->nextPtr) {
@@ -480,59 +481,81 @@ PkgRequireCore(
continue;
}
+ /* Check satisfaction of requirements before considering the current version further. */
+ if (reqc > 0) {
+ satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
+ if (!satisfies) {
+ ckfree(availVersion);
+ availVersion = NULL;
+ continue;
+ }
+ }
+
if (bestPtr != NULL) {
int res = CompareVersions(availVersion, bestVersion, NULL);
/*
- * Note: Use internal reps!
+ * Note: Used internal reps in the comparison!
*/
- if (res <= 0) {
+ if (res > 0) {
/*
- * The version of the package sought is not as good as the
- * currently selected version. Ignore it.
+ * The version of the package sought is better than the
+ * currently selected version.
*/
-
- ckfree(availVersion);
- availVersion = NULL;
- continue;
+ goto newbest;
}
- }
-
- /*
- * We have found a version which is better than our max.
- */
-
- if (reqc > 0) {
- /* Check satisfaction of requirements. */
+ } else {
+ newbest:
+ /* We have found a version which is better than our max. */
- satisfies = SomeRequirementSatisfied(availVersion, reqc, reqv);
- if (!satisfies) {
- ckfree(availVersion);
- availVersion = NULL;
- continue;
- }
+ bestPtr = availPtr;
+ CheckVersionAndConvert(interp, bestPtr->version, &bestVersion, NULL);
}
- bestPtr = availPtr;
-
- if (bestVersion != NULL) {
- ckfree(bestVersion);
+ if (!availStable) {
+ ckfree(availVersion);
+ availVersion = NULL;
+ continue;
}
- bestVersion = availVersion;
- /*
- * If this new best version is stable then it also has to be
- * better than the max stable version found so far.
- */
+ if (bestStablePtr != NULL) {
+ int res = CompareVersions(availVersion, bestStableVersion, NULL);
+
+ /*
+ * Note: Used internal reps in the comparison!
+ */
- if (availStable) {
+ if (res > 0) {
+ /*
+ * This stable version of the package sought is better
+ * than the currently selected stable version.
+ */
+ goto newstable;
+ }
+ } else {
+ newstable:
+ /* We have found a stable version which is better than our max stable. */
bestStablePtr = availPtr;
+ CheckVersionAndConvert(interp, bestStablePtr->version, &bestStableVersion, NULL);
}
- }
+
+ ckfree(availVersion);
+ availVersion = NULL;
+ } /* end for */
+
+ /*
+ * Clean up memorized internal reps, if any.
+ */
if (bestVersion != NULL) {
ckfree(bestVersion);
+ bestVersion = NULL;
+ }
+
+ if (bestStableVersion != NULL) {
+ ckfree(bestStableVersion);
+ bestStableVersion = NULL;
}
/*
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index ebd2086..24b28e5 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -72,6 +72,11 @@ static int TclSockMinimumBuffersOld(int sock, int size)
# define TclBNInitBignumFromWideUInt 0
# define TclBNInitBignumFromWideInt 0
# define TclBNInitBignumFromLong 0
+# define Tcl_AppendResultVA 0
+# define Tcl_AppendStringsToObjVA 0
+# define Tcl_SetErrorCodeVA 0
+# define Tcl_PanicVA 0
+# define Tcl_VarEvalVA 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 608cd15..8ebace5 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -974,7 +974,7 @@ Tcl_ScanCountedElement(
int *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
- int flags = CONVERT_ANY;
+ char flags = CONVERT_ANY;
int numBytes = TclScanElement(src, length, &flags);
*flagPtr = flags;
@@ -1015,7 +1015,7 @@ int
TclScanElement(
const char *src, /* String to convert to Tcl list element. */
int length, /* Number of bytes in src, or -1. */
- int *flagPtr) /* Where to store information to guide
+ char *flagPtr) /* Where to store information to guide
* Tcl_ConvertElement. */
{
const char *p = src;
@@ -1547,11 +1547,10 @@ Tcl_Merge(
int argc, /* How many strings to merge. */
const char *const *argv) /* Array of string values. */
{
-#define LOCAL_SIZE 20
- int localFlags[LOCAL_SIZE], *flagPtr = NULL;
+#define LOCAL_SIZE 64
+ char localFlags[LOCAL_SIZE], *flagPtr = NULL;
int i, bytesNeeded = 0;
char *result, *dst;
- const int maxFlags = UINT_MAX / sizeof(int);
/*
* Handle empty list case first, so logic of the general case can be
@@ -1570,22 +1569,8 @@ Tcl_Merge(
if (argc <= LOCAL_SIZE) {
flagPtr = localFlags;
- } else if (argc > maxFlags) {
- /*
- * We cannot allocate a large enough flag array to format this list in
- * one pass. We could imagine converting this routine to a multi-pass
- * implementation, but for sizeof(int) == 4, the limit is a max of
- * 2^30 list elements and since each element is at least one byte
- * formatted, and requires one byte space between it and the next one,
- * that a minimum space requirement of 2^31 bytes, which is already
- * INT_MAX. If we tried to format a list of > maxFlags elements, we're
- * just going to overflow the size limits on the formatted string
- * anyway, so just issue that same panic early.
- */
-
- Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
} else {
- flagPtr = ckalloc(argc * sizeof(int));
+ flagPtr = ckalloc(argc);
}
for (i = 0; i < argc; i++) {
flagPtr[i] = ( i ? TCL_DONT_QUOTE_HASH : 0 );
@@ -2717,7 +2702,7 @@ Tcl_DStringAppendElement(
{
char *dst = dsPtr->string + dsPtr->length;
int needSpace = TclNeedSpace(dsPtr->string, dst);
- int flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
+ char flags = needSpace ? TCL_DONT_QUOTE_HASH : 0;
int newSize = dsPtr->length + needSpace
+ TclScanElement(element, -1, &flags);
diff --git a/tests/package.test b/tests/package.test
index 99f9f06..bb938b8 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -20,18 +20,19 @@ if {"::tcltest" ni [namespace children]} {
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
-testConstraint testpreferstable [llength [info commands testpreferstable]]
-
# Do all this in a slave interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoSlaveInterpreter $i {*}$argv
+load {} Tcltest $i
interp eval $i {
namespace import -force ::tcltest::*
-package forget {*}[package names]
+#package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""
+
+testConstraint testpreferstable [llength [info commands testpreferstable]]
test package-1.1 {pkg::create gives error on insufficient args} -body {
::pkg::create
@@ -139,7 +140,7 @@ test package-3.1 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {3.4}
test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -149,7 +150,7 @@ test package-3.2 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {3.5}
test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -159,7 +160,7 @@ test package-3.3 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t 2.2
- return $x
+ set x
} -result {2.3}
test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -169,7 +170,7 @@ test package-3.4 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require -exact t 2.3
- return $x
+ set x
} -result {2.3}
test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
package forget t
@@ -179,7 +180,7 @@ test package-3.5 {Tcl_PkgRequire procedure, picking best version} -setup {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t 2.1
- return $x
+ set x
} -result {2.4}
test package-3.6 {Tcl_PkgRequire procedure, can't find suitable version} -setup {
package forget t
@@ -238,7 +239,7 @@ test package-3.12 {Tcl_PkgRequire procedure, self-deleting script} -setup {
} -body {
package ifneeded t 1.2 "package forget t; set x 1.2; package provide t 1.2"
package require t 1.2
- return $x
+ set x
} -result {1.2}
test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
package forget t
@@ -256,7 +257,7 @@ test package-3.13 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
}
package unknown pkgUnknown
package require -exact t 1.5
- return $x
+ set x
} -cleanup {
package unknown {}
} -result {t 1.5-1.5}
@@ -283,7 +284,7 @@ test package-3.15 {Tcl_PkgRequire procedure, "package unknown" support} -setup {
package provide [lindex $args 0] 2.0
}
package require {a b}
- return $x
+ set x
} -cleanup {
package unknown {}
} -result {{a b} 0-}
@@ -575,15 +576,23 @@ test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
+ interp create child
+ load {} Tcltest child
+ child eval {
testpreferstable
package forget t
set x xxx
+ }
} -body {
+ child eval {
foreach i {1.4 3.4 4.0a1 2.3 2.4 2.2} {
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
+ }
+} -cleanup {
+ interp delete child
} -result {3.4}
test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup {
package forget t
@@ -593,7 +602,7 @@ test package-3.51 {Tcl_PkgRequire procedure, picking best stable version} -setup
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {1.3}
test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup {
package forget t
@@ -603,34 +612,69 @@ test package-3.52 {Tcl_PkgRequire procedure, picking best stable version} -setup
package ifneeded t $i "set x $i; package provide t $i"
}
package require t
- return $x
+ set x
} -result {1.3}
+test pkg-3.53 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
+ testpreferstable
+ package forget t
+ set x xxx
+} -body {
+ foreach i {1.2b1 1.1} {
+ package ifneeded t $i "set x $i; package provide t $i"
+ }
+ package require t
+ set x
+} -result {1.1}
+
test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
package
} -result {wrong # args: should be "package option ?arg ...?"}
-test package-4.2 {Tcl_PackageCmd procedure, "forget" option} {
+test package-4.2 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
package names
-} {}
-test package-4.3 {Tcl_PackageCmd procedure, "forget" option} {
+ }
+} -cleanup {
+ interp delete child
+} -result {}
+test package-4.3 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
package forget foo
-} {}
+ }
+} -cleanup {
+ interp delete child
+} -result {}
test package-4.4 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+ child eval {
package forget {*}[package names]
set result {}
+ }
} -body {
+ child eval {
package ifneeded t 1.1 {first script}
package ifneeded t 2.3 {second script}
package ifneeded x 1.4 {x's script}
lappend result [lsort [package names]] [package versions t]
package forget t
lappend result [lsort [package names]] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {{t x} {1.1 2.3} x {}}
test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
+ interp create child
+ child eval {
package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded a 1.1 {first script}
package ifneeded b 2.3 {second script}
package ifneeded c 1.4 {third script}
@@ -638,6 +682,9 @@ test package-4.5 {Tcl_PackageCmd procedure, "forget" option} -setup {
set result [list [lsort [package names]]]
package forget a c
lappend result [lsort [package names]]
+ }
+} -cleanup {
+ interp delete child
} -result {{a b c} b}
test package-4.5.1 {Tcl_PackageCmd procedure, "forget" option} -body {
# Test for Bug 415273
@@ -656,28 +703,55 @@ test package-4.7 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
test package-4.8 {Tcl_PackageCmd procedure, "ifneeded" option} -body {
package ifneeded t xyz
} -returnCodes error -result {expected version number but got "xyz"}
-test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} {
+test package-4.9 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
list [package ifneeded foo 1.1] [package names]
-} {{} {}}
+ }
+} -cleanup {
+ interp delete child
+} -result {{} {}}
test package-4.10 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
- package forget t
+ interp create child
+ child eval {
+ package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded t 1.4 "script for t 1.4"
list [package names] [package ifneeded t 1.4] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {t {script for t 1.4} 1.4}
test package-4.11 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
- package forget t
+ interp create child
+ child eval {
+ package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded t 1.4 "script for t 1.4"
list [package ifneeded t 1.5] [package names] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {{} t 1.4}
test package-4.12 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
- package forget t
+ interp create child
+ child eval {
+ package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded t 1.4 "script for t 1.4"
package ifneeded t 1.4 "second script for t 1.4"
list [package ifneeded t 1.4] [package names] [package versions t]
+ }
+} -cleanup {
+ interp delete child
} -result {{second script for t 1.4} t 1.4}
test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
package forget t
@@ -690,18 +764,31 @@ test package-4.13 {Tcl_PackageCmd procedure, "ifneeded" option} -setup {
test package-4.14 {Tcl_PackageCmd procedure, "names" option} -body {
package names a
} -returnCodes error -result {wrong # args: should be "package names"}
-test package-4.15 {Tcl_PackageCmd procedure, "names" option} {
+test package-4.15 {Tcl_PackageCmd procedure, "names" option} -setup {
+ interp create child
+} -body {
+ child eval {
package forget {*}[package names]
package names
-} {}
+ }
+} -cleanup {
+ interp delete child
+} -result {}
test package-4.16 {Tcl_PackageCmd procedure, "names" option} -setup {
+ interp create child
+ child eval {
package forget {*}[package names]
+ }
} -body {
+ child eval {
package ifneeded x 1.2 {dummy}
package provide x 1.3
package provide y 2.4
catch {package require z 47.16}
lsort [package names]
+ }
+} -cleanup {
+ interp delete child
} -result {x y}
test package-4.17 {Tcl_PackageCmd procedure, "provide" option} -body {
package provide
@@ -1239,11 +1326,9 @@ proc prefer {args} {
}
}
-test package-13.0 {package prefer defaults} -constraints testpreferstable -setup {
- testpreferstable
-} -body {
+test package-13.0 {package prefer defaults} -body {
prefer
-} -result stable
+} -result [expr {[string match {*[ab]*} [package provide Tcl]] ? "latest" : "stable"}]
test package-13.1 {package prefer defaults} -body {
set ::env(TCL_PKG_PREFER_LATEST) stable ;# value not relevant!
prefer
@@ -1260,23 +1345,25 @@ test package-14.1 {bogus argument} -returnCodes error -body {
test package-15.0 {set, keep} -constraints testpreferstable -setup {
testpreferstable
-} -body {package prefer stable} -result stable
+} -body {package prefer} -result stable
test package-15.1 {set stable, keep} -constraints testpreferstable -setup {
testpreferstable
-} -body {prefer stable} -result {stable stable}
+} -body {package prefer stable} -result stable
test package-15.2 {set latest, change} -constraints testpreferstable -setup {
testpreferstable
-} -body {prefer latest} -result {stable latest}
+} -body {package prefer latest} -result latest
test package-15.3 {set latest, keep} -constraints testpreferstable -setup {
testpreferstable
} -body {
- prefer latest latest
-} -result {stable latest latest}
+ package prefer latest
+ package prefer latest
+} -result latest
test package-15.4 {set stable, rejected} -constraints testpreferstable -setup {
testpreferstable
} -body {
- prefer latest stable
-} -result {stable latest latest}
+ package prefer latest
+ package prefer stable
+} -result latest
rename prefer {}
diff --git a/tests/split.test b/tests/split.test
index 585fef5..2d180e0 100644
--- a/tests/split.test
+++ b/tests/split.test
@@ -70,6 +70,9 @@ test split-1.13 {basic split commands} {
test split-1.14 {basic split commands} {
split ",12,,,34,56," {,}
} {{} 12 {} {} 34 56 {}}
+test split-1.15 {basic split commands} -body {
+ split "a\U01f4a9b" {}
+} -result "a \U01f4a9 b"
test split-2.1 {split errors} {
list [catch split msg] $msg $errorCode
diff --git a/unix/configure b/unix/configure
index 129c283..51d694f 100755
--- a/unix/configure
+++ b/unix/configure
@@ -3733,16 +3733,6 @@ $as_echo "#define NO_DIRENT_H 1" >>confdefs.h
fi
- ac_fn_c_check_header_mongrel "$LINENO" "float.h" "ac_cv_header_float_h" "$ac_includes_default"
-if test "x$ac_cv_header_float_h" = xyes; then :
-
-else
-
-$as_echo "#define NO_FLOAT_H 1" >>confdefs.h
-
-fi
-
-
ac_fn_c_check_header_mongrel "$LINENO" "values.h" "ac_cv_header_values_h" "$ac_includes_default"
if test "x$ac_cv_header_values_h" = xyes; then :
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 45922e0..9aa3eb2 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -2078,7 +2078,6 @@ closedir(d);
AC_DEFINE(NO_DIRENT_H, 1, [Do we have <dirent.h>?])
fi
- AC_CHECK_HEADER(float.h, , [AC_DEFINE(NO_FLOAT_H, 1, [Do we have <float.h>?])])
AC_CHECK_HEADER(values.h, , [AC_DEFINE(NO_VALUES_H, 1, [Do we have <values.h>?])])
AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in
index adbc80d..28ce012 100644
--- a/unix/tclConfig.h.in
+++ b/unix/tclConfig.h.in
@@ -295,9 +295,6 @@
/* Do we have fd_set? */
#undef NO_FD_SET
-/* Do we have <float.h>? */
-#undef NO_FLOAT_H
-
/* Do we have fstatfs()? */
#undef NO_FSTATFS
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index ba56089..8b766d6 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -181,13 +181,10 @@ extern int TclUnixSetBlockingMode(int fd, int mode);
*---------------------------------------------------------------------------
*/
-#ifndef NO_FLOAT_H
-# include <float.h>
-#else
+#include <float.h>
#ifndef NO_VALUES_H
# include <values.h>
#endif
-#endif
#ifndef FLT_MAX
# ifdef MAXFLOAT
diff --git a/win/tcl.dsp b/win/tcl.dsp
index 48eae9d..ad9c764 100644
--- a/win/tcl.dsp
+++ b/win/tcl.dsp
@@ -152,10 +152,6 @@ SOURCE=..\compat\fixstrtod.c
# End Source File
# Begin Source File
-SOURCE=..\compat\float.h
-# End Source File
-# Begin Source File
-
SOURCE=..\compat\gettod.c
# End Source File
# Begin Source File
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 30079b9..fea4b0f 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -30,7 +30,7 @@ static const unsigned char errorTable[] = {
ENOEXEC, /* ERROR_BAD_FORMAT 11 */
EACCES, /* ERROR_INVALID_ACCESS 12 */
EINVAL, /* ERROR_INVALID_DATA 13 */
- EFAULT, /* ERROR_OUT_OF_MEMORY 14 */
+ ENOMEM, /* ERROR_OUT_OF_MEMORY 14 */
ENOENT, /* ERROR_INVALID_DRIVE 15 */
EACCES, /* ERROR_CURRENT_DIRECTORY 16 */
EXDEV, /* ERROR_NOT_SAME_DEVICE 17 */
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index b9cde72..8c130a7 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -13,8 +13,6 @@
#include "tclWinInt.h"
-#include <float.h>
-
/* Workaround for mingw versions which don't provide this in float.h */
#ifndef _MCW_EM
# define _MCW_EM 0x0008001F /* Error masks */
generated by cgit v0.12 at 2024-11-16 19:11:24 (GMT)