summaryrefslogtreecommitdiffstats
path: root/generic/tclTestObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTestObj.c')
-rw-r--r--generic/tclTestObj.c171
1 files changed, 85 insertions, 86 deletions
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index 547792a..79a164c 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -18,9 +18,21 @@
# define USE_TCL_STUBS
#endif
#include "tclInt.h"
-#include "tommath.h"
+#ifdef TCL_WITH_EXTERNAL_TOMMATH
+# include "tommath.h"
+#else
+# include "tclTomMath.h"
+#endif
#include "tclStringRep.h"
+#ifdef __GNUC__
+/*
+ * The rest of this file shouldn't warn about deprecated functions; they're
+ * there because we intend them to be so and know that this file is OK to
+ * touch those fields.
+ */
+#pragma GCC diagnostic ignored "-Wdeprecated-declarations"
+#endif
/*
* Forward declarations for functions defined later in this file:
@@ -30,30 +42,21 @@ static int CheckIfVarUnset(Tcl_Interp *interp, Tcl_Obj **varPtr, int varIndex);
static int GetVariableIndex(Tcl_Interp *interp,
const char *string, int *indexPtr);
static void SetVarToObj(Tcl_Obj **varPtr, int varIndex, Tcl_Obj *objPtr);
-static int TestbignumobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestbooleanobjCmd(ClientData dummy,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
-static int TestdoubleobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestindexobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestintobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestlistobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-static int TestobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
-static int TeststringobjCmd(ClientData dummy, Tcl_Interp *interp,
- int objc, Tcl_Obj *const objv[]);
+static Tcl_ObjCmdProc TestbignumobjCmd;
+static Tcl_ObjCmdProc TestbooleanobjCmd;
+static Tcl_ObjCmdProc TestdoubleobjCmd;
+static Tcl_ObjCmdProc TestindexobjCmd;
+static Tcl_ObjCmdProc TestintobjCmd;
+static Tcl_ObjCmdProc TestlistobjCmd;
+static Tcl_ObjCmdProc TestobjCmd;
+static Tcl_ObjCmdProc TeststringobjCmd;
#define VARPTR_KEY "TCLOBJTEST_VARPTR"
#define NUMBER_OF_OBJECT_VARS 20
-static void VarPtrDeleteProc(ClientData clientData, Tcl_Interp *interp)
+static void VarPtrDeleteProc(void *clientData, Tcl_Interp *interp)
{
- register int i;
+ int i;
Tcl_Obj **varPtr = (Tcl_Obj **) clientData;
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
@@ -91,7 +94,7 @@ int
TclObjTest_Init(
Tcl_Interp *interp)
{
- register int i;
+ int i;
/*
* An array of Tcl_Obj pointers used in the commands that operate on or get
* the values of Tcl object-valued variables. varPtr[i] is the i-th variable's
@@ -131,7 +134,7 @@ TclObjTest_Init(
*
* TestbignumobjCmd --
*
- * This function implmenets the "testbignumobj" command. It is used
+ * This function implements the "testbignumobj" command. It is used
* to exercise the bignum Tcl object type implementation.
*
* Results:
@@ -146,7 +149,7 @@ TclObjTest_Init(
static int
TestbignumobjCmd(
- ClientData clientData, /* unused */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Argument count */
Tcl_Obj *const objv[]) /* Argument vector */
@@ -160,7 +163,7 @@ TestbignumobjCmd(
};
int index, varIndex;
const char *string;
- mp_int bignumValue, newValue;
+ mp_int bignumValue;
Tcl_Obj **varPtr;
if (objc < 3) {
@@ -233,19 +236,16 @@ TestbignumobjCmd(
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
- if (mp_init(&newValue) != MP_OKAY
- || (mp_mul_d(&bignumValue, 10, &newValue) != MP_OKAY)) {
+ if (mp_mul_d(&bignumValue, 10, &bignumValue) != MP_OKAY) {
mp_clear(&bignumValue);
- mp_clear(&newValue);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("error in mp_mul_d", -1));
return TCL_ERROR;
}
- mp_clear(&bignumValue);
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBignumObj(varPtr[varIndex], &newValue);
+ Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
}
break;
@@ -261,19 +261,16 @@ TestbignumobjCmd(
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
- if (mp_init(&newValue) != MP_OKAY
- || (mp_div_d(&bignumValue, 10, &newValue, NULL) != MP_OKAY)) {
+ if (mp_div_d(&bignumValue, 10, &bignumValue, NULL) != MP_OKAY) {
mp_clear(&bignumValue);
- mp_clear(&newValue);
Tcl_SetObjResult(interp,
Tcl_NewStringObj("error in mp_div_d", -1));
return TCL_ERROR;
}
- mp_clear(&bignumValue);
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBignumObj(varPtr[varIndex], &newValue);
+ Tcl_SetBignumObj(varPtr[varIndex], &bignumValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&newValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewBignumObj(&bignumValue));
}
break;
@@ -289,10 +286,16 @@ TestbignumobjCmd(
&bignumValue) != TCL_OK) {
return TCL_ERROR;
}
+ if (mp_mod_2d(&bignumValue, 1, &bignumValue) != MP_OKAY) {
+ mp_clear(&bignumValue);
+ Tcl_SetObjResult(interp,
+ Tcl_NewStringObj("error in mp_mod_2d", -1));
+ return TCL_ERROR;
+ }
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetIntObj(varPtr[varIndex], mp_iseven(&bignumValue));
+ Tcl_SetIntObj(varPtr[varIndex], mp_iszero(&bignumValue));
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iseven(&bignumValue)));
+ SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(mp_iszero(&bignumValue)));
}
mp_clear(&bignumValue);
break;
@@ -345,7 +348,7 @@ TestbignumobjCmd(
static int
TestbooleanobjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -385,9 +388,9 @@ TestbooleanobjCmd(
*/
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBooleanObj(varPtr[varIndex], boolValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], boolValue != 0);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue != 0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else if (strcmp(subCmd, "get") == 0) {
@@ -410,9 +413,9 @@ TestbooleanobjCmd(
return TCL_ERROR;
}
if (!Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetBooleanObj(varPtr[varIndex], !boolValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], boolValue == 0);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewBooleanObj(!boolValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(boolValue == 0));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
} else {
@@ -445,7 +448,7 @@ TestbooleanobjCmd(
static int
TestdoubleobjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -563,7 +566,7 @@ TestdoubleobjCmd(
static int
TestindexobjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -571,6 +574,7 @@ TestindexobjCmd(
int allowAbbrev, index, index2, setError, i, result;
const char **argv;
static const char *const tablePtr[] = {"a", "b", "check", NULL};
+
/*
* Keep this structure declaration in sync with tclIndexObj.c
*/
@@ -594,7 +598,7 @@ TestindexobjCmd(
}
Tcl_GetIndexFromObj(NULL, objv[1], tablePtr, "token", 0, &index);
- indexRep = objv[1]->internalRep.twoPtrValue.ptr1;
+ indexRep = (struct IndexRep *)objv[1]->internalRep.twoPtrValue.ptr1;
indexRep->index = index2;
result = Tcl_GetIndexFromObj(NULL, objv[1],
tablePtr, "token", 0, &index);
@@ -616,14 +620,14 @@ TestindexobjCmd(
return TCL_ERROR;
}
- argv = ckalloc((objc-3) * sizeof(char *));
+ argv = (const char **)ckalloc((objc-3) * sizeof(char *));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
argv[objc-4] = NULL;
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
- argv, "token", INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
+ argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
ckfree(argv);
if (result == TCL_OK) {
@@ -652,13 +656,13 @@ TestindexobjCmd(
static int
TestintobjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
int intValue, varIndex, i;
- long longValue;
+ Tcl_WideInt wideValue;
const char *index, *subCmd, *string;
Tcl_Obj **varPtr;
@@ -713,7 +717,7 @@ TestintobjCmd(
} else {
SetVarToObj(varPtr, varIndex, Tcl_NewIntObj(intValue));
}
- } else if (strcmp(subCmd, "setlong") == 0) {
+ } else if (strcmp(subCmd, "setint") == 0) {
if (objc != 4) {
goto wrongNumArgs;
}
@@ -723,33 +727,33 @@ TestintobjCmd(
}
intValue = i;
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], intValue);
+ Tcl_SetWideIntObj(varPtr[varIndex], intValue);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(intValue));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(intValue));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
- } else if (strcmp(subCmd, "setmaxlong") == 0) {
- long maxLong = LONG_MAX;
+ } else if (strcmp(subCmd, "setmax") == 0) {
+ Tcl_WideInt maxWide = WIDE_MAX;
if (objc != 3) {
goto wrongNumArgs;
}
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], maxLong);
+ Tcl_SetWideIntObj(varPtr[varIndex], maxWide);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(maxLong));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(maxWide));
}
- } else if (strcmp(subCmd, "ismaxlong") == 0) {
+ } else if (strcmp(subCmd, "ismax") == 0) {
if (objc != 3) {
goto wrongNumArgs;
}
if (CheckIfVarUnset(interp, varPtr,varIndex)) {
return TCL_ERROR;
}
- if (Tcl_GetLongFromObj(interp, varPtr[varIndex], &longValue) != TCL_OK) {
+ if (Tcl_GetWideIntFromObj(interp, varPtr[varIndex], &wideValue) != TCL_OK) {
return TCL_ERROR;
}
Tcl_AppendToObj(Tcl_GetObjResult(interp),
- ((longValue == LONG_MAX)? "1" : "0"), -1);
+ ((wideValue == WIDE_MAX)? "1" : "0"), -1);
} else if (strcmp(subCmd, "get") == 0) {
if (objc != 3) {
goto wrongNumArgs;
@@ -782,9 +786,9 @@ TestintobjCmd(
Tcl_AppendToObj(Tcl_GetObjResult(interp), "1", -1);
#else
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetLongObj(varPtr[varIndex], LONG_MAX);
+ Tcl_SetWideIntObj(varPtr[varIndex], LONG_MAX);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewLongObj(LONG_MAX));
+ SetVarToObj(varPtr, varIndex, Tcl_NewWideIntObj(LONG_MAX));
}
if (Tcl_GetIntFromObj(interp, varPtr[varIndex], &i) != TCL_OK) {
Tcl_ResetResult(interp);
@@ -856,7 +860,7 @@ TestintobjCmd(
static int
TestlistobjCmd(
- ClientData clientData, /* Not used */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Tcl interpreter */
int objc, /* Number of arguments */
Tcl_Obj *const objv[]) /* Argument objects */
@@ -953,7 +957,7 @@ TestlistobjCmd(
static int
TestobjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
@@ -1165,21 +1169,22 @@ TestobjCmd(
static int
TeststringobjCmd(
- ClientData clientData, /* Not used. */
+ TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_UniChar *unicode;
int varIndex, option, i, length;
+ size_t size;
#define MAX_STRINGS 11
const char *index, *string, *strings[MAX_STRINGS+1];
String *strPtr;
Tcl_Obj **varPtr;
static const char *const options[] = {
"append", "appendstrings", "get", "get2", "length", "length2",
- "set", "set2", "setlength", "maxchars", "getunicode",
- "appendself", "appendself2", NULL
+ "set", "set2", "setlength", "maxchars", "appendself",
+ "appendself2", NULL
};
if (objc < 3) {
@@ -1283,7 +1288,7 @@ TeststringobjCmd(
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
- strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = (int) strPtr->allocated;
} else {
length = -1;
@@ -1304,12 +1309,12 @@ TeststringobjCmd(
* is "copy on write".
*/
- string = Tcl_GetStringFromObj(objv[3], &length);
+ string = Tcl_GetStringFromObj(objv[3], &size);
if ((varPtr[varIndex] != NULL)
&& !Tcl_IsShared(varPtr[varIndex])) {
- Tcl_SetStringObj(varPtr[varIndex], string, length);
+ Tcl_SetStringObj(varPtr[varIndex], string, size);
} else {
- SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, length));
+ SetVarToObj(varPtr, varIndex, Tcl_NewStringObj(string, size));
}
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
@@ -1337,20 +1342,14 @@ TeststringobjCmd(
if (varPtr[varIndex] != NULL) {
Tcl_ConvertToType(NULL, varPtr[varIndex],
Tcl_GetObjType("string"));
- strPtr = varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
length = strPtr->maxChars;
} else {
length = -1;
}
Tcl_SetIntObj(Tcl_GetObjResult(interp), length);
break;
- case 10: /* getunicode */
- if (objc != 3) {
- goto wrongNumArgs;
- }
- Tcl_GetUnicodeFromObj(varPtr[varIndex], NULL);
- break;
- case 11: /* appendself */
+ case 10: /* appendself */
if (objc != 4) {
goto wrongNumArgs;
}
@@ -1367,21 +1366,21 @@ TeststringobjCmd(
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
- string = Tcl_GetStringFromObj(varPtr[varIndex], &length);
+ string = Tcl_GetStringFromObj(varPtr[varIndex], &size);
if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
return TCL_ERROR;
}
- if ((i < 0) || (i > length)) {
+ if ((i < 0) || ((size_t)i > size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
}
- Tcl_AppendToObj(varPtr[varIndex], string + i, length - i);
+ Tcl_AppendToObj(varPtr[varIndex], string + i, size - i);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
- case 12: /* appendself2 */
+ case 11: /* appendself2 */
if (objc != 4) {
goto wrongNumArgs;
}
@@ -1398,18 +1397,18 @@ TeststringobjCmd(
SetVarToObj(varPtr, varIndex, Tcl_DuplicateObj(varPtr[varIndex]));
}
- unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &length);
+ unicode = Tcl_GetUnicodeFromObj(varPtr[varIndex], &size);
if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
return TCL_ERROR;
}
- if ((i < 0) || (i > length)) {
+ if ((i < 0) || ((size_t)i > size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
}
- Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, length - i);
+ Tcl_AppendUnicodeToObj(varPtr[varIndex], unicode + i, size - i);
Tcl_SetObjResult(interp, varPtr[varIndex]);
break;
}
generated by cgit v0.12 at 2024-11-17 11:02:25 (GMT)