summaryrefslogtreecommitdiffstats
path: root/generic/tclTestObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclTestObj.c')
-rw-r--r--generic/tclTestObj.c71
1 files changed, 27 insertions, 44 deletions
diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c
index a03a60a..4008b11 100644
--- a/generic/tclTestObj.c
+++ b/generic/tclTestObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
-#undef BUILD_tcl
+
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
@@ -25,14 +25,6 @@
#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:
@@ -61,7 +53,7 @@ static void VarPtrDeleteProc(void *clientData, TCL_UNUSED(Tcl_Interp *))
for (i = 0; i < NUMBER_OF_OBJECT_VARS; i++) {
if (varPtr[i]) Tcl_DecrRefCount(varPtr[i]);
}
- ckfree(varPtr);
+ Tcl_Free(varPtr);
}
static Tcl_Obj **GetVarPtr(Tcl_Interp *interp)
@@ -101,7 +93,7 @@ TclObjTest_Init(
*/
Tcl_Obj **varPtr;
- varPtr = (Tcl_Obj **) ckalloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
+ varPtr = (Tcl_Obj **) Tcl_Alloc(NUMBER_OF_OBJECT_VARS *sizeof(varPtr[0]));
if (!varPtr) {
return TCL_ERROR;
}
@@ -159,7 +151,7 @@ TestbignumobjCmd(
enum options {
BIGNUM_SET, BIGNUM_GET, BIGNUM_MULT10, BIGNUM_DIV10, BIGNUM_ISEVEN,
BIGNUM_RADIXSIZE
- };
+ } idx;
int index;
size_t varIndex;
const char *string;
@@ -171,7 +163,7 @@ TestbignumobjCmd(
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
- &index) != TCL_OK) {
+ &idx) != TCL_OK) {
return TCL_ERROR;
}
if (GetVariableIndex(interp, objv[2], &varIndex) != TCL_OK) {
@@ -179,7 +171,7 @@ TestbignumobjCmd(
}
varPtr = GetVarPtr(interp);
- switch ((enum options)index) {
+ switch (idx) {
case BIGNUM_SET:
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "var value");
@@ -617,7 +609,7 @@ TestindexobjCmd(
return TCL_ERROR;
}
- argv = (const char **)ckalloc((objc-3) * sizeof(char *));
+ argv = (const char **)Tcl_Alloc((objc-3) * sizeof(char *));
for (i = 4; i < objc; i++) {
argv[i-4] = Tcl_GetString(objv[i]);
}
@@ -626,7 +618,7 @@ TestindexobjCmd(
result = Tcl_GetIndexFromObj((setError? interp : NULL), objv[3],
argv, "token", TCL_INDEX_TEMP_TABLE|(allowAbbrev? 0 : TCL_EXACT),
&index);
- ckfree(argv);
+ Tcl_Free((void *)argv);
if (result == TCL_OK) {
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), index);
}
@@ -886,7 +878,7 @@ TestlistobjCmd(
0, &cmdIndex) != TCL_OK) {
return TCL_ERROR;
}
- switch(cmdIndex) {
+ switch (cmdIndex) {
case LISTOBJ_SET:
if ((varPtr[varIndex] != NULL) && !Tcl_IsShared(varPtr[varIndex])) {
Tcl_SetListObj(varPtr[varIndex], objc-3, objv+3);
@@ -1073,9 +1065,8 @@ TestobjCmd(
Tcl_SetObjResult(interp, Tcl_NewStringObj("none", -1));
} else {
typeName = objv[2]->typePtr->name;
- if (!strcmp(typeName, "utf32string")) typeName = "string";
#ifndef TCL_WIDE_INT_IS_LONG
- else if (!strcmp(typeName, "wideInt")) typeName = "int";
+ if (!strcmp(typeName, "wideInt")) typeName = "int";
#endif
Tcl_SetObjResult(interp, Tcl_NewStringObj(typeName, -1));
}
@@ -1154,9 +1145,9 @@ TeststringobjCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- unsigned short *unicode;
- size_t varIndex;
- int size, option, i;
+ Tcl_UniChar *unicode;
+ size_t size, varIndex;
+ int option, i;
Tcl_WideInt length;
#define MAX_STRINGS 11
const char *string, *strings[MAX_STRINGS+1];
@@ -1257,21 +1248,17 @@ TeststringobjCmd(
goto wrongNumArgs;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), (varPtr[varIndex] != NULL)
- ? varPtr[varIndex]->length : -1);
+ ? (Tcl_WideInt)varPtr[varIndex]->length : (Tcl_WideInt)-1);
break;
case 5: /* length2 */
if (objc != 3) {
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- const Tcl_ObjType *objType = Tcl_GetObjType("string");
- if (objType != NULL) {
- Tcl_ConvertToType(NULL, varPtr[varIndex], objType);
- strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
- length = (int) strPtr->allocated;
- } else {
- length = -1;
- }
+ Tcl_ConvertToType(NULL, varPtr[varIndex],
+ Tcl_GetObjType("string"));
+ strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ length = strPtr->allocated;
} else {
length = -1;
}
@@ -1322,26 +1309,22 @@ TeststringobjCmd(
goto wrongNumArgs;
}
if (varPtr[varIndex] != NULL) {
- const Tcl_ObjType *objType = Tcl_GetObjType("string");
- if (objType != NULL) {
- Tcl_ConvertToType(NULL, varPtr[varIndex],objType);
- strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
- length = strPtr->maxChars;
- } else {
- length = -1;
- }
+ Tcl_ConvertToType(NULL, varPtr[varIndex],
+ Tcl_GetObjType("string"));
+ strPtr = (String *)varPtr[varIndex]->internalRep.twoPtrValue.ptr1;
+ length = strPtr->maxChars;
} else {
length = -1;
}
Tcl_SetWideIntObj(Tcl_GetObjResult(interp), length);
break;
case 10: { /* range */
- int first, last;
+ Tcl_WideInt first, last;
if (objc != 5) {
goto wrongNumArgs;
}
- if ((Tcl_GetIntFromObj(interp, objv[3], &first) != TCL_OK)
- || (Tcl_GetIntFromObj(interp, objv[4], &last) != TCL_OK)) {
+ if ((Tcl_GetWideIntFromObj(interp, objv[3], &first) != TCL_OK)
+ || (Tcl_GetWideIntFromObj(interp, objv[4], &last) != TCL_OK)) {
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_GetRange(varPtr[varIndex], first, last));
@@ -1369,7 +1352,7 @@ TeststringobjCmd(
if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
- if ((length < 0) || (length > size)) {
+ if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
@@ -1400,7 +1383,7 @@ TeststringobjCmd(
if (Tcl_GetWideIntFromObj(interp, objv[3], &length) != TCL_OK) {
return TCL_ERROR;
}
- if ((length < 0) || (length > size)) {
+ if ((length < 0) || ((Tcl_WideUInt)length > (Tcl_WideUInt)size)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"index value out of range", -1));
return TCL_ERROR;
generated by cgit v0.12 at 2024-11-17 06:23:43 (GMT)