TclOO Package

Check-in [0274fdbceb]
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:[tcl:1a56550e96] Ensure that method list introspection finds methods from mixins in all cases.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 0274fdbceb3cb4fb3909bac108207b2d73d30997
User & Date: dkf 2017-10-19 11:05:21
Context
2017-10-19
11:06
Implementation of TIP 473 went into 8.6 series Tcl. Leaf check-in: 9331a9eb28 user: dkf tags: trunk
11:05
[tcl:1a56550e96] Ensure that method list introspection finds methods from mixins in all cases. check-in: 0274fdbceb user: dkf tags: trunk
2016-04-20
07:58
[6adfa8fddf] Fix test target check-in: e5b56214c7 user: gahr tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclOOCall.c.

    43     43    * Function declarations for things defined in this file.
    44     44    */
    45     45   
    46     46   static void		AddClassFiltersToCallContext(Object *const oPtr,
    47     47   			    Class *clsPtr, struct ChainBuilder *const cbPtr,
    48     48   			    Tcl_HashTable *const doneFilters);
    49     49   static void		AddClassMethodNames(Class *clsPtr, const int flags,
    50         -			    Tcl_HashTable *const namesPtr);
           50  +			    Tcl_HashTable *const namesPtr,
           51  +			    Tcl_HashTable *const examinedClassesPtr);
    51     52   static inline void	AddMethodToCallChain(Method *const mPtr,
    52     53   			    struct ChainBuilder *const cbPtr,
    53     54   			    Tcl_HashTable *const doneFilters,
    54     55   			    Class *const filterDecl);
    55     56   static inline void	AddSimpleChainToCallContext(Object *const oPtr,
    56     57   			    Tcl_Obj *const methodNameObj,
    57     58   			    struct ChainBuilder *const cbPtr,
................................................................................
   326    327       int flags,			/* Whether we just want the public method
   327    328   				 * names. */
   328    329       const char ***stringsPtr)	/* Where to write a pointer to the array of
   329    330   				 * strings to. */
   330    331   {
   331    332       Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
   332    333   				 * mapping. */
          334  +    Tcl_HashTable examinedClasses;
          335  +				/* Used to track what classes have been looked
          336  +				 * at. Is set-like in nature and keyed by
          337  +				 * pointer to class. */
   333    338       FOREACH_HASH_DECLS;
   334    339       int i;
   335    340       Class *mixinPtr;
   336    341       Tcl_Obj *namePtr;
   337    342       Method *mPtr;
   338    343       int isWantedIn;
   339    344       void *isWanted;
   340    345   
   341    346       Tcl_InitObjHashTable(&names);
          347  +    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
   342    348   
   343    349       /*
   344    350        * Name the bits used in the names table values.
   345    351        */
   346    352   #define IN_LIST 1
   347    353   #define NO_IMPLEMENTATION 2
   348    354   
................................................................................
   395    401       }
   396    402   
   397    403       /*
   398    404        * Process (normal) method names from the class hierarchy and the mixin
   399    405        * hierarchy.
   400    406        */
   401    407   
   402         -    AddClassMethodNames(oPtr->selfCls, flags, &names);
          408  +    AddClassMethodNames(oPtr->selfCls, flags, &names, &examinedClasses);
   403    409       FOREACH(mixinPtr, oPtr->mixins) {
   404         -	AddClassMethodNames(mixinPtr, flags, &names);
          410  +	AddClassMethodNames(mixinPtr, flags, &names, &examinedClasses);
   405    411       }
          412  +
          413  +    Tcl_DeleteHashTable(&examinedClasses);
   406    414   
   407    415       /*
   408    416        * See how many (visible) method names there are. If none, we do not (and
   409    417        * should not) try to sort the list of them.
   410    418        */
   411    419   
   412    420       i = 0;
................................................................................
   454    462       int flags,			/* Whether we just want the public method
   455    463   				 * names. */
   456    464       const char ***stringsPtr)	/* Where to write a pointer to the array of
   457    465   				 * strings to. */
   458    466   {
   459    467       Tcl_HashTable names;	/* Tcl_Obj* method name to "wanted in list"
   460    468   				 * mapping. */
          469  +    Tcl_HashTable examinedClasses;
          470  +				/* Used to track what classes have been looked
          471  +				 * at. Is set-like in nature and keyed by
          472  +				 * pointer to class. */
   461    473       FOREACH_HASH_DECLS;
   462    474       int i;
   463    475       Tcl_Obj *namePtr;
   464    476       void *isWanted;
   465    477   
   466    478       Tcl_InitObjHashTable(&names);
          479  +    Tcl_InitHashTable(&examinedClasses, TCL_ONE_WORD_KEYS);
   467    480   
   468    481       /*
   469    482        * Process method names from the class hierarchy and the mixin hierarchy.
   470    483        */
   471    484   
   472         -    AddClassMethodNames(clsPtr, flags, &names);
          485  +    AddClassMethodNames(clsPtr, flags, &names, &examinedClasses);
          486  +    Tcl_DeleteHashTable(&examinedClasses);
   473    487   
   474    488       /*
   475    489        * See how many (visible) method names there are. If none, we do not (and
   476    490        * should not) try to sort the list of them.
   477    491        */
   478    492   
   479    493       i = 0;
................................................................................
   540    554    */
   541    555   
   542    556   static void
   543    557   AddClassMethodNames(
   544    558       Class *clsPtr,		/* Class to get method names from. */
   545    559       const int flags,		/* Whether we are interested in just the
   546    560   				 * public method names. */
   547         -    Tcl_HashTable *const namesPtr)
          561  +    Tcl_HashTable *const namesPtr,
   548    562   				/* Reference to the hash table to put the
   549    563   				 * information in. The hash table maps the
   550    564   				 * Tcl_Obj * method name to an integral value
   551    565   				 * describing whether the method is wanted.
   552    566   				 * This ensures that public/private override
   553    567   				 * semantics are handled correctly.*/
          568  +    Tcl_HashTable *const examinedClassesPtr)
          569  +				/* Hash table that tracks what classes have
          570  +				 * already been looked at. The keys are the
          571  +				 * pointers to the classes, and the values are
          572  +				 * immaterial. */
   554    573   {
          574  +    /*
          575  +     * If we've already started looking at this class, stop working on it now
          576  +     * to prevent repeated work.
          577  +     */
          578  +
          579  +    if (Tcl_FindHashEntry(examinedClassesPtr, (char *) clsPtr)) {
          580  +	return;
          581  +    }
          582  +
   555    583       /*
   556    584        * Scope all declarations so that the compiler can stand a good chance of
   557    585        * making the recursive step highly efficient. We also hand-implement the
   558    586        * tail-recursive case using a while loop; C compilers typically cannot do
   559    587        * tail-recursion optimization usefully.
   560    588        */
   561    589   
   562         -    if (clsPtr->mixins.num != 0) {
   563         -	Class *mixinPtr;
   564         -	int i;
   565         -
   566         -	/* TODO: Beware of infinite loops! */
   567         -	FOREACH(mixinPtr, clsPtr->mixins) {
   568         -	    AddClassMethodNames(mixinPtr, flags, namesPtr);
   569         -	}
   570         -    }
   571         -
   572    590       while (1) {
   573    591   	FOREACH_HASH_DECLS;
   574    592   	Tcl_Obj *namePtr;
   575    593   	Method *mPtr;
          594  +	int isNew;
          595  +
          596  +	(void) Tcl_CreateHashEntry(examinedClassesPtr, (char *) clsPtr,
          597  +		&isNew);
          598  +	if (!isNew) {
          599  +	    break;
          600  +	}
          601  +
          602  +	if (clsPtr->mixins.num != 0) {
          603  +	    Class *mixinPtr;
          604  +	    int i;
          605  +
          606  +	    FOREACH(mixinPtr, clsPtr->mixins) {
          607  +		AddClassMethodNames(mixinPtr, flags, namesPtr,
          608  +			examinedClassesPtr);
          609  +	    }
          610  +	}
   576    611   
   577    612   	FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) {
   578         -	    int isNew;
   579         -
   580    613   	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
   581    614   	    if (isNew) {
   582    615   		int isWanted = (!(flags & PUBLIC_METHOD)
   583    616   			|| (mPtr->flags & PUBLIC_METHOD)) ? IN_LIST : 0;
   584    617   
   585    618   		Tcl_SetHashValue(hPtr, INT2PTR(isWanted));
   586    619   	    } else if ((PTR2INT(Tcl_GetHashValue(hPtr)) & NO_IMPLEMENTATION)
................................................................................
   598    631   	clsPtr = clsPtr->superclasses.list[0];
   599    632       }
   600    633       if (clsPtr->superclasses.num != 0) {
   601    634   	Class *superPtr;
   602    635   	int i;
   603    636   
   604    637   	FOREACH(superPtr, clsPtr->superclasses) {
   605         -	    AddClassMethodNames(superPtr, flags, namesPtr);
          638  +	    AddClassMethodNames(superPtr, flags, namesPtr,
          639  +		    examinedClassesPtr);
   606    640   	}
   607    641       }
   608    642   }
   609    643   
   610    644   /*
   611    645    * ----------------------------------------------------------------------
   612    646    *

Changes to tests/oo.test.

  3443   3443   } {}
  3444   3444   test oo-35.4 {Bug 593baa032c: mixins list teardown} {
  3445   3445       # Bug makes this crash, especially with mem-debugging on
  3446   3446       oo::class create B {}
  3447   3447       oo::class create D {mixin B}
  3448   3448       namespace eval [info object namespace D] [list [namespace which B] destroy]
  3449   3449   } {}
         3450  +test oo-35.5 {Bug 1a56550e96: introspectors must traverse mixin links correctly} -setup {
         3451  +    oo::class create base {
         3452  +	unexport destroy
         3453  +    }
         3454  +} -body {
         3455  +    oo::class create C {
         3456  +	superclass base
         3457  +	method c {} {}
         3458  +    }
         3459  +    oo::class create D {
         3460  +	superclass base
         3461  +	mixin C
         3462  +	method d {} {}
         3463  +    }
         3464  +    oo::class create E {
         3465  +	superclass D
         3466  +	method e {} {}
         3467  +    }
         3468  +    E create e1
         3469  +    list [lsort [info class methods E -all]] [lsort [info object methods e1 -all]]
         3470  +} -cleanup {
         3471  +    base destroy
         3472  +} -result {{c d e} {c d e}}
  3450   3473   
  3451   3474   cleanupTests
  3452   3475   return
  3453   3476   
  3454   3477   # Local Variables:
  3455   3478   # mode: tcl
  3456   3479   # End: