summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h17
-rw-r--r--generic/tclBasic.c32
-rw-r--r--generic/tclCkalloc.c2
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclScan.c21
-rw-r--r--generic/tclStringObj.c20
-rw-r--r--generic/tclStubInit.c2
7 files changed, 62 insertions, 34 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index 5ff0742..7880e2c 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -60,6 +60,7 @@ extern "C" {
#define TCL_VERSION "8.7"
#define TCL_PATCH_LEVEL "8.7.0-alpha.0"
+#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
*----------------------------------------------------------------------------
* The following definitions set up the proper options for Windows compilers.
@@ -88,6 +89,7 @@ extern "C" {
# define JOIN(a,b) JOIN1(a,b)
# define JOIN1(a,b) a##b
#endif
+#endif /* !TCL_NO_DEPRECATED */
/*
* A special definition used to allow this header file to be included from
@@ -139,7 +141,7 @@ extern "C" {
# define TCL_VARARGS(type, name) (type name, ...)
# define TCL_VARARGS_DEF(type, name) (type name, ...)
# define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
-#endif
+#endif /* !TCL_NO_DEPRECATED */
#if defined(__GNUC__) && (__GNUC__ > 2)
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
# define TCL_NORETURN __attribute__ ((noreturn))
@@ -255,7 +257,7 @@ extern "C" {
#ifndef TCL_NO_DEPRECATED
# undef _ANSI_ARGS_
# define _ANSI_ARGS_(x) x
-#endif
+#endif /* !TCL_NO_DEPRECATED */
/*
* Definitions that allow this header file to be used either with or without
@@ -521,7 +523,7 @@ typedef struct Tcl_Interp
int errorLineDontUse; /* Don't use in extensions! */
#endif
}
-#endif /* TCL_NO_DEPRECATED */
+#endif /* !TCL_NO_DEPRECATED */
Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
@@ -995,7 +997,9 @@ typedef struct Tcl_DString {
#define Tcl_DStringLength(dsPtr) ((dsPtr)->length)
#define Tcl_DStringValue(dsPtr) ((dsPtr)->string)
-#define Tcl_DStringTrunc Tcl_DStringSetLength
+#ifndef TCL_NO_DEPRECATED
+# define Tcl_DStringTrunc Tcl_DStringSetLength
+#endif /* !TCL_NO_DEPRECATED */
/*
* Definitions for the maximum number of digits of precision that may be
@@ -1123,7 +1127,7 @@ typedef struct Tcl_DString {
#ifndef TCL_NO_DEPRECATED
# define TCL_PARSE_PART1 0x400
-#endif
+#endif /* !TCL_NO_DEPRECATED */
/*
* Types for linked variables:
@@ -2624,7 +2628,6 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
# define panic Tcl_Panic
#endif
# define panicVA Tcl_PanicVA
-#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------------
@@ -2635,6 +2638,8 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
extern Tcl_AppInitProc Tcl_AppInit;
+#endif /* !TCL_NO_DEPRECATED */
+
#endif /* RC_INVOKED */
/*
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index aae7ab6..154c555 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -8770,6 +8770,35 @@ TclNRCoroutineActivateCallback(
/*
*----------------------------------------------------------------------
*
+ * TclNREvalList --
+ *
+ * Callback to invoke command as list, used in order to delayed
+ * processing of canonical list command in sane environment.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TclNREvalList(
+ ClientData data[],
+ Tcl_Interp *interp,
+ int result)
+{
+ int objc;
+ Tcl_Obj **objv;
+ Tcl_Obj *listPtr = data[0];
+
+ Tcl_IncrRefCount(listPtr);
+
+ TclMarkTailcall(interp);
+ TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL);
+ TclListObjGetElements(NULL, listPtr, &objc, &objv);
+ return TclNREvalObjv(interp, objc, objv, 0, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* NRCoroInjectObjCmd --
*
* Implementation of [::tcl::unsupported::inject] command.
@@ -8821,7 +8850,8 @@ NRCoroInjectObjCmd(
*/
iPtr->execEnvPtr = corPtr->eePtr;
- TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
+ TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2),
+ NULL, NULL, NULL);
iPtr->execEnvPtr = savedEEPtr;
return TCL_OK;
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index 3484a97..123d872 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -859,7 +859,7 @@ MemoryCmd(
}
if (strcmp(argv[1],"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER "u\n",
+ "%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER"d\n%-25s %10u\n%-25s %10" TCL_LL_MODIFIER "d\n",
"total mallocs", total_mallocs, "total frees", total_frees,
"current packets allocated", current_malloc_packets,
"current bytes allocated", (Tcl_WideInt)current_bytes_malloced,
diff --git a/generic/tclInt.h b/generic/tclInt.h
index d725688..fdbdb9b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -2630,7 +2630,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, size_t *lengthPtr,
*/
typedef struct ProcessGlobalValue {
- size_t epoch; /* Epoch counter to detect changes in the
+ size_t epoch; /* Epoch counter to detect changes in the
* master value. */
size_t numBytes; /* Length of the master string. */
char *value; /* The master string value. */
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 5ea7e46..3edb8be 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -10,7 +10,6 @@
*/
#include "tclInt.h"
-#include "tommath.h"
/*
* Flag values used by Tcl_ScanObjCmd.
@@ -416,7 +415,14 @@ ValidateFormat(
case 'x':
case 'X':
case 'b':
+ break;
case 'u':
+ if (flags & SCAN_BIG) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj(
+ "unsigned bignum scans are invalid", -1));
+ Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
+ goto error;
+ }
break;
/*
* Bracket terms need special checking
@@ -930,18 +936,7 @@ Tcl_ScanObjCmd(
} else {
Tcl_SetWideIntObj(objPtr, wideValue);
}
- } else if (flags & SCAN_BIG) {
- if (flags & SCAN_UNSIGNED) {
- mp_int big;
- if ((Tcl_GetBignumFromObj(interp, objPtr, &big) != TCL_OK)
- || (mp_cmp_d(&big, 0) == MP_LT)) {
- Tcl_SetObjResult(interp, Tcl_NewStringObj(
- "unsigned bignum scans are invalid", -1));
- Tcl_SetErrorCode(interp, "TCL", "FORMAT", "BADUNSIGNED",NULL);
- return TCL_ERROR;
- }
- }
- } else {
+ } else if (!(flags & SCAN_BIG)) {
if (TclGetLongFromObj(NULL, objPtr, &value) != TCL_OK) {
if (TclGetString(objPtr)[0] == '-') {
value = LONG_MIN;
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index e51b98a..7c898b7 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -1939,6 +1939,11 @@ Tcl_AppendFormatToObj(
}
case 'u':
+ if (useBig) {
+ msg = "unsigned bignum format is invalid";
+ errCode = "BADUNSIGNED";
+ goto errorMsg;
+ }
case 'd':
case 'o':
case 'p':
@@ -1962,15 +1967,6 @@ Tcl_AppendFormatToObj(
goto error;
}
isNegative = (mp_cmp_d(&big, 0) == MP_LT);
- if (ch == 'u') {
- if (isNegative) {
- msg = "unsigned bignum format is invalid";
- errCode = "BADUNSIGNED";
- goto errorMsg;
- } else {
- ch = 'd';
- }
- }
#ifndef TCL_WIDE_INT_IS_LONG
} else if (useWide) {
if (Tcl_GetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
@@ -2784,7 +2780,7 @@ TclStringRepeat(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"string size overflow: unable to alloc %"
- TCL_LL_MODIFIER "u bytes",
+ TCL_LL_MODIFIER "d bytes",
(Tcl_WideUInt)STRING_SIZE(count*length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
@@ -3008,7 +3004,7 @@ TclStringCatObjv(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
- TCL_LL_MODIFIER "u bytes",
+ TCL_LL_MODIFIER "d bytes",
(Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
@@ -3024,7 +3020,7 @@ TclStringCatObjv(
if (interp) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"concatenation failed: unable to alloc %"
- TCL_LL_MODIFIER "u bytes",
+ TCL_LL_MODIFIER "d bytes",
(Tcl_WideUInt)STRING_SIZE(length)));
Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
}
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index de29d2d..2a05638 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -143,6 +143,7 @@ void *TclWinGetTclInstance()
return hInstance;
}
+#ifndef TCL_NO_DEPRECATED
#define TclWinSetSockOpt winSetSockOpt
static int
TclWinSetSockOpt(SOCKET s, int level, int optname,
@@ -165,6 +166,7 @@ TclWinGetServByName(const char *name, const char *proto)
{
return getservbyname(name, proto);
}
+#endif /* TCL_NO_DEPRECATED */
#define TclWinNoBackslash winNoBackslash
static char *
generated by cgit v0.12 at 2025-08-08 13:18:34 (GMT)