summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/string.n8
-rw-r--r--generic/tcl.h2
-rw-r--r--generic/tclCmdMZ.c9
-rw-r--r--generic/tclDecls.h6
-rw-r--r--generic/tclExecute.c2
-rw-r--r--generic/tclInt.h12
-rw-r--r--generic/tclUtil.c38
-rw-r--r--tools/genStubs.tcl2
8 files changed, 41 insertions, 38 deletions
diff --git a/doc/string.n b/doc/string.n
index 00ce85c..7e666ea 100644
--- a/doc/string.n
+++ b/doc/string.n
@@ -115,9 +115,7 @@ Any Unicode control character.
Any Unicode digit character. Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
-Any of the valid forms for a double in Tcl, with optional surrounding
-whitespace. In case of under/overflow in the value, 0 is returned and
-the \fIvarname\fR will contain \-1.
+Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
.IP \fBentier\fR 12
.VS 8.6
Any of the valid string formats for an integer value of arbitrary size
@@ -131,7 +129,7 @@ false.
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for a 32-bit integer value in Tcl,
-with optional surrounding whitespace. In case of under/overflow in
+with optional surrounding whitespace. In case of overflow in
the value, 0 is returned and the \fIvarname\fR will contain \-1.
.IP \fBlist\fR 12
Any proper list structure, with optional surrounding whitespace. In
@@ -156,7 +154,7 @@ true.
Any upper case alphabet character in the Unicode character set.
.IP \fBwideinteger\fR 12
Any of the valid forms for a wide integer in Tcl, with optional
-surrounding whitespace. In case of under/overflow in the value, 0 is
+surrounding whitespace. In case of overflow in the value, 0 is
returned and the \fIvarname\fR will contain \-1.
.IP \fBwordchar\fR 12
Any Unicode word character. That is any alphanumeric character, and
diff --git a/generic/tcl.h b/generic/tcl.h
index 088ced6..6adc284 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -114,6 +114,7 @@ extern "C" {
# define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
# define TCL_NORETURN __attribute__ ((noreturn))
# define TCL_NOINLINE __attribute__ ((noinline))
+# define TCL_NORETURN1 __attribute__ ((noreturn))
#else
# define TCL_FORMAT_PRINTF(a,b)
# if defined(_MSC_VER) && (_MSC_VER >= 1310)
@@ -123,6 +124,7 @@ extern "C" {
# define TCL_NORETURN /* nothing */
# define TCL_NOINLINE /* nothing */
# endif
+# define TCL_NORETURN1 /* nothing */
#endif
/*
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 057bd3c..369583f 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1584,7 +1584,6 @@ StringIsCmd(
chcomp = Tcl_UniCharIsDigit;
break;
case STR_IS_DOUBLE: {
- /* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
(objPtr->typePtr == &tclBignumType)) {
@@ -3205,10 +3204,11 @@ StringTrimCmd(
Tcl_Obj *const objv[]) /* Argument objects. */
{
const char *string1, *string2;
- int triml, trimr, length1, length2;
+ size_t triml, trimr, length1, length2;
if (objc == 3) {
- string2 = TclGetStringFromObj(objv[2], &length2);
+ string2 = TclGetString(objv[2]);
+ length2 = objv[2]->length;
} else if (objc == 2) {
string2 = tclDefaultTrimSet;
length2 = strlen(tclDefaultTrimSet);
@@ -3216,7 +3216,8 @@ StringTrimCmd(
Tcl_WrongNumArgs(interp, 1, objv, "string ?chars?");
return TCL_ERROR;
}
- string1 = TclGetStringFromObj(objv[1], &length1);
+ string1 = TclGetString(objv[1]);
+ length1 = objv[1]->length;
triml = TclTrim(string1, length1, string2, length2, &trimr);
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 48d2e06..f876c9e 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -1780,7 +1780,7 @@ typedef struct TclStubs {
int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */
const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */
- TCL_NORETURN void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
+ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */
void * (*tcl_Alloc) (size_t size); /* 3 */
void (*tcl_Free) (void *ptr); /* 4 */
void * (*tcl_Realloc) (void *ptr, size_t size); /* 5 */
@@ -1927,7 +1927,7 @@ typedef struct TclStubs {
int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
void (*reserved131)(void);
void (*tcl_EventuallyFree) (void *clientData, Tcl_FreeProc *freeProc); /* 132 */
- TCL_NORETURN void (*tcl_Exit) (int status); /* 133 */
+ TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
@@ -2096,7 +2096,7 @@ typedef struct TclStubs {
int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, size_t numBytes, int flags); /* 291 */
int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */
int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */
- TCL_NORETURN void (*tcl_ExitThread) (int status); /* 294 */
+ TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */
int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */
char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */
void (*tcl_FinalizeThread) (void); /* 297 */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index efa46bc..f5f2427 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -5396,7 +5396,7 @@ TEBCresume(
{
const char *string1, *string2;
- int trim1, trim2;
+ size_t trim1, trim2;
case INST_STR_TRIM_LEFT:
valuePtr = OBJ_UNDER_TOS; /* String */
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 17adad3..e496b92 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3136,12 +3136,12 @@ MODULE_SCOPE void TclSubstParse(Tcl_Interp *interp, const char *bytes,
MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
int count, int *tokensLeftPtr, int line,
int *clNextOuter, const char *outerScript);
-MODULE_SCOPE int TclTrim(const char *bytes, int numBytes,
- const char *trim, int numTrim, int *trimRight);
-MODULE_SCOPE int TclTrimLeft(const char *bytes, int numBytes,
- const char *trim, int numTrim);
-MODULE_SCOPE int TclTrimRight(const char *bytes, int numBytes,
- const char *trim, int numTrim);
+MODULE_SCOPE size_t TclTrim(const char *bytes, size_t numBytes,
+ const char *trim, size_t numTrim, size_t *trimRight);
+MODULE_SCOPE size_t TclTrimLeft(const char *bytes, size_t numBytes,
+ const char *trim, size_t numTrim);
+MODULE_SCOPE size_t TclTrimRight(const char *bytes, size_t numBytes,
+ const char *trim, size_t numTrim);
MODULE_SCOPE int TclUtfCmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCasecmp(const char *cs, const char *ct);
MODULE_SCOPE int TclUtfCount(int ch);
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index fc22da2..59f6c99 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -1700,14 +1700,14 @@ TrimRight(
return numBytes - (p - bytes);
}
-int
+size_t
TclTrimRight(
const char *bytes, /* String to be trimmed... */
- int numBytes, /* ...and its length in bytes */
+ size_t numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
- int numTrim) /* ...and its length in bytes */
+ size_t numTrim) /* ...and its length in bytes */
{
- int res;
+ size_t res;
Tcl_DString bytesBuf, trimBuf;
/* Empty strings -> nothing to do */
@@ -1749,12 +1749,12 @@ TclTrimRight(
*----------------------------------------------------------------------
*/
-static inline int
+static inline size_t
TrimLeft(
const char *bytes, /* String to be trimmed... */
- int numBytes, /* ...and its length in bytes */
+ size_t numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
- int numTrim) /* ...and its length in bytes */
+ size_t numTrim) /* ...and its length in bytes */
{
const char *p = bytes;
Tcl_UniChar ch1 = 0, ch2 = 0;
@@ -1798,14 +1798,14 @@ TrimLeft(
return p - bytes;
}
-int
+size_t
TclTrimLeft(
const char *bytes, /* String to be trimmed... */
- int numBytes, /* ...and its length in bytes */
+ size_t numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
- int numTrim) /* ...and its length in bytes */
+ size_t numTrim) /* ...and its length in bytes */
{
- int res;
+ size_t res;
Tcl_DString bytesBuf, trimBuf;
/* Empty strings -> nothing to do */
@@ -1845,15 +1845,15 @@ TclTrimLeft(
*----------------------------------------------------------------------
*/
-int
+size_t
TclTrim(
const char *bytes, /* String to be trimmed... */
- int numBytes, /* ...and its length in bytes */
+ size_t numBytes, /* ...and its length in bytes */
const char *trim, /* String of trim characters... */
- int numTrim, /* ...and its length in bytes */
- int *trimRight) /* Offset from the end of the string. */
+ size_t numTrim, /* ...and its length in bytes */
+ size_t *trimRight) /* Offset from the end of the string. */
{
- int trimLeft;
+ size_t trimLeft;
Tcl_DString bytesBuf, trimBuf;
*trimRight = 0;
@@ -1953,7 +1953,8 @@ Tcl_Concat(
result = ckalloc((unsigned) (bytesNeeded + argc));
for (p = result, i = 0; i < argc; i++) {
- int triml, trimr, elemLength;
+ size_t triml, trimr;
+ int elemLength;
const char *element;
element = argv[i];
@@ -2086,8 +2087,7 @@ Tcl_ConcatObj(
Tcl_SetObjLength(resPtr, 0);
for (i = 0; i < objc; i++) {
- size_t triml;
- int trimr;
+ size_t triml, trimr;
element = TclGetString(objv[i]);
elemLength = objv[i]->length;
diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl
index a345437..830ba2b 100644
--- a/tools/genStubs.tcl
+++ b/tools/genStubs.tcl
@@ -600,6 +600,8 @@ proc genStubs::makeSlot {name decl index} {
}
if {[string range $rtype end-8 end] eq "__stdcall"} {
append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") "
+ } elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} {
+ append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") "
} else {
append text $rtype " (*" $lfname ") "
}
generated by cgit v0.12 at 2025-12-13 09:20:36 (GMT)