From 0e24bd44bfdeacaed97aa9b1292be5689fca79f1 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 18 Jun 2017 14:01:00 +0000
Subject: Factor out chunk of non-obvious code in the guts of [oo::define] into
one place.
---
generic/tclOODefineCmds.c | 200 +++++++++++++++++-----------------------------
1 file changed, 74 insertions(+), 126 deletions(-)
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 8747ff5..e953dc0 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -47,8 +47,11 @@ struct DeclaredSlot {
static inline void BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
Tcl_Namespace *const namespacePtr);
-static void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
+static inline void GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
Tcl_Obj *savedNameObj, const char *typeOfSubject);
+static inline int MagicDefinitionInvoke(Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr, int cmdIndex,
+ int objc, Tcl_Obj *const *objv);
static inline Class * GetClassInOuterContext(Tcl_Interp *interp,
Tcl_Obj *className, const char *errMsg);
static inline int InitDefineContext(Tcl_Interp *interp,
@@ -755,7 +758,7 @@ GetClassInOuterContext(
* ----------------------------------------------------------------------
*/
-static void
+static inline void
GenerateErrorInfo(
Tcl_Interp *interp, /* Where to store the error info trace. */
Object *oPtr, /* What object (or class) was being configured
@@ -787,6 +790,69 @@ GenerateErrorInfo(
/*
* ----------------------------------------------------------------------
*
+ * MagicDefinitionInvoke --
+ * Part of the implementation of the "oo::define" and "oo::objdefine"
+ * commands that is used to implement the more-than-one-argument case,
+ * applying ensemble-like tricks with dispatch so that error messages are
+ * clearer. Doesn't handle the management of the stack frame.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline int
+MagicDefinitionInvoke(
+ Tcl_Interp *interp,
+ Tcl_Namespace *nsPtr,
+ int cmdIndex,
+ int objc,
+ Tcl_Obj *const *objv)
+{
+ Tcl_Obj *objPtr, *obj2Ptr, **objs;
+ Tcl_Command cmd;
+ int isRoot, dummy, result, offset = cmdIndex + 1;
+
+ /*
+ * More than one argument: fire them through the ensemble processing
+ * engine so that everything appears to be good and proper in error
+ * messages. Note that we cannot just concatenate and send through
+ * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we cannot go
+ * through Tcl_EvalObjv without the extra work to pre-find the command, as
+ * that finds command names in the wrong namespace at the moment. Ugly!
+ */
+
+ isRoot = TclInitRewriteEnsemble(interp, offset, 1, objv);
+
+ /*
+ * Build the list of arguments using a Tcl_Obj as a workspace. See
+ * comments above for why these contortions are necessary.
+ */
+
+ objPtr = Tcl_NewObj();
+ obj2Ptr = Tcl_NewObj();
+ cmd = FindCommand(interp, objv[cmdIndex], nsPtr);
+ if (cmd == NULL) {
+ /* punt this case! */
+ Tcl_AppendObjToObj(obj2Ptr, objv[cmdIndex]);
+ } else {
+ Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
+ }
+ Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
+ /* TODO: overflow? */
+ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-offset, objv+offset);
+ Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
+
+ result = Tcl_EvalObjv(interp, objc-cmdIndex, objs, TCL_EVAL_INVOKE);
+ if (isRoot) {
+ TclResetRewriteEnsemble(interp, 1);
+ }
+ Tcl_DecrRefCount(objPtr);
+
+ return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
* TclOODefineObjCmd --
* Implementation of the "oo::define" command. Works by effectively doing
* the same as 'namespace eval', but with extra magic applied so that the
@@ -805,8 +871,8 @@ TclOODefineObjCmd(
Tcl_Obj *const *objv)
{
Foundation *fPtr = TclOOGetFoundation(interp);
- int result;
Object *oPtr;
+ int result;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
@@ -846,46 +912,7 @@ TclOODefineObjCmd(
}
TclDecrRefCount(objNameObj);
} else {
- Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Tcl_Command cmd;
- int isRoot, dummy;
-
- /*
- * More than one argument: fire them through the ensemble processing
- * engine so that everything appears to be good and proper in error
- * messages. Note that we cannot just concatenate and send through
- * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
- * cannot go through Tcl_EvalObjv without the extra work to pre-find
- * the command, as that finds command names in the wrong namespace at
- * the moment. Ugly!
- */
-
- isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
-
- /*
- * Build the list of arguments using a Tcl_Obj as a workspace. See
- * comments above for why these contortions are necessary.
- */
-
- objPtr = Tcl_NewObj();
- obj2Ptr = Tcl_NewObj();
- cmd = FindCommand(interp, objv[2], fPtr->defineNs);
- if (cmd == NULL) {
- /* punt this case! */
- Tcl_AppendObjToObj(obj2Ptr, objv[2]);
- } else {
- Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
- }
- Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
- /* TODO: overflow? */
- Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
- Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
- result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
- if (isRoot) {
- TclResetRewriteEnsemble(interp, 1);
- }
- Tcl_DecrRefCount(objPtr);
+ result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
}
DelRef(oPtr);
@@ -918,8 +945,8 @@ TclOOObjDefObjCmd(
Tcl_Obj *const *objv)
{
Foundation *fPtr = TclOOGetFoundation(interp);
- int isRoot, result;
Object *oPtr;
+ int result;
if (objc < 3) {
Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
@@ -952,47 +979,7 @@ TclOOObjDefObjCmd(
}
TclDecrRefCount(objNameObj);
} else {
- Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Tcl_Command cmd;
- int dummy;
-
- /*
- * More than one argument: fire them through the ensemble processing
- * engine so that everything appears to be good and proper in error
- * messages. Note that we cannot just concatenate and send through
- * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
- * cannot go through Tcl_EvalObjv without the extra work to pre-find
- * the command, as that finds command names in the wrong namespace at
- * the moment. Ugly!
- */
-
- isRoot = TclInitRewriteEnsemble(interp, 3, 1, objv);
-
- /*
- * Build the list of arguments using a Tcl_Obj as a workspace. See
- * comments above for why these contortions are necessary.
- */
-
- objPtr = Tcl_NewObj();
- obj2Ptr = Tcl_NewObj();
- cmd = FindCommand(interp, objv[2], fPtr->objdefNs);
- if (cmd == NULL) {
- /* punt this case! */
- Tcl_AppendObjToObj(obj2Ptr, objv[2]);
- } else {
- Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
- }
- Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
- /* TODO: overflow? */
- Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-3, objv+3);
- Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
- result = Tcl_EvalObjv(interp, objc-2, objs, TCL_EVAL_INVOKE);
-
- if (isRoot) {
- TclResetRewriteEnsemble(interp, 1);
- }
- Tcl_DecrRefCount(objPtr);
+ result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
}
DelRef(oPtr);
@@ -1025,8 +1012,8 @@ TclOODefineSelfObjCmd(
Tcl_Obj *const *objv)
{
Foundation *fPtr = TclOOGetFoundation(interp);
- int result;
Object *oPtr;
+ int result;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
@@ -1059,46 +1046,7 @@ TclOODefineSelfObjCmd(
}
TclDecrRefCount(objNameObj);
} else {
- Tcl_Obj *objPtr, *obj2Ptr, **objs;
- Tcl_Command cmd;
- int isRoot, dummy;
-
- /*
- * More than one argument: fire them through the ensemble processing
- * engine so that everything appears to be good and proper in error
- * messages. Note that we cannot just concatenate and send through
- * Tcl_EvalObjEx, as that doesn't do ensemble processing, and we
- * cannot go through Tcl_EvalObjv without the extra work to pre-find
- * the command, as that finds command names in the wrong namespace at
- * the moment. Ugly!
- */
-
- isRoot = TclInitRewriteEnsemble(interp, 2, 1, objv);
-
- /*
- * Build the list of arguments using a Tcl_Obj as a workspace. See
- * comments above for why these contortions are necessary.
- */
-
- objPtr = Tcl_NewObj();
- obj2Ptr = Tcl_NewObj();
- cmd = FindCommand(interp, objv[1], fPtr->objdefNs);
- if (cmd == NULL) {
- /* punt this case! */
- Tcl_AppendObjToObj(obj2Ptr, objv[1]);
- } else {
- Tcl_GetCommandFullName(interp, cmd, obj2Ptr);
- }
- Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr);
- /* TODO: overflow? */
- Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc-2, objv+2);
- Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs);
-
- result = Tcl_EvalObjv(interp, objc-1, objs, TCL_EVAL_INVOKE);
- if (isRoot) {
- TclResetRewriteEnsemble(interp, 1);
- }
- Tcl_DecrRefCount(objPtr);
+ result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
}
DelRef(oPtr);
--
cgit v0.12