summaryrefslogtreecommitdiffstats
path: root/generic/tclOOBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclOOBasic.c')
-rw-r--r--generic/tclOOBasic.c50
1 files changed, 28 insertions, 22 deletions
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 2732036..9ab801b 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -197,7 +197,7 @@ TclOO_Class_Create(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
- Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
return TCL_ERROR;
}
@@ -215,7 +215,7 @@ TclOO_Class_Create(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object name must not be empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
return TCL_ERROR;
}
@@ -262,7 +262,7 @@ TclOO_Class_CreateNs(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
- Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
return TCL_ERROR;
}
@@ -280,7 +280,7 @@ TclOO_Class_CreateNs(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"object name must not be empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
return TCL_ERROR;
}
nsName = Tcl_GetStringFromObj(
@@ -288,7 +288,7 @@ TclOO_Class_CreateNs(
if (len == 0) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"namespace name must not be empty", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "EMPTY_NAME", (char *)NULL);
return TCL_ERROR;
}
@@ -333,7 +333,7 @@ TclOO_Class_New(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" is not a class", TclGetString(cmdnameObj)));
- Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "INSTANTIATE_NONCLASS", (char *)NULL);
return TCL_ERROR;
}
@@ -444,7 +444,8 @@ TclOO_Object_Eval(
*/
(void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr,
- Tcl_GetObjectNamespace(object), 0);
+ Tcl_GetObjectNamespace(object), FRAME_IS_METHOD);
+ framePtr->clientData = context;
framePtr->objc = objc;
framePtr->objv = objv; /* Reference counts do not need to be
* incremented here. */
@@ -592,7 +593,7 @@ TclOO_Object_Unknown(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"object \"%s\" has no %s", TclGetString(tmpBuf), piece));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[skip]), (void *)NULL);
+ TclGetString(objv[skip]), (char *)NULL);
return TCL_ERROR;
}
@@ -611,7 +612,7 @@ TclOO_Object_Unknown(
Tcl_Free((void *)methodNames);
Tcl_SetObjResult(interp, errorMsg);
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
- TclGetString(objv[skip]), (void *)NULL);
+ TclGetString(objv[skip]), (char *)NULL);
return TCL_ERROR;
}
@@ -668,7 +669,7 @@ TclOO_Object_LinkVar(
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"variable name \"%s\" illegal: must not contain namespace"
" separator", varName));
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", (char *)NULL);
return TCL_ERROR;
}
@@ -697,7 +698,7 @@ TclOO_Object_LinkVar(
TclVarErrMsg(interp, varName, NULL, "define",
"name refers to an element in an array");
- Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT", (char *)NULL);
return TCL_ERROR;
}
@@ -855,6 +856,11 @@ TclOO_Object_VarName(
}
/*
+ * The variable reference must not disappear too soon. [Bug 74b6110204]
+ */
+ TclSetVarNamespaceVar(varPtr);
+
+ /*
* Now that we've pinned down what variable we're really talking about
* (including traversing variable links), convert back to a name.
*/
@@ -909,7 +915,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", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
context = (Tcl_ObjectContext)framePtr->clientData;
@@ -949,7 +955,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", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
contextPtr = (CallContext *)framePtr->clientData;
@@ -970,7 +976,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", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
@@ -1019,14 +1025,14 @@ TclOONextToObjCmd(
"%s implementation by \"%s\" not reachable from here",
methodType, TclGetString(objv[1])));
Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_REACHABLE",
- (void *)NULL);
+ (char *)NULL);
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", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CLASS_NOT_THERE", (char *)NULL);
return TCL_ERROR;
}
@@ -1088,7 +1094,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", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
}
@@ -1123,7 +1129,7 @@ TclOOSelfObjCmd(
if (clsPtr == NULL) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"method not defined by a class", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
}
@@ -1144,7 +1150,7 @@ TclOOSelfObjCmd(
if (!CurrentlyInvoked(contextPtr).isFilter) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not inside a filtering context", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
} else {
struct MInvoke *miPtr = &CurrentlyInvoked(contextPtr);
@@ -1170,7 +1176,7 @@ TclOOSelfObjCmd(
!(framePtr->callerVarPtr->isProcCallFrame & FRAME_IS_METHOD)){
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"caller is not an object", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "CONTEXT_REQUIRED", (char *)NULL);
return TCL_ERROR;
} else {
CallContext *callerPtr = (CallContext *)framePtr->callerVarPtr->clientData;
@@ -1238,7 +1244,7 @@ TclOOSelfObjCmd(
if (!CurrentlyInvoked(contextPtr).isFilter) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"not inside a filtering context", -1));
- Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (void *)NULL);
+ Tcl_SetErrorCode(interp, "TCL", "OO", "UNMATCHED_CONTEXT", (char *)NULL);
return TCL_ERROR;
} else {
Method *mPtr;
@@ -1304,7 +1310,7 @@ TclOOCopyObjectCmd(
if (objc < 2 || objc > 4) {
Tcl_WrongNumArgs(interp, 1, objv,
- "sourceName ?targetName? ?targetNamespace?");
+ "sourceName ?targetName? ?targetNamespace?");
return TCL_ERROR;
}
generated by cgit v0.12 at 2025-12-04 13:03:22 (GMT)