Itcl - the [incr Tcl] extension

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

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

Overview
Comment:restored clazzObjectPtr and check via this object due to timing problem (clazzClassPtr returns still valid this-object by deleted oo-subsystem sporadicaly, well reproducible within DEBUG-build).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: abf70db2936bcf16236b7373e6773b729a1db54d8aef026cef4245037eb40f7b
User & Date: sebres 2019-02-10 01:46:39
Context
2019-02-10
16:56
Re-generate configure script. Change various function calls to the *2() or *Ex() versions. This improves possible future compatibility with Tcl 9. For now, it doesn't really matter. check-in: ac9d8318e1 user: jan.nijtmans tags: trunk
01:48
merge fix from trunk check-in: fe7810c5f7 user: sebres tags: sebres-memopt-perf-branch
01:46
restored clazzObjectPtr and check via this object due to timing problem (clazzClassPtr returns still valid this-object by deleted oo-subsystem sporadicaly, well reproducible within DEBUG-build). check-in: abf70db293 user: sebres tags: trunk
2019-02-09
20:22
code review: revert clazzObjectPtr back to unused, remove increment workaround for OO 1.0.2 (thisPtr of clazz is removed with last ref to engine, no matter how many references still exist). check-in: b8e09f7f17 user: sebres tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/itclBase.c.

379
380
381
382
383
384
385

386
387
388
389
390
391
392
    if (clazzObjectPtr == NULL) {
        Tcl_AppendResult(interp,
                "ITCL: cannot get Object for ::itcl::clazz for class \"",
                "::itcl::clazz", "\"", NULL);
        return TCL_ERROR;
    }


    infoPtr->clazzClassPtr = Tcl_GetObjectAsClass(clazzObjectPtr);

    /*
     *  Initialize the ensemble package first, since we need this
     *  for other parts of [incr Tcl].
     */







>







379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
    if (clazzObjectPtr == NULL) {
        Tcl_AppendResult(interp,
                "ITCL: cannot get Object for ::itcl::clazz for class \"",
                "::itcl::clazz", "\"", NULL);
        return TCL_ERROR;
    }

    infoPtr->clazzObjectPtr = clazzObjectPtr;
    infoPtr->clazzClassPtr = Tcl_GetObjectAsClass(clazzObjectPtr);

    /*
     *  Initialize the ensemble package first, since we need this
     *  for other parts of [incr Tcl].
     */

Changes to generic/itclClass.c.

244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
    Tcl_HashEntry *hPtr;
    void *callbackPtr;
    int result;
    int newEntry;
    ItclResolveInfo *resolveInfoPtr;
    Tcl_Obj *cmdNamePtr;

    if (!infoPtr->clazzClassPtr
	|| Tcl_ObjectDeleted(Tcl_GetClassAsObject(infoPtr->clazzClassPtr))
    ) {
	Tcl_AppendResult(interp, "oo-subsystem is deleted", NULL);
	return TCL_ERROR;
    }

    /*
     * check for an empty class name to avoid a crash






|
|







244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
    Tcl_HashEntry *hPtr;
    void *callbackPtr;
    int result;
    int newEntry;
    ItclResolveInfo *resolveInfoPtr;
    Tcl_Obj *cmdNamePtr;

    if (!infoPtr->clazzObjectPtr
	|| Tcl_ObjectDeleted(infoPtr->clazzObjectPtr)
    ) {
	Tcl_AppendResult(interp, "oo-subsystem is deleted", NULL);
	return TCL_ERROR;
    }

    /*
     * check for an empty class name to avoid a crash

Changes to generic/itclInt.h.

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
				     * otherwise NULL */
    Tcl_ObjectMetadataType *class_meta_type;
                                    /* type for getting the Itcl class info
                                     * from a TclOO Tcl_Object */
    const Tcl_ObjectMetadataType *object_meta_type;
                                    /* type for getting the Itcl object info
                                     * from a TclOO Tcl_Object */
    Tcl_Object unused1;             /* the root object of Itcl */
    Tcl_Class clazzClassPtr;        /* the root class of Itcl */
    struct EnsembleInfo *ensembleInfo;
    struct ItclClass *currContextIclsPtr;
                                    /* context class for delegated option
                                     * handling */
    int currClassFlags;             /* flags for the class just in creation */
    int buildingWidget;             /* set if in construction of a widget */






|







165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
				     * otherwise NULL */
    Tcl_ObjectMetadataType *class_meta_type;
                                    /* type for getting the Itcl class info
                                     * from a TclOO Tcl_Object */
    const Tcl_ObjectMetadataType *object_meta_type;
                                    /* type for getting the Itcl object info
                                     * from a TclOO Tcl_Object */
    Tcl_Object clazzObjectPtr;      /* the root object of Itcl */
    Tcl_Class clazzClassPtr;        /* the root class of Itcl */
    struct EnsembleInfo *ensembleInfo;
    struct ItclClass *currContextIclsPtr;
                                    /* context class for delegated option
                                     * handling */
    int currClassFlags;             /* flags for the class just in creation */
    int buildingWidget;             /* set if in construction of a widget */