Itcl - the [incr Tcl] extension

Check-in [bc31e1da48]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

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

Overview
Comment:fix [1dc2d851eb] case "sfbug-254.1" - Tcl_GetObjectFromObj/Tcl_GetObjectAsClass could return NULL (without oo-machinery), test passed now
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | bug-1dc2d851eb
Files: files | file ages | folders
SHA3-256:bc31e1da4817c5b8b590a34bbd2de351593e572585d70f91fec6996a0b771df7
User & Date: sebres 2019-02-08 21:18:36
Context
2019-02-08
22:38
small amend: simplifying code and cleanup in error check-in: 31b795fefd user: sebres tags: bug-1dc2d851eb
21:18
fix [1dc2d851eb] case "sfbug-254.1" - Tcl_GetObjectFromObj/Tcl_GetObjectAsClass could return NULL (without oo-machinery), test passed now check-in: bc31e1da48 user: sebres tags: bug-1dc2d851eb
20:50
more tests illustrating [1dc2d851eb] check-in: ae5616de01 user: sebres tags: bug-1dc2d851eb
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclBase.c.

208
209
210
211
212
213
214

215
216
217
218
219
220
221
...
338
339
340
341
342
343
344
345
346








347
348
349
350
351
352
353
...
732
733
734
735
736
737
738

739


740

741

742


743

744
745


746
747
748
749
750
751
752
    Tcl_Namespace *itclNs;
    Tcl_HashEntry *hPtr;
    ItclObjectInfo *infoPtr;
    const char * ret;
    char *res_option;
    int opt;
    int isNew;

    Tcl_Object clazzObjectPtr, root;
    Tcl_Obj *objPtr, *resPtr;

    if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
        return TCL_ERROR;
    }

................................................................................
    Itcl_PreserveData((ClientData)infoPtr);

#ifdef NEW_PROTO_RESOLVER
    ItclVarsAndCommandResolveInit(interp);
#endif

    objPtr = Tcl_NewStringObj("::oo::class", -1);
    root = Tcl_NewObjectInstance(interp, Tcl_GetObjectAsClass(
	    Tcl_GetObjectFromObj(interp, objPtr)), "::itcl::Root",








	    NULL, 0, NULL, 0);
    Tcl_DecrRefCount(objPtr);

    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("unknown", -1), 0, &itclRootMethodType,
	    ItclUnknownGuts);
    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
................................................................................
	    Tcl_SetEnsembleMappingDict(interp, cmdPtr, mapDict);
        }
    }
    /* FIXME have to figure out why the refCount of
     * ::itcl::builtin::Info
     * and ::itcl::builtin::Info::vars and vars is 2 here !! */
    /* seems to be as the tclOO commands are not yet deleted ?? */

    Tcl_DecrRefCount(infoPtr->infoVars3Ptr);


    Tcl_DecrRefCount(infoPtr->infoVars4Ptr);

    if (checkMemoryLeaks) {

        Tcl_DecrRefCount(infoPtr->infoVars3Ptr);


        Tcl_DecrRefCount(infoPtr->infoVars4Ptr);

    /* see comment above */
    }



    Tcl_DecrRefCount(infoPtr->typeDestructorArgumentPtr);

    Tcl_EvalEx(infoPtr->interp,
            "::oo::define ::itcl::clazz deletemethod unknown", -1, 0);

    /* first have to look for the remaining memory leaks, then remove the next ifdef */







>







 







|
|
>
>
>
>
>
>
>
>







 







>
|
>
>
|
>

>
|
>
>
|
>


>
>







208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
...
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
...
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
    Tcl_Namespace *itclNs;
    Tcl_HashEntry *hPtr;
    ItclObjectInfo *infoPtr;
    const char * ret;
    char *res_option;
    int opt;
    int isNew;
    Tcl_Class tclCls;
    Tcl_Object clazzObjectPtr, root;
    Tcl_Obj *objPtr, *resPtr;

    if (Tcl_InitStubs(interp, "8.6", 0) == NULL) {
        return TCL_ERROR;
    }

................................................................................
    Itcl_PreserveData((ClientData)infoPtr);

#ifdef NEW_PROTO_RESOLVER
    ItclVarsAndCommandResolveInit(interp);
#endif

    objPtr = Tcl_NewStringObj("::oo::class", -1);
    Tcl_IncrRefCount(objPtr);
    clazzObjectPtr = Tcl_GetObjectFromObj(interp, objPtr);
    if (!clazzObjectPtr) {
        return TCL_ERROR;
    }
    tclCls = Tcl_GetObjectAsClass(clazzObjectPtr);
    if (!tclCls) {
        return TCL_ERROR;
    }
    root = Tcl_NewObjectInstance(interp, tclCls, "::itcl::Root",
	    NULL, 0, NULL, 0);
    Tcl_DecrRefCount(objPtr);

    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
	    Tcl_NewStringObj("unknown", -1), 0, &itclRootMethodType,
	    ItclUnknownGuts);
    Tcl_NewMethod(interp, Tcl_GetObjectAsClass(root),
................................................................................
	    Tcl_SetEnsembleMappingDict(interp, cmdPtr, mapDict);
        }
    }
    /* FIXME have to figure out why the refCount of
     * ::itcl::builtin::Info
     * and ::itcl::builtin::Info::vars and vars is 2 here !! */
    /* seems to be as the tclOO commands are not yet deleted ?? */
    if (infoPtr->infoVars3Ptr) {
	Tcl_DecrRefCount(infoPtr->infoVars3Ptr);
    }
    if (infoPtr->infoVars4Ptr) {
	Tcl_DecrRefCount(infoPtr->infoVars4Ptr);
    }
    if (checkMemoryLeaks) {
        if (infoPtr->infoVars3Ptr) {
	    Tcl_DecrRefCount(infoPtr->infoVars3Ptr);
	}
	if (infoPtr->infoVars4Ptr) {
	    Tcl_DecrRefCount(infoPtr->infoVars4Ptr);
	}
    /* see comment above */
    }
    infoPtr->infoVars3Ptr = NULL;
    infoPtr->infoVars4Ptr = NULL;

    Tcl_DecrRefCount(infoPtr->typeDestructorArgumentPtr);

    Tcl_EvalEx(infoPtr->interp,
            "::oo::define ::itcl::clazz deletemethod unknown", -1, 0);

    /* first have to look for the remaining memory leaks, then remove the next ifdef */