Itcl - the [incr Tcl] extension

Check-in [0e02e7b014]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fix for SF bug #244
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0e02e7b0148492e3d8163e6ac27dfbb9d1af3e47
User & Date: arnulf 2014-01-26 17:20:52
Context
2014-01-26
17:21
fix for SF bug #244 check-in: fb472c7861 user: arnulf tags: trunk
17:20
fix for SF bug #244 check-in: 0e02e7b014 user: arnulf tags: trunk
09:41
Fix for SF bug #248. check-in: d6e939152b user: arnulf tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclMethod.c.

1173
1174
1175
1176
1177
1178
1179

1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193







1194
1195
1196
1197
1198
1199
1200
1201
    int result)
{
    Tcl_Object oPtr;
    ItclMemberFunc *imPtr = data[0];
    ItclObject *ioPtr = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];

    
    ItclShowArgs(1, "CallObjectCmd", objc, objv);
    if (ioPtr != NULL) {
        ioPtr->hadConstructorError = 0;
    }
    if (imPtr->flags & (ITCL_CONSTRUCTOR|ITCL_DESTRUCTOR)) {
        oPtr = ioPtr->oPtr;
    } else {
        oPtr = NULL;
    }
    if (oPtr != NULL) {
        result =  ItclObjectCmd(imPtr, interp, oPtr, imPtr->iclsPtr->clsPtr,
                objc, objv);
    } else {







        result = ItclObjectCmd(imPtr, interp, NULL, NULL, objc, objv);
    }
    if (result != TCL_OK) {
	if (ioPtr != NULL && ioPtr->hadConstructorError == 0) {
	    /* we are in a constructor call and did not yet have an error */
	    /* -1 means we are not in a constructor */
            ioPtr->hadConstructorError = 1;
	}







>

|












>
>
>
>
>
>
>
|







1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
    int result)
{
    Tcl_Object oPtr;
    ItclMemberFunc *imPtr = data[0];
    ItclObject *ioPtr = data[1];
    int objc = PTR2INT(data[2]);
    Tcl_Obj **objv = data[3];
    void * ptr;
    
    ItclShowArgs(1, "CallItclObjectCmd", objc, objv);
    if (ioPtr != NULL) {
        ioPtr->hadConstructorError = 0;
    }
    if (imPtr->flags & (ITCL_CONSTRUCTOR|ITCL_DESTRUCTOR)) {
        oPtr = ioPtr->oPtr;
    } else {
        oPtr = NULL;
    }
    if (oPtr != NULL) {
        result =  ItclObjectCmd(imPtr, interp, oPtr, imPtr->iclsPtr->clsPtr,
                objc, objv);
    } else {
        ptr = Itcl_GetCallFrameVarFramePtr(interp);
        if (Itcl_GetUplevelCallFrame(interp, 0) != ptr) {
            /* we are executing an uplevel command (SF bug #244) */
            if (ioPtr != NULL) {
                oPtr = ioPtr->oPtr;
            }
        }
        result = ItclObjectCmd(imPtr, interp, oPtr, NULL, objc, objv);
    }
    if (result != TCL_OK) {
	if (ioPtr != NULL && ioPtr->hadConstructorError == 0) {
	    /* we are in a constructor call and did not yet have an error */
	    /* -1 means we are not in a constructor */
            ioPtr->hadConstructorError = 1;
	}

Changes to generic/itclMigrate2TclCore.c.

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103








104
105
106
107
108
109
110
    }
    if (framePtr == NULL) {
        return NULL;
    }
    return (Tcl_CallFrame *)framePtr;
}


Tcl_CallFrame *
Itcl_ActivateCallFrame(
    Tcl_Interp *interp,
    Tcl_CallFrame *framePtr)
{
    Interp *iPtr = (Interp*)interp;
    CallFrame *oldFramePtr;

    oldFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = (CallFrame *) framePtr;

    return (Tcl_CallFrame *) oldFramePtr;
}









Tcl_Namespace *
Itcl_GetUplevelNamespace(
    Tcl_Interp *interp,
    int level)
{
    CallFrame *framePtr;







<













>
>
>
>
>
>
>
>







83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
    }
    if (framePtr == NULL) {
        return NULL;
    }
    return (Tcl_CallFrame *)framePtr;
}


Tcl_CallFrame *
Itcl_ActivateCallFrame(
    Tcl_Interp *interp,
    Tcl_CallFrame *framePtr)
{
    Interp *iPtr = (Interp*)interp;
    CallFrame *oldFramePtr;

    oldFramePtr = iPtr->varFramePtr;
    iPtr->varFramePtr = (CallFrame *) framePtr;

    return (Tcl_CallFrame *) oldFramePtr;
}

void *
Itcl_GetCallFrameVarFramePtr(
    Tcl_Interp *interp)
{

    return ((Interp *)interp)->varFramePtr;
}

Tcl_Namespace *
Itcl_GetUplevelNamespace(
    Tcl_Interp *interp,
    int level)
{
    CallFrame *framePtr;

Changes to generic/itclMigrate2TclCore.h.

73
74
75
76
77
78
79

80
81
82
#endif

#define Tcl_SetProcCmd _Tcl_SetProcCmd

MODULE_SCOPE Tcl_Var Tcl_NewNamespaceVar(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	const char *varName);
MODULE_SCOPE int Itcl_IsCallFrameArgument(Tcl_Interp *interp, const char *name);

#define Tcl_SetNamespaceResolver _Tcl_SetNamespaceResolver
MODULE_SCOPE int _Tcl_SetNamespaceResolver(Tcl_Namespace *nsPtr,
        struct Tcl_Resolve *resolvePtr);







>



73
74
75
76
77
78
79
80
81
82
83
#endif

#define Tcl_SetProcCmd _Tcl_SetProcCmd

MODULE_SCOPE Tcl_Var Tcl_NewNamespaceVar(Tcl_Interp *interp, Tcl_Namespace *nsPtr,
	const char *varName);
MODULE_SCOPE int Itcl_IsCallFrameArgument(Tcl_Interp *interp, const char *name);
MODULE_SCOPE void *Itcl_GetCallFrameVarFramePtr(Tcl_Interp *interp);
#define Tcl_SetNamespaceResolver _Tcl_SetNamespaceResolver
MODULE_SCOPE int _Tcl_SetNamespaceResolver(Tcl_Namespace *nsPtr,
        struct Tcl_Resolve *resolvePtr);

Changes to generic/itclObject.c.

2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
    imPtr = (ItclMemberFunc *)clientData;
    iclsPtr = imPtr->iclsPtr;
    infoPtr = imPtr->iclsPtr->infoPtr;
    if ((oPtr == NULL) && (clsPtr == NULL)) {
         isDirectCall = 1;
    }
    if (oPtr == NULL) {
	ClientData clientData;
	if ((imPtr->flags & ITCL_COMMON)
	        && (imPtr->codePtr != NULL)
	        && !(imPtr->codePtr->flags & ITCL_BUILTIN)) {
	    result = Itcl_InvokeProcedureMethod(imPtr->tmPtr, interp,
	            objc, objv);
            return result;
	}
	oPtr = NULL;
	clientData = Itcl_GetCallFrameClientData(interp);
	if ((clientData == NULL) && (oPtr == NULL)) {
	    if (((imPtr->codePtr != NULL)
	            && (imPtr->codePtr->flags & ITCL_BUILTIN))) {
	        result = Itcl_InvokeProcedureMethod(imPtr->tmPtr, interp,
	                objc, objv);
                return result;
	    }
	    if (infoPtr->currIoPtr != NULL) {
	        /* if we want to call methods in the constructor for example
	         * config* methods, clientData
	         * is still NULL, but we can use infoPtr->currIoPtr
	         * for getting the TclOO object ptr
	         */
	        oPtr = infoPtr->currIoPtr->oPtr;
	    } else {
	        Tcl_AppendResult(interp,
	                "ItclObjectCmd cannot get context object (NULL)", NULL);
	        return TCL_ERROR;
	    }
	}
	if (oPtr == NULL) {
            oPtr = Tcl_ObjectContextObject((Tcl_ObjectContext)clientData);
        }
    }
    methodNamePtr = NULL;
    if (objv[0] != NULL) {
        Itcl_ParseNamespPath(Tcl_GetString(objv[0]), &buffer,
	        &className, &tail);
        if (className != NULL) {







|








|
|




















|







2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
    imPtr = (ItclMemberFunc *)clientData;
    iclsPtr = imPtr->iclsPtr;
    infoPtr = imPtr->iclsPtr->infoPtr;
    if ((oPtr == NULL) && (clsPtr == NULL)) {
         isDirectCall = 1;
    }
    if (oPtr == NULL) {
	ClientData clientData2;
	if ((imPtr->flags & ITCL_COMMON)
	        && (imPtr->codePtr != NULL)
	        && !(imPtr->codePtr->flags & ITCL_BUILTIN)) {
	    result = Itcl_InvokeProcedureMethod(imPtr->tmPtr, interp,
	            objc, objv);
            return result;
	}
	oPtr = NULL;
	clientData2 = Itcl_GetCallFrameClientData(interp);
	if ((clientData2 == NULL) && (oPtr == NULL)) {
	    if (((imPtr->codePtr != NULL)
	            && (imPtr->codePtr->flags & ITCL_BUILTIN))) {
	        result = Itcl_InvokeProcedureMethod(imPtr->tmPtr, interp,
	                objc, objv);
                return result;
	    }
	    if (infoPtr->currIoPtr != NULL) {
	        /* if we want to call methods in the constructor for example
	         * config* methods, clientData
	         * is still NULL, but we can use infoPtr->currIoPtr
	         * for getting the TclOO object ptr
	         */
	        oPtr = infoPtr->currIoPtr->oPtr;
	    } else {
	        Tcl_AppendResult(interp,
	                "ItclObjectCmd cannot get context object (NULL)", NULL);
	        return TCL_ERROR;
	    }
	}
	if (oPtr == NULL) {
            oPtr = Tcl_ObjectContextObject((Tcl_ObjectContext)clientData2);
        }
    }
    methodNamePtr = NULL;
    if (objv[0] != NULL) {
        Itcl_ParseNamespPath(Tcl_GetString(objv[0]), &buffer,
	        &className, &tail);
        if (className != NULL) {
2725
2726
2727
2728
2729
2730
2731


2732
2733
2734
2735
2736
2737
2738
		    found = 1;
		    break;
		}
                elem = Itcl_NextListElem(elem);
	    }
        }
        Tcl_DStringFree(&buffer);


    }
    if (isDirectCall) {
	if (!found) {
	    if (methodNamePtr != NULL) {
	        Tcl_DecrRefCount(methodNamePtr);
	    }
            methodNamePtr = objv[0];







>
>







2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
		    found = 1;
		    break;
		}
                elem = Itcl_NextListElem(elem);
	    }
        }
        Tcl_DStringFree(&buffer);
    } else {
        methodNamePtr = Tcl_NewStringObj(tail, -1);
    }
    if (isDirectCall) {
	if (!found) {
	    if (methodNamePtr != NULL) {
	        Tcl_DecrRefCount(methodNamePtr);
	    }
            methodNamePtr = objv[0];
2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798









2799



2800

2801
2802
2803
2804
2805
2806
2807
	    if (strcmp(myName, "installcomponent") == 0) {
                result = Itcl_BiInstallComponentCmd(iclsPtr, interp, objc, objv);
		return result;
	    }
	}
        incr = 1;
        newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *)*(objc+incr));
	myPtr = Tcl_NewStringObj("my", 2);
        Tcl_IncrRefCount(myPtr);
        newObjv[0] = myPtr;
        newObjv[1] = methodNamePtr;
        memcpy(newObjv+incr+1, objv+1, (sizeof(Tcl_Obj*)*(objc-1)));
	ItclShowArgs(1, "run CallPublicObjectCmd1", objc+incr, newObjv);
	Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,
	        INT2PTR(objc+incr), newObjv);

    } else {
	ItclShowArgs(1, "run CallPublicObjectCmd2", objc, objv);









	Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,



	        INT2PTR(objc), (ClientData)objv);

    }

    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (methodNamePtr != NULL) {
        ckfree((char *)newObjv);
        Tcl_DecrRefCount(methodNamePtr);
    }







|










>
>
>
>
>
>
>
>
>
|
>
>
>
|
>







2783
2784
2785
2786
2787
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
	    if (strcmp(myName, "installcomponent") == 0) {
                result = Itcl_BiInstallComponentCmd(iclsPtr, interp, objc, objv);
		return result;
	    }
	}
        incr = 1;
        newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *)*(objc+incr));
        myPtr = Tcl_NewStringObj("my", 2);
        Tcl_IncrRefCount(myPtr);
        newObjv[0] = myPtr;
        newObjv[1] = methodNamePtr;
        memcpy(newObjv+incr+1, objv+1, (sizeof(Tcl_Obj*)*(objc-1)));
	ItclShowArgs(1, "run CallPublicObjectCmd1", objc+incr, newObjv);
	Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,
	        INT2PTR(objc+incr), newObjv);

    } else {
	ItclShowArgs(1, "run CallPublicObjectCmd2", objc, objv);
        if (objc == 1) {
            /* add a "my" at the beginning of the arguments */
            incr = 1;
            newObjv = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *)*(objc+incr));
            myPtr = Tcl_NewStringObj("my", 2);
            Tcl_IncrRefCount(myPtr);
            newObjv[0] = myPtr;
            memcpy(newObjv+incr, objv, (sizeof(Tcl_Obj*)*(objc)));
	    ItclShowArgs(1, "run CallPublicObjectCmd3", objc+incr, newObjv);
            Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,
                    INT2PTR(objc+incr), newObjv);
        } else {
	    Tcl_NRAddCallback(interp, CallPublicObjectCmd, oPtr, clsPtr,
	            INT2PTR(objc), (ClientData)objv);
        }
    }

    result = Itcl_NRRunCallbacks(interp, callbackPtr);
    if (methodNamePtr != NULL) {
        ckfree((char *)newObjv);
        Tcl_DecrRefCount(methodNamePtr);
    }