Skip to content

Commit

Permalink
Disable TclGetObjInterpProc() if TCL_NO_DEPRECATED=1. Merge 9.0
Browse files Browse the repository at this point in the history
  • Loading branch information
jan.nijtmans committed Dec 23, 2024
2 parents a6b3510 + 0f1f06b commit e0c0f37
Show file tree
Hide file tree
Showing 10 changed files with 73 additions and 68 deletions.
15 changes: 7 additions & 8 deletions generic/tclExecute.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4425,7 +4425,7 @@ TEBCresume(
"self may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
CACHE_STACK_INFO();
goto gotError;
}
Expand Down Expand Up @@ -4453,7 +4453,7 @@ TEBCresume(
"nextto may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
CACHE_STACK_INFO();
goto gotError;
}
Expand All @@ -4474,7 +4474,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(valuePtr)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL);
OO_ERROR(interp, CLASS_REQUIRED);
CACHE_STACK_INFO();
goto gotError;
}
Expand Down Expand Up @@ -4525,16 +4525,15 @@ TEBCresume(
"%s implementation by \"%s\" not reachable from here",
methodType, TclGetString(valuePtr)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
(char *)NULL);
OO_ERROR(interp, CLASS_NOT_REACHABLE);
CACHE_STACK_INFO();
goto gotError;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s has no non-filter implementation by \"%s\"",
methodType, TclGetString(valuePtr)));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL);
OO_ERROR(interp, CLASS_NOT_THERE);
CACHE_STACK_INFO();
goto gotError;
}
Expand All @@ -4552,7 +4551,7 @@ TEBCresume(
"next may only be called from inside a method",
-1));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
CACHE_STACK_INFO();
goto gotError;
}
Expand Down Expand Up @@ -4581,7 +4580,7 @@ TEBCresume(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
DECACHE_STACK_INFO();
Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
OO_ERROR(interp, NOTHING_NEXT);
CACHE_STACK_INFO();
goto gotError;
#ifdef TCL_COMPILE_DEBUG
Expand Down
2 changes: 1 addition & 1 deletion generic/tclInt.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3457,9 +3457,9 @@ MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
const char *reason, int index);
#ifndef TCL_NO_DEPRECATED
MODULE_SCOPE Tcl_ObjCmdProc TclObjInterpProc;
#define TclObjInterpProc TclGetObjInterpProc()
#endif
MODULE_SCOPE Tcl_ObjCmdProc2 TclObjInterpProc2;
#define TclObjInterpProc TclGetObjInterpProc()
#define TclObjInterpProc2 TclGetObjInterpProc2()
MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp,
Tcl_Size objc, Tcl_Obj *const objv[],
Expand Down
1 change: 1 addition & 0 deletions generic/tclIntDecls.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1268,6 +1268,7 @@ extern const TclIntStubs *tclIntStubsPtr;

#ifdef TCL_NO_DEPRECATED
#undef Tcl_ObjCmdProc
#undef TclGetObjInterpProc
#endif

#if defined(USE_TCL_STUBS)
Expand Down
10 changes: 5 additions & 5 deletions generic/tclOO.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1892,7 +1892,7 @@ TclNewObjectInstanceCommon(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create object \"%s\": command already exists with"
" that name", nameStr));
Tcl_SetErrorCode(interp, "TCL", "OO", "OVERWRITE_OBJECT", (char *)NULL);
OO_ERROR(interp, OVERWRITE_OBJECT);
return NULL;
}
}
Expand Down Expand Up @@ -1949,7 +1949,7 @@ FinalizeAlloc(
if (result != TCL_ERROR && Destructing(oPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object deleted in constructor", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", (char *)NULL);
OO_ERROR(interp, STILLBORN);
result = TCL_ERROR;
}
if (result != TCL_OK) {
Expand Down Expand Up @@ -2020,7 +2020,7 @@ Tcl_CopyObjectInstance(
if (IsRootClass(oPtr)) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"may not clone the class of classes", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", (char *)NULL);
OO_ERROR(interp, CLONING_CLASS);
return NULL;
}

Expand Down Expand Up @@ -2911,7 +2911,7 @@ Tcl_ObjectContextInvokeNext(

Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
OO_ERROR(interp, NOTHING_NEXT);
return TCL_ERROR;
}

Expand Down Expand Up @@ -2980,7 +2980,7 @@ TclNRObjectContextInvokeNext(

Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"no next %s implementation", methodType));
Tcl_SetErrorCode(interp, "TCL", "OO", "NOTHING_NEXT", (char *)NULL);
OO_ERROR(interp, NOTHING_NEXT);
return TCL_ERROR;
}

Expand Down
33 changes: 16 additions & 17 deletions generic/tclOOBasic.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -206,7 +206,7 @@ TclOO_Class_Create(

Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
OO_ERROR(interp, INSTANTIATE_NONCLASS);
return TCL_ERROR;
}

Expand All @@ -224,7 +224,7 @@ TclOO_Class_Create(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object name must not be empty", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
OO_ERROR(interp, EMPTY_NAME);
return TCL_ERROR;
}

Expand Down Expand Up @@ -271,7 +271,7 @@ TclOO_Class_CreateNs(

Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
OO_ERROR(interp, INSTANTIATE_NONCLASS);
return TCL_ERROR;
}

Expand All @@ -289,15 +289,15 @@ TclOO_Class_CreateNs(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object name must not be empty", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
OO_ERROR(interp, EMPTY_NAME);
return TCL_ERROR;
}
nsName = Tcl_GetStringFromObj(
objv[Tcl_ObjectContextSkippedArgs(context) + 1], &len);
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"namespace name must not be empty", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
OO_ERROR(interp, EMPTY_NAME);
return TCL_ERROR;
}

Expand Down Expand Up @@ -342,7 +342,7 @@ TclOO_Class_New(

Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
OO_ERROR(interp, INSTANTIATE_NONCLASS);
return TCL_ERROR;
}

Expand Down Expand Up @@ -934,7 +934,7 @@ TclOONextObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}
context = (Tcl_ObjectContext) framePtr->clientData;
Expand Down Expand Up @@ -974,7 +974,7 @@ TclOONextToObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}
contextPtr = (CallContext *) framePtr->clientData;
Expand All @@ -995,7 +995,7 @@ TclOONextToObjCmd(
if (classPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"\"%s\" is not a class", TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL);
OO_ERROR(interp, CLASS_REQUIRED);
return TCL_ERROR;
}

Expand Down Expand Up @@ -1043,15 +1043,14 @@ TclOONextToObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s implementation by \"%s\" not reachable from here",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
(char *)NULL);
OO_ERROR(interp, CLASS_NOT_REACHABLE);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s has no non-filter implementation by \"%s\"",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL);
OO_ERROR(interp, CLASS_NOT_THERE);
return TCL_ERROR;
}

Expand Down Expand Up @@ -1113,7 +1112,7 @@ TclOOSelfObjCmd(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%s may only be called from inside a method",
TclGetString(objv[0])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
}

Expand Down Expand Up @@ -1148,7 +1147,7 @@ TclOOSelfObjCmd(
if (clsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method not defined by a class", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
OO_ERROR(interp, UNMATCHED_CONTEXT);
return TCL_ERROR;
}

Expand All @@ -1169,7 +1168,7 @@ TclOOSelfObjCmd(
if (!CurrentlyInvoked(contextPtr).isFilter) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not inside a filtering context", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
OO_ERROR(interp, UNMATCHED_CONTEXT);
return TCL_ERROR;
} else {
MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
Expand All @@ -1195,7 +1194,7 @@ TclOOSelfObjCmd(
!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"caller is not an object", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
OO_ERROR(interp, CONTEXT_REQUIRED);
return TCL_ERROR;
} else {
CallContext *callerPtr = (CallContext *)
Expand Down Expand Up @@ -1264,7 +1263,7 @@ TclOOSelfObjCmd(
if (!CurrentlyInvoked(contextPtr).isFilter) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not inside a filtering context", TCL_AUTO_LENGTH));
Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
OO_ERROR(interp, UNMATCHED_CONTEXT);
return TCL_ERROR;
} else {
Method *mPtr;
Expand Down
Loading

0 comments on commit e0c0f37

Please sign in to comment.