Tcl Source Code

Changes On Branch tip-524
Login
Bounty program for improvements to Tcl and certain Tcl packages.

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

Changes In Branch tip-524 Excluding Merge-Ins

This is equivalent to a diff from fc3996f465 to 5fbb86d1a1

2018-11-06
11:15
Implement TIP 524 check-in: f726350fc9 user: dkf tags: core-8-branch
2018-10-29
13:19
[TIP 522] New option "-errorCode" to [tcltest::test] in tcltest 2.5 check-in: 6852438731 user: dgp tags: core-8-branch
2018-10-28
19:26
Merge 8.7 check-in: 4f12a75d03 user: jan.nijtmans tags: tip-468
19:21
Experiment: See if we can build and test using cross-compiled mingw-w64 with wine check-in: 4c6c98a736 user: jan.nijtmans tags: travis-8.7-wine
15:36
Documentation Closed-Leaf check-in: 5fbb86d1a1 user: dkf tags: tip-524
12:48
Test cases (and some fixes) check-in: c1d92c86e0 user: dkf tags: tip-524
2018-10-27
22:12
merge core-8-branch check-in: c000f42f30 user: dkf tags: tip-524
19:46
Merge 8.7 check-in: 6966eb6f6f user: jan.nijtmans tags: trunk
19:45
Merge 8.6 check-in: fc3996f465 user: jan.nijtmans tags: core-8-branch
19:43
merge-mark... well ... almost: Except for a missing <include> in tclWinDde.c check-in: db9d745b8d user: jan.nijtmans tags: core-8-6-branch
18:08
Update TZ info to tzdata2018g. check-in: 0bf9474c61 user: jima tags: core-8-branch

Changes to doc/define.n.

    30     30   configuration of all subclasses of the class and all objects that are
    31     31   instances of that class or which mix it in (as modified by any per-instance
    32     32   configuration). The way in which the configuration is done is controlled by
    33     33   either the \fIdefScript\fR argument or by the \fIsubcommand\fR and following
    34     34   \fIarg\fR arguments; when the second is present, it is exactly as if all the
    35     35   arguments from \fIsubcommand\fR onwards are made into a list and that list is
    36     36   used as the \fIdefScript\fR argument.
    37         -.SS "CONFIGURING CLASSES"
           37  +.PP
           38  +Note that the constructor for \fBoo::class\fR will call \fBoo::define\fR on
           39  +the script argument that it is provided. This is a convenient way to create
           40  +and define a class in one step.
           41  +.SH "CONFIGURING CLASSES"
    38     42   .PP
    39     43   The following commands are supported in the \fIdefScript\fR for
    40     44   \fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
    41     45   .TP
    42     46   \fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
    43     47   .VS TIP478
    44     48   This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
................................................................................
    66     70   the constructor (defined using the same format as for the Tcl \fBproc\fR
    67     71   command) will be \fIargList\fR, and the body of the constructor will be
    68     72   \fIbodyScript\fR. When the body of the constructor is evaluated, the current
    69     73   namespace of the constructor will be a namespace that is unique to the object
    70     74   being constructed. Within the constructor, the \fBnext\fR command should be
    71     75   used to call the superclasses' constructors. If \fIbodyScript\fR is the empty
    72     76   string, the constructor will be deleted.
    73         -.TP
    74         -\fBdeletemethod\fI name\fR ?\fIname ...\fR?
    75         -.
    76         -This deletes each of the methods called \fIname\fR from a class. The methods
    77         -must have previously existed in that class. Does not affect the superclasses
    78         -of the class, nor does it affect the subclasses or instances of the class
    79         -(except when they have a call chain through the class being modified).
           77  +.RS
           78  +.PP
           79  +Classes do not need to have a constructor defined. If none is specified, the
           80  +superclass's constructor will be used instead.
           81  +.RE
    80     82   .TP
    81     83   \fBdestructor\fI bodyScript\fR
    82     84   .
    83     85   This creates or updates the destructor for a class. Destructors take no
    84     86   arguments, and the body of the destructor will be \fIbodyScript\fR. The
    85     87   destructor is called when objects of the class are deleted, and when called
    86     88   will have the object's unique namespace as the current namespace. Destructors
................................................................................
    98    100   .
    99    101   This arranges for each of the named methods, \fIname\fR, to be exported
   100    102   (i.e. usable outside an instance through the instance object's command) by the
   101    103   class being defined. Note that the methods themselves may be actually defined
   102    104   by a superclass; subclass exports override superclass visibility, and may in
   103    105   turn be overridden by instances.
   104    106   .TP
   105         -\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
   106         -.
   107         -This slot (see \fBSLOTTED DEFINITIONS\fR below)
   108         -sets or updates the list of method names that are used to guard whether
   109         -method call to instances of the class may be called and what the method's
   110         -results are. Each \fImethodName\fR names a single filtering method (which may
   111         -be exposed or not exposed); it is not an error for a non-existent method to be
   112         -named since they may be defined by subclasses.
   113         -By default, this slot works by appending.
   114         -.TP
   115    107   \fBforward\fI name cmdName \fR?\fIarg ...\fR?
   116    108   .
   117    109   This creates or updates a forwarded method called \fIname\fR. The method is
   118    110   defined be forwarded to the command called \fIcmdName\fR, with additional
   119    111   arguments, \fIarg\fR etc., added before those arguments specified by the
   120    112   caller of the method. The \fIcmdName\fR will always be resolved using the
   121    113   rules of the invoking objects' namespaces, i.e., when \fIcmdName\fR is not
................................................................................
   155    147   .PP
   156    148   .VS TIP500
   157    149   If in a private definition context (see the \fBprivate\fR definition command,
   158    150   below), this command creates private procedure-like methods.
   159    151   .VE TIP500
   160    152   .RE
   161    153   .TP
   162         -\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
   163         -.
   164         -This slot (see \fBSLOTTED DEFINITIONS\fR below)
   165         -sets or updates the list of additional classes that are to be mixed into
   166         -all the instances of the class being defined. Each \fIclassName\fR argument
   167         -names a single class that is to be mixed in.
   168         -By default, this slot works by replacement.
   169         -.TP
   170    154   \fBprivate \fIcmd arg...\fR
   171    155   .TP
   172    156   \fBprivate \fIscript\fR
   173    157   .
   174    158   .VS TIP500
   175    159   This evaluates the \fIscript\fR (or the list of command and arguments given by
   176    160   \fIcmd\fR and \fIarg\fRs) in a context where the definitions made on the
................................................................................
   182    166   \fBprivate\fR inside \fBprivate\fR has no cumulative effect; the innermost
   183    167   definition context is just a private definition context. All other definition
   184    168   commands have no difference in behavior when used in a private definition
   185    169   context.
   186    170   .RE
   187    171   .VE TIP500
   188    172   .TP
   189         -\fBrenamemethod\fI fromName toName\fR
   190         -.
   191         -This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
   192         -method must have previously existed in the class, and \fItoName\fR must not
   193         -previously refer to a method in that class. Does not affect the superclasses
   194         -of the class, nor does it affect the subclasses or instances of the class
   195         -(except when they have a call chain through the class being modified). Does
   196         -not change the export status of the method; if it was exported before, it will
   197         -be afterwards.
   198         -.TP
   199    173   \fBself\fI subcommand arg ...\fR
   200    174   .TP
   201    175   \fBself\fI script\fR
   202    176   .TP
   203    177   \fBself\fR
   204    178   .
   205    179   This command is equivalent to calling \fBoo::objdefine\fR on the class being
................................................................................
   265    239   instance object is different to the name given in the definition; the name
   266    240   used in the definition is the name that you use to access the variable within
   267    241   the methods of this class, and the name of the variable in the instance
   268    242   namespace has a unique prefix that makes accidental use from other classes
   269    243   extremely unlikely.
   270    244   .VE TIP500
   271    245   .RE
   272         -.SS "CONFIGURING OBJECTS"
          246  +.SS "ADVANCED CLASS CONFIGURATION OPTIONS"
          247  +.PP
          248  +The following definitions are also supported, but are not required in simple
          249  +programs:
          250  +.TP
          251  +\fBdefinitionnamespace\fR ?\fIkind\fR? \fInamespaceName\fR
          252  +.VS TIP524
          253  +This allows control over what namespace will be used by the \fBoo::define\fR
          254  +and \fBoo::objdefine\fR commands to look up the definition commands they
          255  +use. When any object has a definition operation applied to it, \fIthe class that
          256  +it is an instance of\fR (and its superclasses and mixins) is consulted for
          257  +what definition namespace to use. \fBoo::define\fR gets the class definition
          258  +namespace, and \fB::oo::objdefine\fR gets the instance definition namespace,
          259  +but both otherwise use the identical lookup operation.
          260  +.RS
          261  +.PP
          262  +This sets the definition namespace of kind \fIkind\fR provided by the current
          263  +class to \fInamespaceName\fR. The \fInamespaceName\fR must refer to a
          264  +currently existing namespace, or must be the empty string (to stop the current
          265  +class from having such a namespace connected). The \fIkind\fR, if supplied,
          266  +must be either \fB\-class\fR (the default) or \fB\-instance\fR to specify the
          267  +whether the namespace for use with \fBoo::define\fR or \fBoo::objdefine\fR
          268  +respectively is being set.
          269  +.PP
          270  +The class \fBoo::object\fR has its instance namespace locked to
          271  +\fB::oo::objdefine\fR, and the class \fBoo::class\fR has its class namespace
          272  +locked to \fB::oo::define\fR. A consequence of this is that effective use of
          273  +this feature for classes requires the definition of a metaclass.
          274  +.RE
          275  +.VE TIP524
          276  +.TP
          277  +\fBdeletemethod\fI name\fR ?\fIname ...\fR?
          278  +.
          279  +This deletes each of the methods called \fIname\fR from a class. The methods
          280  +must have previously existed in that class. Does not affect the superclasses
          281  +of the class, nor does it affect the subclasses or instances of the class
          282  +(except when they have a call chain through the class being modified).
          283  +.TP
          284  +\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
          285  +.
          286  +This slot (see \fBSLOTTED DEFINITIONS\fR below)
          287  +sets or updates the list of method names that are used to guard whether
          288  +method call to instances of the class may be called and what the method's
          289  +results are. Each \fImethodName\fR names a single filtering method (which may
          290  +be exposed or not exposed); it is not an error for a non-existent method to be
          291  +named since they may be defined by subclasses.
          292  +By default, this slot works by appending.
          293  +.TP
          294  +\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
          295  +.
          296  +This slot (see \fBSLOTTED DEFINITIONS\fR below)
          297  +sets or updates the list of additional classes that are to be mixed into
          298  +all the instances of the class being defined. Each \fIclassName\fR argument
          299  +names a single class that is to be mixed in.
          300  +By default, this slot works by replacement.
          301  +.TP
          302  +\fBrenamemethod\fI fromName toName\fR
          303  +.
          304  +This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
          305  +method must have previously existed in the class, and \fItoName\fR must not
          306  +previously refer to a method in that class. Does not affect the superclasses
          307  +of the class, nor does it affect the subclasses or instances of the class
          308  +(except when they have a call chain through the class being modified). Does
          309  +not change the export status of the method; if it was exported before, it will
          310  +be afterwards.
          311  +.SH "CONFIGURING OBJECTS"
   273    312   .PP
   274    313   The following commands are supported in the \fIdefScript\fR for
   275    314   \fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
   276    315   form:
   277    316   .TP
   278         -\fBclass\fI className\fR
   279         -.
   280         -This allows the class of an object to be changed after creation. Note that the
   281         -class's constructors are not called when this is done, and so the object may
   282         -well be in an inconsistent state unless additional configuration work is done.
   283         -.TP
   284         -\fBdeletemethod\fI name\fR ?\fIname ...\fR
   285         -.
   286         -This deletes each of the methods called \fIname\fR from an object. The methods
   287         -must have previously existed in that object. Does not affect the classes that
   288         -the object is an instance of.
   289         -.TP
   290    317   \fBexport\fI name \fR?\fIname ...\fR?
   291    318   .
   292    319   This arranges for each of the named methods, \fIname\fR, to be exported
   293    320   (i.e. usable outside the object through the object's command) by the object
   294    321   being defined. Note that the methods themselves may be actually defined by a
   295    322   class or superclass; object exports override class visibility.
   296    323   .TP
   297         -\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
   298         -.
   299         -This slot (see \fBSLOTTED DEFINITIONS\fR below)
   300         -sets or updates the list of method names that are used to guard whether a
   301         -method call to the object may be called and what the method's results are.
   302         -Each \fImethodName\fR names a single filtering method (which may be exposed or
   303         -not exposed); it is not an error for a non-existent method to be named. Note
   304         -that the actual list of filters also depends on the filters set upon any
   305         -classes that the object is an instance of.
   306         -By default, this slot works by appending.
   307         -.TP
   308    324   \fBforward\fI name cmdName \fR?\fIarg ...\fR?
   309    325   .
   310    326   This creates or updates a forwarded object method called \fIname\fR. The
   311    327   method is defined be forwarded to the command called \fIcmdName\fR, with
   312    328   additional arguments, \fIarg\fR etc., added before those arguments specified
   313    329   by the caller of the method. Forwarded methods should be deleted using the
   314    330   \fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
................................................................................
   359    375   \fBforward\fR, \fBmethod\fR, and \fBvariable\fR. Nesting \fBprivate\fR inside
   360    376   \fBprivate\fR has no cumulative effect; the innermost definition context is
   361    377   just a private definition context. All other definition commands have no
   362    378   difference in behavior when used in a private definition context.
   363    379   .RE
   364    380   .VE TIP500
   365    381   .TP
   366         -\fBrenamemethod\fI fromName toName\fR
   367         -.
   368         -This renames the method called \fIfromName\fR in an object to \fItoName\fR.
   369         -The method must have previously existed in the object, and \fItoName\fR must
   370         -not previously refer to a method in that object. Does not affect the classes
   371         -that the object is an instance of. Does not change the export status of the
   372         -method; if it was exported before, it will be afterwards.
   373         -.TP
   374         -\fBself \fR
   375         -.VS TIP470
   376         -This gives the name of the object currently being configured.
   377         -.VE TIP470
   378         -.TP
   379    382   \fBunexport\fI name \fR?\fIname ...\fR?
   380    383   .
   381    384   This arranges for each of the named methods, \fIname\fR, to be not exported
   382    385   (i.e. not usable outside the object through the object's command, but instead
   383    386   just through the \fBmy\fR command visible in the object's context) by the
   384    387   object being defined. Note that the methods themselves may be actually defined
   385    388   by a class; instance unexports override class visibility.
................................................................................
   404    407   instance object is different to the name given in the definition; the name
   405    408   used in the definition is the name that you use to access the variable within
   406    409   the methods of this instance object, and the name of the variable in the
   407    410   instance namespace has a unique prefix that makes accidental use from
   408    411   superclass methods extremely unlikely.
   409    412   .VE TIP500
   410    413   .RE
          414  +.SS "ADVANCED OBJECT CONFIGURATION OPTIONS"
          415  +.PP
          416  +The following definitions are also supported, but are not required in simple
          417  +programs:
          418  +.TP
          419  +\fBclass\fI className\fR
          420  +.
          421  +This allows the class of an object to be changed after creation. Note that the
          422  +class's constructors are not called when this is done, and so the object may
          423  +well be in an inconsistent state unless additional configuration work is done.
          424  +.TP
          425  +\fBdeletemethod\fI name\fR ?\fIname ...\fR
          426  +.
          427  +This deletes each of the methods called \fIname\fR from an object. The methods
          428  +must have previously existed in that object. Does not affect the classes that
          429  +the object is an instance of.
          430  +.TP
          431  +\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
          432  +.
          433  +This slot (see \fBSLOTTED DEFINITIONS\fR below)
          434  +sets or updates the list of method names that are used to guard whether a
          435  +method call to the object may be called and what the method's results are.
          436  +Each \fImethodName\fR names a single filtering method (which may be exposed or
          437  +not exposed); it is not an error for a non-existent method to be named. Note
          438  +that the actual list of filters also depends on the filters set upon any
          439  +classes that the object is an instance of.
          440  +By default, this slot works by appending.
          441  +.TP
          442  +\fBrenamemethod\fI fromName toName\fR
          443  +.
          444  +This renames the method called \fIfromName\fR in an object to \fItoName\fR.
          445  +The method must have previously existed in the object, and \fItoName\fR must
          446  +not previously refer to a method in that object. Does not affect the classes
          447  +that the object is an instance of. Does not change the export status of the
          448  +method; if it was exported before, it will be afterwards.
          449  +.TP
          450  +\fBself \fR
          451  +.VS TIP470
          452  +This gives the name of the object currently being configured.
          453  +.VE TIP470
   411    454   .SH "PRIVATE METHODS"
   412    455   .VS TIP500
   413    456   When a class or instance has a private method, that private method can only be
   414    457   invoked from within methods of that class or instance. Other callers of the
   415    458   object's methods \fIcannot\fR invoke private methods, it is as if the private
   416    459   methods do not exist. However, a private method of a class \fIcan\fR be
   417    460   invoked from the class's methods when those methods are being used on another
................................................................................
   655    698           \fI\(-> DB: delete row ::oo::Obj123\fR
   656    699   set g [Group find "groupname=webadmins"]
   657    700           \fI\(-> DB: locate row ::Group with groupname=webadmins\fR
   658    701   $g update "emailaddress=admins"
   659    702           \fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
   660    703   .CE
   661    704   .VE TIP478
          705  +.PP
          706  +.VS TIP524
          707  +This example shows how to make a custom definition for a class. Note that it
          708  +explicitly includes delegation to the existing definition commands via
          709  +\fBnamespace path\fR.
          710  +.PP
          711  +.CS
          712  +namespace eval myDefinitions {
          713  +    # Delegate to existing definitions where not overridden
          714  +    namespace path \fB::oo::define\fR
          715  +
          716  +    # A custom type of method
          717  +    proc exprmethod {name arguments body} {
          718  +        tailcall \fBmethod\fR $name $arguments [list expr $body]
          719  +    }
          720  +
          721  +    # A custom way of building a constructor
          722  +    proc parameters args {
          723  +        uplevel 1 [list \fBvariable\fR {*}$args]
          724  +        set body [join [lmap a $args {
          725  +            string map [list VAR $a] {
          726  +                set [my varname VAR] [expr {double($VAR)}]
          727  +            }
          728  +        }] ";"]
          729  +        tailcall \fBconstructor\fR $args $body
          730  +    }
          731  +}
          732  +
          733  +# Bind the namespace into a (very simple) metaclass for use
          734  +oo::class create exprclass {
          735  +    \fBsuperclass\fR oo::class
          736  +    \fBdefinitionnamespace\fR myDefinitions
          737  +}
          738  +
          739  +# Use the custom definitions
          740  +exprclass create quadratic {
          741  +    parameters a b c
          742  +    exprmethod evaluate {x} {
          743  +        ($a * $x**2) + ($b * $x) + $c
          744  +    }
          745  +}
          746  +
          747  +# Showing the resulting class and object in action
          748  +quadratic create quad 1 2 3
          749  +for {set x 0} {$x <= 4} {incr x} {
          750  +    puts [format "quad(%d) = %.2f" $x [quad evaluate $x]]
          751  +}
          752  +        \fI\(-> quad(0) = 3.00\fR
          753  +        \fI\(-> quad(1) = 6.00\fR
          754  +        \fI\(-> quad(2) = 11.00\fR
          755  +        \fI\(-> quad(3) = 18.00\fR
          756  +        \fI\(-> quad(4) = 27.00\fR
          757  +.CE
          758  +.VE TIP524
   662    759   .SH "SEE ALSO"
   663    760   next(n), oo::class(n), oo::object(n)
   664    761   .SH KEYWORDS
   665    762   class, definition, method, object, slot
   666    763   .\" Local variables:
   667    764   .\" mode: nroff
   668    765   .\" fill-column: 78
   669    766   .\" End:

Changes to doc/info.n.

   476    476   \fBinfo class definition\fI class method\fR
   477    477   .
   478    478   This subcommand returns a description of the definition of the method named
   479    479   \fImethod\fR of class \fIclass\fR. The definition is described as a two element
   480    480   list; the first element is the list of arguments to the method in a form
   481    481   suitable for passing to another call to \fBproc\fR or a method definition, and
   482    482   the second element is the body of the method.
          483  +.TP
          484  +\fBinfo class definitionnamespace\fI class\fR ?\fIkind\fR?
          485  +.VS TIP524
          486  +This subcommand returns the definition namespace for \fIkind\fR definitions of
          487  +the class \fIclass\fR; the definition namespace only affects the instances of
          488  +\fIclass\fR, not \fIclass\fR itself. The \fIkind\fR can be either
          489  +\fB\-class\fR to return the definition namespace used for \fBoo::define\fR, or
          490  +\fB\-instance\fR to return the definition namespace used for
          491  +\fBoo::objdefine\fR; the \fB\-class\fR kind is default (though this is only
          492  +actually useful on classes that are subclasses of \fBoo::class\fR).
          493  +.RS
          494  +.PP
          495  +If \fIclass\fR does not provide a definition namespace of the specified kind,
          496  +this command returns the empty string. In those circumstances, the
          497  +\fBoo::define\fR and \fBoo::objdefine\fR commands look up which definition
          498  +namespace to use using the class inheritance hierarchy.
          499  +.RE
          500  +.VE TIP524
   483    501   .TP
   484    502   \fBinfo class destructor\fI class\fR
   485    503   .
   486    504   This subcommand returns the body of the destructor of class \fIclass\fR. If no
   487    505   destructor is present, this returns the empty string.
   488    506   .TP
   489    507   \fBinfo class filters\fI class\fR

Changes to generic/tclOO.c.

    22     22   
    23     23   static const struct {
    24     24       const char *name;
    25     25       Tcl_ObjCmdProc *objProc;
    26     26       int flag;
    27     27   } defineCmds[] = {
    28     28       {"constructor", TclOODefineConstructorObjCmd, 0},
           29  +    {"definitionnamespace", TclOODefineDefnNsObjCmd, 0},
    29     30       {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
    30     31       {"destructor", TclOODefineDestructorObjCmd, 0},
    31     32       {"export", TclOODefineExportObjCmd, 0},
    32     33       {"forward", TclOODefineForwardObjCmd, 0},
    33     34       {"method", TclOODefineMethodObjCmd, 0},
    34     35       {"private", TclOODefinePrivateObjCmd, 0},
    35     36       {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
................................................................................
   441    442   static void
   442    443   InitClassSystemRoots(
   443    444       Tcl_Interp *interp,
   444    445       Foundation *fPtr)
   445    446   {
   446    447       Class fakeCls;
   447    448       Object fakeObject;
          449  +    Tcl_Obj *defNsName;
   448    450   
   449    451       /* Stand up a phony class for bootstrapping. */
   450    452       fPtr->objectCls = &fakeCls;
   451    453       /* referenced in TclOOAllocClass to increment the refCount. */
   452    454       fakeCls.thisPtr = &fakeObject;
   453    455   
   454    456       fPtr->objectCls = TclOOAllocClass(interp,
   455    457   	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
   456    458       /* Corresponding TclOODecrRefCount in KillFoudation */
   457    459       AddRef(fPtr->objectCls->thisPtr);
   458    460   
   459         -    /* This is why it is unnecessary in this routine to replace the
          461  +    /*
          462  +     * This is why it is unnecessary in this routine to replace the
   460    463        * incremented reference count of fPtr->objectCls that was swallowed by
   461         -     * fakeObject. */
          464  +     * fakeObject.
          465  +     */
          466  +
   462    467       fPtr->objectCls->superclasses.num = 0;
   463    468       ckfree(fPtr->objectCls->superclasses.list);
   464    469       fPtr->objectCls->superclasses.list = NULL;
   465    470   
   466         -    /* special initialization for the primordial objects */
          471  +    /*
          472  +     * Special initialization for the primordial objects.
          473  +     */
          474  +
   467    475       fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
   468    476       fPtr->objectCls->flags |= ROOT_OBJECT;
          477  +    TclNewLiteralStringObj(defNsName, "::oo::objdefine");
          478  +    fPtr->objectCls->objDefinitionNs = defNsName;
          479  +    Tcl_IncrRefCount(defNsName);
   469    480   
   470    481       fPtr->classCls = TclOOAllocClass(interp,
   471    482   	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
   472    483       /* Corresponding TclOODecrRefCount in KillFoudation */
   473    484       AddRef(fPtr->classCls->thisPtr);
   474    485   
   475    486       /*
................................................................................
   476    487        * Increment reference counts for each reference because these
   477    488        * relationships can be dynamically changed.
   478    489        *
   479    490        * Corresponding TclOODecrRefCount for all incremented refcounts is in
   480    491        * KillFoundation.
   481    492        */
   482    493   
   483         -    /* Rewire bootstrapped objects. */
          494  +    /*
          495  +     * Rewire bootstrapped objects.
          496  +     */
          497  +
   484    498       fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
   485    499       AddRef(fPtr->classCls->thisPtr);
   486    500       TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
   487    501   
   488    502       fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
   489    503       AddRef(fPtr->classCls->thisPtr);
   490    504       TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
   491    505   
   492    506       fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
   493    507       fPtr->classCls->flags |= ROOT_CLASS;
          508  +    TclNewLiteralStringObj(defNsName, "::oo::define");
          509  +    fPtr->classCls->clsDefinitionNs = defNsName;
          510  +    Tcl_IncrRefCount(defNsName);
   494    511   
   495    512       /* Standard initialization for new Objects */
   496    513       TclOOAddToSubclasses(fPtr->classCls, fPtr->objectCls);
   497    514   
   498    515       /*
   499    516        * THIS IS THE ONLY FUNCTION THAT DOES NON-STANDARD CLASS SPLICING.
   500    517        * Everything else is careful to prohibit looping.
................................................................................
   953    970   	    Tcl_Panic("deleting class structure for non-deleted %s",
   954    971   		    "::oo::class");
   955    972   	} else if (IsRootObject(oPtr)) {
   956    973   	    Tcl_Panic("deleting class structure for non-deleted %s",
   957    974   		    "::oo::object");
   958    975   	}
   959    976       }
          977  +
          978  +    /*
          979  +     * Stop using the class for definition information.
          980  +     */
          981  +
          982  +    if (clsPtr->clsDefinitionNs) {
          983  +	Tcl_DecrRefCount(clsPtr->clsDefinitionNs);
          984  +	clsPtr->clsDefinitionNs = NULL;
          985  +    }
          986  +    if (clsPtr->objDefinitionNs) {
          987  +	Tcl_DecrRefCount(clsPtr->objDefinitionNs);
          988  +	clsPtr->objDefinitionNs = NULL;
          989  +    }
   960    990   
   961    991       /*
   962    992        * Squelch method implementation chain caches.
   963    993        */
   964    994   
   965    995       if (clsPtr->constructorChainPtr) {
   966    996   	TclOODeleteChain(clsPtr->constructorChainPtr);

Changes to generic/tclOOCall.c.

    26     26       int filterLength;		/* Number of entries in the call chain that
    27     27   				 * are due to processing filters and not the
    28     28   				 * main call chain. */
    29     29       Object *oPtr;		/* The object that we are building the chain
    30     30   				 * for. */
    31     31   };
    32     32   
           33  +/*
           34  + * Structures used for traversing the class hierarchy to find out where
           35  + * definitions are supposed to be done.
           36  + */
           37  +
           38  +typedef struct {
           39  +    Class *definerCls;
           40  +    Tcl_Obj *namespaceName;
           41  +} DefineEntry;
           42  +
           43  +typedef struct {
           44  +    DefineEntry *list;
           45  +    int num;
           46  +    int size;
           47  +} DefineChain;
           48  +
    33     49   /*
    34     50    * Extra flags used for call chain management.
    35     51    */
    36     52   
    37     53   #define DEFINITE_PROTECTED 0x100000
    38     54   #define DEFINITE_PUBLIC    0x200000
    39     55   #define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
................................................................................
    73     89   
    74     90   static void		AddClassFiltersToCallContext(Object *const oPtr,
    75     91   			    Class *clsPtr, struct ChainBuilder *const cbPtr,
    76     92   			    Tcl_HashTable *const doneFilters, int flags);
    77     93   static void		AddClassMethodNames(Class *clsPtr, const int flags,
    78     94   			    Tcl_HashTable *const namesPtr,
    79     95   			    Tcl_HashTable *const examinedClassesPtr);
           96  +static inline void	AddDefinitionNamespaceToChain(Class *const definerCls,
           97  +			    Tcl_Obj *const namespaceName,
           98  +			    DefineChain *const definePtr, const int flags);
    80     99   static inline void	AddMethodToCallChain(Method *const mPtr,
    81    100   			    struct ChainBuilder *const cbPtr,
    82    101   			    Tcl_HashTable *const doneFilters,
    83    102   			    Class *const filterDecl, int flags);
    84    103   static inline int	AddInstancePrivateToCallContext(Object *const oPtr,
    85    104   			    Tcl_Obj *const methodNameObj,
    86    105   			    struct ChainBuilder *const cbPtr, int flags);
................................................................................
   101    120   			    Tcl_HashTable *const doneFilters, int flags,
   102    121   			    Class *const filterDecl);
   103    122   static int		AddSimpleClassChainToCallContext(Class *classPtr,
   104    123   			    Tcl_Obj *const methodNameObj,
   105    124   			    struct ChainBuilder *const cbPtr,
   106    125   			    Tcl_HashTable *const doneFilters, int flags,
   107    126   			    Class *const filterDecl);
          127  +static void		AddSimpleClassDefineNamespaces(Class *classPtr,
          128  +			    DefineChain *const definePtr, int flags);
          129  +static inline void	AddSimpleDefineNamespaces(Object *const oPtr,
          130  +			    DefineChain *const definePtr, int flags);
   108    131   static int		CmpStr(const void *ptr1, const void *ptr2);
   109    132   static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
   110    133   static Tcl_NRPostProc	FinalizeMethodRefs;
   111    134   static void		FreeMethodNameRep(Tcl_Obj *objPtr);
   112    135   static inline int	IsStillValid(CallChain *callPtr, Object *oPtr,
   113    136   			    int flags, int reuseMask);
   114    137   static Tcl_NRPostProc	ResetFilterFlags;
................................................................................
  1830   1853        * Finish building the description and return it.
  1831   1854        */
  1832   1855   
  1833   1856       resultObj = Tcl_NewListObj(callPtr->numChain, objv);
  1834   1857       TclStackFree(interp, objv);
  1835   1858       return resultObj;
  1836   1859   }
         1860  +
         1861  +/*
         1862  + * ----------------------------------------------------------------------
         1863  + *
         1864  + * TclOOGetDefineContextNamespace --
         1865  + *
         1866  + *	Responsible for determining which namespace to use for definitions.
         1867  + *	This is done by building a define chain, which models (strongly!) the
         1868  + *	way that a call chain works but with a different internal model.
         1869  + *
         1870  + *	Then it walks the chain to find the first namespace name that actually
         1871  + *	resolves to an existing namespace.
         1872  + *
         1873  + * Returns:
         1874  + *	Name of namespace, or NULL if none can be found. Note that this
         1875  + *	function does *not* set an error message in the interpreter on failure.
         1876  + *
         1877  + * ----------------------------------------------------------------------
         1878  + */
         1879  +
         1880  +#define DEFINE_CHAIN_STATIC_SIZE 4 /* Enough space to store most cases. */
         1881  +
         1882  +Tcl_Namespace *
         1883  +TclOOGetDefineContextNamespace(
         1884  +    Tcl_Interp *interp,		/* In what interpreter should namespace names
         1885  +				 * actually be resolved. */
         1886  +    Object *oPtr,		/* The object to get the context for. */
         1887  +    int forClass)		/* What sort of context are we looking for.
         1888  +				 * If true, we are going to use this for
         1889  +				 * [oo::define], otherwise, we are going to
         1890  +				 * use this for [oo::objdefine]. */
         1891  +{
         1892  +    DefineChain define;
         1893  +    DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
         1894  +    DefineEntry *entryPtr;
         1895  +    Tcl_Namespace *nsPtr = NULL;
         1896  +    int i;
         1897  +
         1898  +    define.list = staticSpace;
         1899  +    define.num = 0;
         1900  +    define.size = DEFINE_CHAIN_STATIC_SIZE;
         1901  +
         1902  +    /*
         1903  +     * Add the actual define locations. We have to do this twice to handle
         1904  +     * class mixins right.
         1905  +     */
         1906  +
         1907  +    AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
         1908  +    AddSimpleDefineNamespaces(oPtr, &define, forClass);
         1909  +
         1910  +    /*
         1911  +     * Go through the list until we find a namespace whose name we can
         1912  +     * resolve.
         1913  +     */
         1914  +
         1915  +    FOREACH_STRUCT(entryPtr, define) {
         1916  +	if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
         1917  +		&nsPtr) == TCL_OK) {
         1918  +	    break;
         1919  +	}
         1920  +	Tcl_ResetResult(interp);
         1921  +    }
         1922  +    if (define.list != staticSpace) {
         1923  +	ckfree(define.list);
         1924  +    }
         1925  +    return nsPtr;
         1926  +}
         1927  +
         1928  +/*
         1929  + * ----------------------------------------------------------------------
         1930  + *
         1931  + * AddSimpleDefineNamespaces --
         1932  + *
         1933  + *	Adds to the definition chain all the definitions provided by an
         1934  + *	object's class and its mixins, taking into account everything they
         1935  + *	inherit from.
         1936  + *
         1937  + * ----------------------------------------------------------------------
         1938  + */
         1939  +
         1940  +static inline void
         1941  +AddSimpleDefineNamespaces(
         1942  +    Object *const oPtr,		/* Object to add define chain entries for. */
         1943  +    DefineChain *const definePtr,
         1944  +				/* Where to add the define chain entries. */
         1945  +    int flags)			/* What sort of define chain are we
         1946  +				 * building. */
         1947  +{
         1948  +    Class *mixinPtr;
         1949  +    int i;
         1950  +
         1951  +    FOREACH(mixinPtr, oPtr->mixins) {
         1952  +	AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
         1953  +		flags | TRAVERSED_MIXIN);
         1954  +    }
         1955  +
         1956  +    AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);
         1957  +}
         1958  +
         1959  +/*
         1960  + * ----------------------------------------------------------------------
         1961  + *
         1962  + * AddSimpleClassDefineNamespaces --
         1963  + *
         1964  + *	Adds to the definition chain all the definitions provided by a class
         1965  + *	and its superclasses and its class mixins.
         1966  + *
         1967  + * ----------------------------------------------------------------------
         1968  + */
         1969  +
         1970  +static void
         1971  +AddSimpleClassDefineNamespaces(
         1972  +    Class *classPtr,		/* Class to add the define chain entries for. */
         1973  +    DefineChain *const definePtr,
         1974  +				/* Where to add the define chain entries. */
         1975  +    int flags)			/* What sort of define chain are we
         1976  +				 * building. */
         1977  +{
         1978  +    int i;
         1979  +    Class *superPtr;
         1980  +
         1981  +    /*
         1982  +     * We hard-code the tail-recursive form. It's by far the most common case
         1983  +     * *and* it is much more gentle on the stack.
         1984  +     */
         1985  +
         1986  +  tailRecurse:
         1987  +    FOREACH(superPtr, classPtr->mixins) {
         1988  +	AddSimpleClassDefineNamespaces(superPtr, definePtr,
         1989  +		flags | TRAVERSED_MIXIN);
         1990  +    }
         1991  +
         1992  +    if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
         1993  +	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
         1994  +		definePtr, flags);
         1995  +    } else {
         1996  +	AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
         1997  +		definePtr, flags);
         1998  +    }	
         1999  +
         2000  +    switch (classPtr->superclasses.num) {
         2001  +    case 1:
         2002  +	classPtr = classPtr->superclasses.list[0];
         2003  +	goto tailRecurse;
         2004  +    default:
         2005  +	FOREACH(superPtr, classPtr->superclasses) {
         2006  +	    AddSimpleClassDefineNamespaces(superPtr, definePtr, flags);
         2007  +	}
         2008  +    case 0:
         2009  +	return;
         2010  +    }
         2011  +}
         2012  +
         2013  +/*
         2014  + * ----------------------------------------------------------------------
         2015  + *
         2016  + * AddDefinitionNamespaceToChain --
         2017  + *
         2018  + *	Adds a single item to the definition chain (if it is meaningful),
         2019  + *	reallocating the space for the chain if necessary.
         2020  + *
         2021  + * ----------------------------------------------------------------------
         2022  + */
         2023  +
         2024  +static inline void
         2025  +AddDefinitionNamespaceToChain(
         2026  +    Class *definerCls,		/* What class defines this entry. */
         2027  +    Tcl_Obj *namespaceName,	/* The name for this entry (or NULL, a
         2028  +				 * no-op). */
         2029  +    DefineChain *const definePtr,
         2030  +				/* The define chain to add the method
         2031  +				 * implementation to. */
         2032  +    int flags)			/* Used to check if we're mixin-consistent
         2033  +				 * only. Mixin-consistent means that either
         2034  +				 * we're looking to add things from a mixin
         2035  +				 * and we have passed a mixin, or we're not
         2036  +				 * looking to add things from a mixin and have
         2037  +				 * not passed a mixin. */
         2038  +{
         2039  +    int i;
         2040  +
         2041  +    /*
         2042  +     * Return if this entry is blank. This is also where we enforce
         2043  +     * mixin-consistency.
         2044  +     */
         2045  +
         2046  +    if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
         2047  +	return;
         2048  +    }
         2049  +
         2050  +    /*
         2051  +     * First test whether the method is already in the call chain.
         2052  +     */
         2053  +
         2054  +    for (i=0 ; i<definePtr->num ; i++) {
         2055  +	if (definePtr->list[i].definerCls == definerCls) {
         2056  +	    /*
         2057  +	     * Call chain semantics states that methods come as *late* in the
         2058  +	     * call chain as possible. This is done by copying down the
         2059  +	     * following methods. Note that this does not change the number of
         2060  +	     * method invocations in the call chain; it just rearranges them.
         2061  +	     *
         2062  +	     * We skip changing anything if the place we found was already at
         2063  +	     * the end of the list.
         2064  +	     */
         2065  +
         2066  +	    if (i < definePtr->num - 1) {
         2067  +		memmove(&definePtr->list[i], &definePtr->list[i + 1],
         2068  +			sizeof(DefineEntry) * (definePtr->num - i - 1));
         2069  +		definePtr->list[i].definerCls = definerCls;
         2070  +		definePtr->list[i].namespaceName = namespaceName;
         2071  +	    }
         2072  +	    return;
         2073  +	}
         2074  +    }
         2075  +
         2076  +    /*
         2077  +     * Need to really add the define. This is made a bit more complex by the
         2078  +     * fact that we are using some "static" space initially, and only start
         2079  +     * realloc-ing if the chain gets long.
         2080  +     */
         2081  +
         2082  +    if (definePtr->num == definePtr->size) {
         2083  +	definePtr->size *= 2;
         2084  +	if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
         2085  +	    DefineEntry *staticList = definePtr->list;
         2086  +
         2087  +	    definePtr->list =
         2088  +		    ckalloc(sizeof(DefineEntry) * definePtr->size);
         2089  +	    memcpy(definePtr->list, staticList,
         2090  +		    sizeof(DefineEntry) * definePtr->num);
         2091  +	} else {
         2092  +	    definePtr->list = ckrealloc(definePtr->list,
         2093  +		    sizeof(DefineEntry) * definePtr->size);
         2094  +	}
         2095  +    }
         2096  +    definePtr->list[i].definerCls = definerCls;
         2097  +    definePtr->list[i].namespaceName = namespaceName;
         2098  +    definePtr->num++;
         2099  +}
  1837   2100   
  1838   2101   /*
  1839   2102    * Local Variables:
  1840   2103    * mode: c
  1841   2104    * c-basic-offset: 4
  1842   2105    * fill-column: 78
  1843   2106    * End:
  1844   2107    */

Changes to generic/tclOODefineCmds.c.

    59     59   static inline void	GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
    60     60   			    Tcl_Obj *savedNameObj, const char *typeOfSubject);
    61     61   static inline int	MagicDefinitionInvoke(Tcl_Interp *interp,
    62     62   			    Tcl_Namespace *nsPtr, int cmdIndex,
    63     63   			    int objc, Tcl_Obj *const *objv);
    64     64   static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
    65     65   			    Tcl_Obj *className, const char *errMsg);
           66  +static inline Tcl_Namespace *GetNamespaceInOuterContext(Tcl_Interp *interp,
           67  +			    Tcl_Obj *namespaceName);
    66     68   static inline int	InitDefineContext(Tcl_Interp *interp,
    67     69   			    Tcl_Namespace *namespacePtr, Object *oPtr,
    68     70   			    int objc, Tcl_Obj *const objv[]);
    69     71   static inline void	RecomputeClassCacheFlag(Object *oPtr);
    70     72   static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
    71     73   			    int useClass, Tcl_Obj *const fromPtr,
    72     74   			    Tcl_Obj *const toPtr);
................................................................................
   824    826       int objc,
   825    827       Tcl_Obj *const objv[])
   826    828   {
   827    829       CallFrame *framePtr, **framePtrPtr = &framePtr;
   828    830   
   829    831       if (namespacePtr == NULL) {
   830    832   	Tcl_SetObjResult(interp, Tcl_NewStringObj(
   831         -		"cannot process definitions; support namespace deleted",
   832         -		-1));
          833  +		"no definition namespace available", -1));
   833    834   	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
   834    835   	return TCL_ERROR;
   835    836       }
   836    837   
   837    838       /*
   838    839        * framePtrPtr is needed to satisfy GCC 3.3's strict aliasing rules.
   839    840        */
................................................................................
   884    885       }
   885    886       return object;
   886    887   }
   887    888   
   888    889   /*
   889    890    * ----------------------------------------------------------------------
   890    891    *
   891         - * GetClassInOuterContext --
          892  + * GetClassInOuterContext, GetNamespaceInOuterContext --
   892    893    *
   893         - *	Wrapper round Tcl_GetObjectFromObj to perform the lookup in the
   894         - *	context that called oo::define (or equivalent). Note that this may
   895         - *	have to go up multiple levels to get the level that we started doing
   896         - *	definitions at.
          894  + *	Wrappers round Tcl_GetObjectFromObj and TclGetNamespaceFromObj to
          895  + *	perform the lookup in the context that called oo::define (or
          896  + *	equivalent). Note that this may have to go up multiple levels to get
          897  + *	the level that we started doing definitions at.
   897    898    *
   898    899    * ----------------------------------------------------------------------
   899    900    */
   900    901   
   901    902   static inline Class *
   902    903   GetClassInOuterContext(
   903    904       Tcl_Interp *interp,
................................................................................
   924    925   	Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
   925    926   	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
   926    927   		TclGetString(className), NULL);
   927    928   	return NULL;
   928    929       }
   929    930       return oPtr->classPtr;
   930    931   }
          932  +
          933  +static inline Tcl_Namespace *
          934  +GetNamespaceInOuterContext(
          935  +    Tcl_Interp *interp,
          936  +    Tcl_Obj *namespaceName)
          937  +{
          938  +    Interp *iPtr = (Interp *) interp;
          939  +    Tcl_Namespace *nsPtr;
          940  +    int result;
          941  +    CallFrame *savedFramePtr = iPtr->varFramePtr;
          942  +
          943  +    while (iPtr->varFramePtr->isProcCallFrame == FRAME_IS_OO_DEFINE
          944  +	    || iPtr->varFramePtr->isProcCallFrame == PRIVATE_FRAME) {
          945  +	if (iPtr->varFramePtr->callerVarPtr == NULL) {
          946  +	    Tcl_Panic("getting outer context when already in global context");
          947  +	}
          948  +	iPtr->varFramePtr = iPtr->varFramePtr->callerVarPtr;
          949  +    }
          950  +    result = TclGetNamespaceFromObj(interp, namespaceName, &nsPtr);
          951  +    iPtr->varFramePtr = savedFramePtr;
          952  +    if (result != TCL_OK) {
          953  +	return NULL;
          954  +    }
          955  +    return nsPtr;
          956  +}
   931    957   
   932    958   /*
   933    959    * ----------------------------------------------------------------------
   934    960    *
   935    961    * GenerateErrorInfo --
   936    962    *
   937    963    *	Factored out code to generate part of the error trace messages.
................................................................................
  1049   1075   int
  1050   1076   TclOODefineObjCmd(
  1051   1077       ClientData clientData,
  1052   1078       Tcl_Interp *interp,
  1053   1079       int objc,
  1054   1080       Tcl_Obj *const *objv)
  1055   1081   {
  1056         -    Foundation *fPtr = TclOOGetFoundation(interp);
         1082  +    Tcl_Namespace *nsPtr;
  1057   1083       Object *oPtr;
  1058   1084       int result;
  1059   1085   
  1060   1086       if (objc < 3) {
  1061   1087   	Tcl_WrongNumArgs(interp, 1, objv, "className arg ?arg ...?");
  1062   1088   	return TCL_ERROR;
  1063   1089       }
................................................................................
  1064   1090   
  1065   1091       oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
  1066   1092       if (oPtr == NULL) {
  1067   1093   	return TCL_ERROR;
  1068   1094       }
  1069   1095       if (oPtr->classPtr == NULL) {
  1070   1096   	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
  1071         -		"%s does not refer to a class",TclGetString(objv[1])));
         1097  +		"%s does not refer to a class", TclGetString(objv[1])));
  1072   1098   	Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
  1073   1099   		TclGetString(objv[1]), NULL);
  1074   1100   	return TCL_ERROR;
  1075   1101       }
  1076   1102   
  1077   1103       /*
  1078   1104        * Make the oo::define namespace the current namespace and evaluate the
  1079   1105        * command(s).
  1080   1106        */
  1081   1107   
  1082         -    if (InitDefineContext(interp, fPtr->defineNs, oPtr, objc,objv) != TCL_OK){
         1108  +    nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 1);
         1109  +    if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
  1083   1110   	return TCL_ERROR;
  1084   1111       }
  1085   1112   
  1086   1113       AddRef(oPtr);
  1087   1114       if (objc == 3) {
  1088   1115   	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
  1089   1116   
................................................................................
  1091   1118   	result = TclEvalObjEx(interp, objv[2], 0,
  1092   1119   		((Interp *)interp)->cmdFramePtr, 2);
  1093   1120   	if (result == TCL_ERROR) {
  1094   1121   	    GenerateErrorInfo(interp, oPtr, objNameObj, "class");
  1095   1122   	}
  1096   1123   	TclDecrRefCount(objNameObj);
  1097   1124       } else {
  1098         -	result = MagicDefinitionInvoke(interp, fPtr->defineNs, 2, objc, objv);
         1125  +	result = MagicDefinitionInvoke(interp, nsPtr, 2, objc, objv);
  1099   1126       }
  1100   1127       TclOODecrRefCount(oPtr);
  1101   1128   
  1102   1129       /*
  1103   1130        * Restore the previous "current" namespace.
  1104   1131        */
  1105   1132   
................................................................................
  1124   1151   int
  1125   1152   TclOOObjDefObjCmd(
  1126   1153       ClientData clientData,
  1127   1154       Tcl_Interp *interp,
  1128   1155       int objc,
  1129   1156       Tcl_Obj *const *objv)
  1130   1157   {
  1131         -    Foundation *fPtr = TclOOGetFoundation(interp);
         1158  +    Tcl_Namespace *nsPtr;
  1132   1159       Object *oPtr;
  1133   1160       int result;
  1134   1161   
  1135   1162       if (objc < 3) {
  1136   1163   	Tcl_WrongNumArgs(interp, 1, objv, "objectName arg ?arg ...?");
  1137   1164   	return TCL_ERROR;
  1138   1165       }
................................................................................
  1143   1170       }
  1144   1171   
  1145   1172       /*
  1146   1173        * Make the oo::objdefine namespace the current namespace and evaluate the
  1147   1174        * command(s).
  1148   1175        */
  1149   1176   
  1150         -    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
         1177  +    nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
         1178  +    if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
  1151   1179   	return TCL_ERROR;
  1152   1180       }
  1153   1181   
  1154   1182       AddRef(oPtr);
  1155   1183       if (objc == 3) {
  1156   1184   	Tcl_Obj *objNameObj = TclOOObjectName(interp, oPtr);
  1157   1185   
................................................................................
  1159   1187   	result = TclEvalObjEx(interp, objv[2], 0,
  1160   1188   		((Interp *)interp)->cmdFramePtr, 2);
  1161   1189   	if (result == TCL_ERROR) {
  1162   1190   	    GenerateErrorInfo(interp, oPtr, objNameObj, "object");
  1163   1191   	}
  1164   1192   	TclDecrRefCount(objNameObj);
  1165   1193       } else {
  1166         -	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 2, objc, objv);
         1194  +	result = MagicDefinitionInvoke(interp, nsPtr, 2, objc, objv);
  1167   1195       }
  1168   1196       TclOODecrRefCount(oPtr);
  1169   1197   
  1170   1198       /*
  1171   1199        * Restore the previous "current" namespace.
  1172   1200        */
  1173   1201   
................................................................................
  1192   1220   int
  1193   1221   TclOODefineSelfObjCmd(
  1194   1222       ClientData clientData,
  1195   1223       Tcl_Interp *interp,
  1196   1224       int objc,
  1197   1225       Tcl_Obj *const *objv)
  1198   1226   {
  1199         -    Foundation *fPtr = TclOOGetFoundation(interp);
         1227  +    Tcl_Namespace *nsPtr;
  1200   1228       Object *oPtr;
  1201   1229       int result, private;
  1202   1230   
  1203   1231       oPtr = (Object *) TclOOGetDefineCmdContext(interp);
  1204   1232       if (oPtr == NULL) {
  1205   1233   	return TCL_ERROR;
  1206   1234       }
................................................................................
  1213   1241       private = IsPrivateDefine(interp);
  1214   1242   
  1215   1243       /*
  1216   1244        * Make the oo::objdefine namespace the current namespace and evaluate the
  1217   1245        * command(s).
  1218   1246        */
  1219   1247   
  1220         -    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
         1248  +    nsPtr = TclOOGetDefineContextNamespace(interp, oPtr, 0);
         1249  +    if (InitDefineContext(interp, nsPtr, oPtr, objc, objv) != TCL_OK) {
  1221   1250   	return TCL_ERROR;
  1222   1251       }
  1223   1252       if (private) {
  1224   1253   	((Interp *) interp)->varFramePtr->isProcCallFrame = PRIVATE_FRAME;
  1225   1254       }
  1226   1255   
  1227   1256       AddRef(oPtr);
................................................................................
  1232   1261   	result = TclEvalObjEx(interp, objv[1], 0,
  1233   1262   		((Interp *)interp)->cmdFramePtr, 1);
  1234   1263   	if (result == TCL_ERROR) {
  1235   1264   	    GenerateErrorInfo(interp, oPtr, objNameObj, "class object");
  1236   1265   	}
  1237   1266   	TclDecrRefCount(objNameObj);
  1238   1267       } else {
  1239         -	result = MagicDefinitionInvoke(interp, fPtr->objdefNs, 1, objc, objv);
         1268  +	result = MagicDefinitionInvoke(interp, nsPtr, 1, objc, objv);
  1240   1269       }
  1241   1270       TclOODecrRefCount(oPtr);
  1242   1271   
  1243   1272       /*
  1244   1273        * Restore the previous "current" namespace.
  1245   1274        */
  1246   1275   
................................................................................
  1526   1555        * immediately delete the constructor as this might be being done during
  1527   1556        * execution of the constructor itself.
  1528   1557        */
  1529   1558   
  1530   1559       Tcl_ClassSetConstructor(interp, (Tcl_Class) clsPtr, method);
  1531   1560       return TCL_OK;
  1532   1561   }
         1562  +
         1563  +/*
         1564  + * ----------------------------------------------------------------------
         1565  + *
         1566  + * TclOODefineDefnNsObjCmd --
         1567  + *
         1568  + *	Implementation of the "definitionnamespace" subcommand of the
         1569  + *	"oo::define" command.
         1570  + *
         1571  + * ----------------------------------------------------------------------
         1572  + */
         1573  +
         1574  +int
         1575  +TclOODefineDefnNsObjCmd(
         1576  +    ClientData clientData,
         1577  +    Tcl_Interp *interp,
         1578  +    int objc,
         1579  +    Tcl_Obj *const *objv)
         1580  +{
         1581  +    static const char *kindList[] = {
         1582  +	"-class",
         1583  +	"-instance",
         1584  +	NULL
         1585  +    };
         1586  +    int kind = 0;
         1587  +    Object *oPtr;
         1588  +    Tcl_Namespace *nsPtr;
         1589  +    Tcl_Obj *nsNamePtr, **storagePtr;
         1590  +
         1591  +    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
         1592  +    if (oPtr == NULL) {
         1593  +	return TCL_ERROR;
         1594  +    }
         1595  +    if (!oPtr->classPtr) {
         1596  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
         1597  +		"attempt to misuse API", -1));
         1598  +	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
         1599  +	return TCL_ERROR;
         1600  +    }
         1601  +    if (oPtr->flags & (ROOT_OBJECT | ROOT_CLASS)) {
         1602  +	Tcl_SetObjResult(interp, Tcl_NewStringObj(
         1603  +		"may not modify the definition namespace of the root classes",
         1604  +		-1));
         1605  +	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
         1606  +	return TCL_ERROR;	
         1607  +    }
         1608  +
         1609  +    /*
         1610  +     * Parse the arguments and work out what the user wants to do.
         1611  +     */
         1612  +
         1613  +    if (objc != 2 && objc != 3) {
         1614  +	Tcl_WrongNumArgs(interp, 1, objv, "?kind? namespace");
         1615  +	return TCL_ERROR;
         1616  +    }
         1617  +    if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[1], kindList, "kind", 0,
         1618  +	    &kind) != TCL_OK) {
         1619  +	return TCL_ERROR;
         1620  +    }
         1621  +    if (!Tcl_GetString(objv[objc - 1])[0]) {
         1622  +	nsNamePtr = NULL;
         1623  +    } else {
         1624  +	nsPtr = GetNamespaceInOuterContext(interp, objv[objc - 1]);
         1625  +	if (nsPtr == NULL) {
         1626  +	    return TCL_ERROR;
         1627  +	}
         1628  +	nsNamePtr = Tcl_NewStringObj(nsPtr->fullName, -1);
         1629  +	Tcl_IncrRefCount(nsNamePtr);
         1630  +    }
         1631  +
         1632  +    /*
         1633  +     * Update the correct field of the class definition.
         1634  +     */
         1635  +
         1636  +    if (kind) {
         1637  +	storagePtr = &oPtr->classPtr->objDefinitionNs;
         1638  +    } else {
         1639  +	storagePtr = &oPtr->classPtr->clsDefinitionNs;
         1640  +    }
         1641  +    if (*storagePtr != NULL) {
         1642  +	Tcl_DecrRefCount(*storagePtr);
         1643  +    }
         1644  +    *storagePtr = nsNamePtr;
         1645  +    return TCL_OK;
         1646  +}
  1533   1647   
  1534   1648   /*
  1535   1649    * ----------------------------------------------------------------------
  1536   1650    *
  1537   1651    * TclOODefineDeleteMethodObjCmd --
  1538   1652    *
  1539   1653    *	Implementation of the "deletemethod" subcommand of the "oo::define"

Changes to generic/tclOOInfo.c.

    29     29   static Tcl_ObjCmdProc InfoObjectMixinsCmd;
    30     30   static Tcl_ObjCmdProc InfoObjectNsCmd;
    31     31   static Tcl_ObjCmdProc InfoObjectVarsCmd;
    32     32   static Tcl_ObjCmdProc InfoObjectVariablesCmd;
    33     33   static Tcl_ObjCmdProc InfoClassCallCmd;
    34     34   static Tcl_ObjCmdProc InfoClassConstrCmd;
    35     35   static Tcl_ObjCmdProc InfoClassDefnCmd;
           36  +static Tcl_ObjCmdProc InfoClassDefnNsCmd;
    36     37   static Tcl_ObjCmdProc InfoClassDestrCmd;
    37     38   static Tcl_ObjCmdProc InfoClassFiltersCmd;
    38     39   static Tcl_ObjCmdProc InfoClassForwardCmd;
    39     40   static Tcl_ObjCmdProc InfoClassInstancesCmd;
    40     41   static Tcl_ObjCmdProc InfoClassMethodsCmd;
    41     42   static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
    42     43   static Tcl_ObjCmdProc InfoClassMixinsCmd;
................................................................................
    69     70    * List of commands that are used to implement the [info class] subcommands.
    70     71    */
    71     72   
    72     73   static const EnsembleImplMap infoClassCmds[] = {
    73     74       {"call",	     InfoClassCallCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
    74     75       {"constructor",  InfoClassConstrCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    75     76       {"definition",   InfoClassDefnCmd,		TclCompileBasic2ArgCmd, NULL, NULL, 0},
           77  +    {"definitionnamespace", InfoClassDefnNsCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    76     78       {"destructor",   InfoClassDestrCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
    77     79       {"filters",	     InfoClassFiltersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
    78     80       {"forward",	     InfoClassForwardCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    79     81       {"instances",    InfoClassInstancesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
    80     82       {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
    81     83       {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
    82     84       {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
................................................................................
  1025   1027   	    Tcl_ListObjAppendElement(NULL, resultObjs[0], argObj);
  1026   1028   	}
  1027   1029       }
  1028   1030       resultObjs[1] = TclOOGetMethodBody(Tcl_GetHashValue(hPtr));
  1029   1031       Tcl_SetObjResult(interp, Tcl_NewListObj(2, resultObjs));
  1030   1032       return TCL_OK;
  1031   1033   }
         1034  +
         1035  +/*
         1036  + * ----------------------------------------------------------------------
         1037  + *
         1038  + * InfoClassDefnNsCmd --
         1039  + *
         1040  + *	Implements [info class definitionnamespace $clsName ?$kind?]
         1041  + *
         1042  + * ----------------------------------------------------------------------
         1043  + */
         1044  +
         1045  +static int
         1046  +InfoClassDefnNsCmd(
         1047  +    ClientData clientData,
         1048  +    Tcl_Interp *interp,
         1049  +    int objc,
         1050  +    Tcl_Obj *const objv[])
         1051  +{
         1052  +    static const char *kindList[] = {
         1053  +	"-class",
         1054  +	"-instance",
         1055  +	NULL
         1056  +    };
         1057  +    int kind = 0;
         1058  +    Tcl_Obj *nsNamePtr;
         1059  +    Class *clsPtr;
         1060  +
         1061  +    if (objc != 2 && objc != 3) {
         1062  +	Tcl_WrongNumArgs(interp, 1, objv, "className ?kind?");
         1063  +	return TCL_ERROR;
         1064  +    }
         1065  +    clsPtr = GetClassFromObj(interp, objv[1]);
         1066  +    if (clsPtr == NULL) {
         1067  +	return TCL_ERROR;
         1068  +    }
         1069  +    if (objc == 3 && Tcl_GetIndexFromObj(interp, objv[2], kindList, "kind", 0,
         1070  +	    &kind) != TCL_OK) {
         1071  +	return TCL_ERROR;
         1072  +    }
         1073  +
         1074  +    if (kind) {
         1075  +	nsNamePtr = clsPtr->objDefinitionNs;
         1076  +    } else {
         1077  +	nsNamePtr = clsPtr->clsDefinitionNs;
         1078  +    }
         1079  +    if (nsNamePtr) {
         1080  +	Tcl_SetObjResult(interp, nsNamePtr);
         1081  +    }
         1082  +    return TCL_OK;
         1083  +}
  1032   1084   
  1033   1085   /*
  1034   1086    * ----------------------------------------------------------------------
  1035   1087    *
  1036   1088    * InfoClassDestrCmd --
  1037   1089    *
  1038   1090    *	Implements [info class destructor $clsName]

Changes to generic/tclOOInt.h.

   300    300   				 * object doesn't override with its own mixins
   301    301   				 * (and filters and method implementations for
   302    302   				 * when getting method chains). */
   303    303       VariableNameList variables;
   304    304       PrivateVariableList privateVariables;
   305    305   				/* Configurations for the variable resolver
   306    306   				 * used inside methods. */
          307  +    Tcl_Obj *clsDefinitionNs;	/* Name of the namespace to use for
          308  +				 * definitions commands of instances of this
          309  +				 * class in when those instances are defined
          310  +				 * as classes. If NULL, use the value from the
          311  +				 * class hierarchy. It's an error at
          312  +				 * [oo::define] call time if this namespace is
          313  +				 * defined but doesn't exist; we also check at
          314  +				 * setting time but don't check between
          315  +				 * times. */
          316  +    Tcl_Obj *objDefinitionNs;	/* Name of the namespace to use for
          317  +				 * definitions commands of instances of this
          318  +				 * class in when those instances are defined
          319  +				 * as instances. If NULL, use the value from
          320  +				 * the class hierarchy. It's an error at
          321  +				 * [oo::objdefine]/[self] call time if this
          322  +				 * namespace is defined but doesn't exist; we
          323  +				 * also check at setting time but don't check
          324  +				 * between times. */
   307    325   } Class;
   308    326   
   309    327   /*
   310    328    * The foundation of the object system within an interpreter contains
   311    329    * references to the key classes and namespaces, together with a few other
   312    330    * useful bits and pieces. Probably ought to eventually go in the Interp
   313    331    * structure itself.
................................................................................
   436    454   			    Tcl_Interp *interp, int objc,
   437    455   			    Tcl_Obj *const *objv);
   438    456   MODULE_SCOPE int	TclOOObjDefObjCmd(ClientData clientData,
   439    457   			    Tcl_Interp *interp, int objc,
   440    458   			    Tcl_Obj *const *objv);
   441    459   MODULE_SCOPE int	TclOODefineConstructorObjCmd(ClientData clientData,
   442    460   			    Tcl_Interp *interp, int objc,
          461  +			    Tcl_Obj *const *objv);
          462  +MODULE_SCOPE int	TclOODefineDefnNsObjCmd(ClientData clientData,
          463  +			    Tcl_Interp *interp, int objc,
   443    464   			    Tcl_Obj *const *objv);
   444    465   MODULE_SCOPE int	TclOODefineDeleteMethodObjCmd(ClientData clientData,
   445    466   			    Tcl_Interp *interp, int objc,
   446    467   			    Tcl_Obj *const *objv);
   447    468   MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
   448    469   			    Tcl_Interp *interp, int objc,
   449    470   			    Tcl_Obj *const *objv);
................................................................................
   549    570   MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
   550    571   			    Object *oPtr);
   551    572   MODULE_SCOPE void	TclOODelMethodRef(Method *method);
   552    573   MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
   553    574   			    Tcl_Obj *methodNameObj, int flags,
   554    575   			    Object *contextObjPtr, Class *contextClsPtr,
   555    576   			    Tcl_Obj *cacheInThisObj);
          577  +MODULE_SCOPE Tcl_Namespace *TclOOGetDefineContextNamespace(
          578  +			    Tcl_Interp *interp, Object *oPtr, int forClass);
   556    579   MODULE_SCOPE CallChain *TclOOGetStereotypeCallChain(Class *clsPtr,
   557    580   			    Tcl_Obj *methodNameObj, int flags);
   558    581   MODULE_SCOPE Foundation	*TclOOGetFoundation(Tcl_Interp *interp);
   559    582   MODULE_SCOPE Tcl_Obj *	TclOOGetFwdFromMethod(Method *mPtr);
   560    583   MODULE_SCOPE Proc *	TclOOGetProcFromMethod(Method *mPtr);
   561    584   MODULE_SCOPE Tcl_Obj *	TclOOGetMethodBody(Method *mPtr);
   562    585   MODULE_SCOPE int	TclOOGetSortedClassMethodList(Class *clsPtr,

Changes to generic/tclOOScript.h.

    94     94   "\t\t\treturn\n"
    95     95   "\t\t}\n"
    96     96   "\t\tforeach c [info class superclass $class] {\n"
    97     97   "\t\t\tset d [DelegateName $c]\n"
    98     98   "\t\t\tif {![info object isa class $d]} {\n"
    99     99   "\t\t\t\tcontinue\n"
   100    100   "\t\t\t}\n"
   101         -"\t\t\tdefine $delegate superclass -append $d\n"
          101  +"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
   102    102   "\t\t}\n"
   103         -"\t\tobjdefine $class mixin -append $delegate\n"
          103  +"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
   104    104   "\t}\n"
   105    105   "\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
   106    106   "\t\tset originDelegate [DelegateName $originObject]\n"
   107    107   "\t\tset targetDelegate [DelegateName $targetObject]\n"
   108    108   "\t\tif {\n"
   109    109   "\t\t\t[info object isa class $originDelegate]\n"
   110    110   "\t\t\t&& ![info object isa class $targetDelegate]\n"

Changes to generic/tclOOScript.tcl.

   149    149   	    return
   150    150   	}
   151    151   	foreach c [info class superclass $class] {
   152    152   	    set d [DelegateName $c]
   153    153   	    if {![info object isa class $d]} {
   154    154   		continue
   155    155   	    }
   156         -	    define $delegate superclass -append $d
          156  +	    define $delegate ::oo::define::superclass -append $d
   157    157   	}
   158         -	objdefine $class mixin -append $delegate
          158  +	objdefine $class ::oo::objdefine::mixin -append $delegate
   159    159       }
   160    160   
   161    161       # ----------------------------------------------------------------------
   162    162       #
   163    163       # UpdateClassDelegatesAfterClone --
   164    164       #
   165    165       #	Support code that is like [MixinClassDelegates] except for when a
................................................................................
   172    172   	set originDelegate [DelegateName $originObject]
   173    173   	set targetDelegate [DelegateName $targetObject]
   174    174   	if {
   175    175   	    [info object isa class $originDelegate]
   176    176   	    && ![info object isa class $targetDelegate]
   177    177   	} then {
   178    178   	    copy $originDelegate $targetDelegate
   179         -	    objdefine $targetObject mixin -set \
          179  +	    objdefine $targetObject ::oo::objdefine::mixin -set \
   180    180   		{*}[lmap c [info object mixin $targetObject] {
   181    181   		    if {$c eq $originDelegate} {set targetDelegate} {set c}
   182    182   		}]
   183    183   	}
   184    184       }
   185    185   
   186    186       # ----------------------------------------------------------------------

Changes to tests/oo.test.

   325    325       obj destroy
   326    326       info commands ::AGlobalName
   327    327   } -result {}
   328    328   test oo-1.21 {basic test of OO functionality: default relations} -setup {
   329    329       set fresh [interp create]
   330    330   } -body {
   331    331       lmap x [$fresh eval {
          332  +	set initials {::oo::object ::oo::class ::oo::Slot}
   332    333   	foreach cmd {instances subclasses mixins superclass} {
   333         -	    foreach initial {object class Slot} {
   334         -		lappend x [info class $cmd ::oo::$initial]
          334  +	    foreach initial $initials {
          335  +		lappend x [info class $cmd $initial]
   335    336   	    }
   336    337   	}
   337         -	foreach initial {object class Slot} {
   338         -	    lappend x [info object class ::oo::$initial]
          338  +	foreach initial $initials {
          339  +	    lappend x [info object class $initial]
   339    340   	}
   340    341   	return $x
   341         -    }] {lsort [lmap y $x {if {[string match *::delegate $y]} continue; set y}]}
          342  +    }] {lsort [lsearch -all -not -inline $x *::delegate]}
   342    343   } -cleanup {
   343    344       interp delete $fresh
   344    345   } -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
   345    346   
   346    347   test oo-2.1 {basic test of OO functionality: constructor} -setup {
   347    348       # This is a bit complex because it needs to run in a sub-interp as
   348    349       # we're modifying the root object class's constructor
................................................................................
  2515   2516   } -body {
  2516   2517       info class superclass foo
  2517   2518   } -returnCodes 1 -cleanup {
  2518   2519       foo destroy
  2519   2520   } -result {"foo" is not a class}
  2520   2521   test oo-17.4 {OO: class introspection} -body {
  2521   2522       info class gorp oo::object
  2522         -} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
         2523  +} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
  2523   2524   test oo-17.5 {OO: class introspection} -setup {
  2524   2525       oo::class create testClass
  2525   2526   } -body {
  2526   2527       testClass create foo
  2527   2528       testClass create bar
  2528   2529       testClass create spong
  2529   2530       lsort [info class instances testClass]
................................................................................
  5072   5073   	forward poke myclass Hi
  5073   5074       }
  5074   5075       cls1 create x
  5075   5076       lappend result [catch {cls1 Hi}] [x poke]
  5076   5077   } -cleanup {
  5077   5078       parent destroy
  5078   5079   } -result {1 {this is ::cls1}}
         5080  +
         5081  +test oo-42.1 {TIP 524: definition namespace control: introspection} {
         5082  +    info class definitionnamespace oo::object
         5083  +} {}
         5084  +test oo-42.2 {TIP 524: definition namespace control: introspection} {
         5085  +    info class definitionnamespace oo::object -class
         5086  +} {}
         5087  +test oo-42.3 {TIP 524: definition namespace control: introspection} {
         5088  +    info class definitionnamespace oo::object -instance
         5089  +} ::oo::objdefine
         5090  +test oo-42.4 {TIP 524: definition namespace control: introspection} -body {
         5091  +    info class definitionnamespace oo::object -gorp
         5092  +} -returnCodes error -result {bad kind "-gorp": must be -class or -instance}
         5093  +test oo-42.5 {TIP 524: definition namespace control: introspection} -body {
         5094  +    info class definitionnamespace oo::object -class x
         5095  +} -returnCodes error -result {wrong # args: should be "info class definitionnamespace className ?kind?"}
         5096  +test oo-42.6 {TIP 524: definition namespace control: introspection} {
         5097  +    info class definitionnamespace oo::class
         5098  +} ::oo::define
         5099  +test oo-42.7 {TIP 524: definition namespace control: introspection} {
         5100  +    info class definitionnamespace oo::class -class
         5101  +} ::oo::define
         5102  +test oo-42.8 {TIP 524: definition namespace control: introspection} {
         5103  +    info class definitionnamespace oo::class -instance
         5104  +} {}
         5105  +
         5106  +test oo-43.1 {TIP 524: definition namespace control: semantics} -setup {
         5107  +    oo::class create parent
         5108  +    namespace eval foodef {}
         5109  +} -body {
         5110  +    namespace eval foodef {
         5111  +	proc sparkle {} {return ok}
         5112  +    }
         5113  +    oo::class create foocls {
         5114  +	superclass oo::class parent
         5115  +	definitionnamespace foodef
         5116  +    }
         5117  +    oo::class create foo {
         5118  +	superclass parent
         5119  +	self class foocls
         5120  +    }
         5121  +    oo::define foo {
         5122  +	sparkle
         5123  +    }
         5124  +} -cleanup {
         5125  +    parent destroy
         5126  +    namespace delete foodef
         5127  +} -result ok
         5128  +test oo-43.2 {TIP 524: definition namespace control: semantics} -setup {
         5129  +    oo::class create parent
         5130  +    namespace eval foodef {}
         5131  +    unset -nocomplain ::result
         5132  +} -body {
         5133  +    namespace eval foodef {
         5134  +	namespace path ::oo::define
         5135  +	proc sparkle {} {return ok}
         5136  +    }
         5137  +    oo::class create foocls {
         5138  +	superclass oo::class parent
         5139  +	definitionnamespace foodef
         5140  +    }
         5141  +    foocls create foo {
         5142  +	superclass parent
         5143  +	lappend ::result [sparkle]
         5144  +    }
         5145  +    return $result
         5146  +} -cleanup {
         5147  +    parent destroy
         5148  +    namespace delete foodef
         5149  +} -result ok
         5150  +test oo-43.3 {TIP 524: definition namespace control: semantics} -setup {
         5151  +    oo::class create parent
         5152  +    namespace eval foodef {}
         5153  +    unset -nocomplain ::result
         5154  +} -body {
         5155  +    namespace eval foodef {
         5156  +	namespace path ::oo::define
         5157  +	proc sparkle {} {return ok}
         5158  +    }
         5159  +    oo::class create foocls {
         5160  +	superclass oo::class parent
         5161  +	definitionnamespace -class foodef
         5162  +    }
         5163  +    foocls create foo {
         5164  +	superclass parent
         5165  +	lappend ::result [sparkle]
         5166  +    }
         5167  +    return $result
         5168  +} -cleanup {
         5169  +    parent destroy
         5170  +    namespace delete foodef
         5171  +} -result ok
         5172  +test oo-43.4 {TIP 524: definition namespace control: semantics} -setup {
         5173  +    oo::class create parent
         5174  +    namespace eval foodef {}
         5175  +} -body {
         5176  +    namespace eval foodef {
         5177  +	namespace path ::oo::objdefine
         5178  +	proc sparkle {} {return ok}
         5179  +    }
         5180  +    oo::class create foocls {
         5181  +	superclass oo::class parent
         5182  +	definitionnamespace -instance foodef
         5183  +    }
         5184  +    foocls create foo {
         5185  +	sparkle
         5186  +    }
         5187  +} -returnCodes error -cleanup {
         5188  +    parent destroy
         5189  +    namespace delete foodef
         5190  +} -result {invalid command name "sparkle"}
         5191  +test oo-43.5 {TIP 524: definition namespace control: semantics} -setup {
         5192  +    oo::class create parent
         5193  +    namespace eval foodef {}
         5194  +} -body {
         5195  +    namespace eval foodef {
         5196  +	namespace path ::oo::objdefine
         5197  +	proc sparkle {} {return ok}
         5198  +    }
         5199  +    oo::class create foocls {
         5200  +	superclass oo::class parent
         5201  +	definitionnamespace foodef
         5202  +    }
         5203  +    namespace delete foodef
         5204  +    foocls create foo {
         5205  +	sparkle
         5206  +    }
         5207  +} -returnCodes error -cleanup {
         5208  +    parent destroy
         5209  +    catch {namespace delete foodef}
         5210  +} -result {invalid command name "sparkle"}
         5211  +test oo-43.6 {TIP 524: definition namespace control: semantics} -setup {
         5212  +    oo::class create parent
         5213  +    namespace eval foodef {}
         5214  +    unset -nocomplain result
         5215  +} -body {
         5216  +    namespace eval foodef {
         5217  +	namespace path ::oo::objdefine
         5218  +	proc sparkle {} {return ok}
         5219  +    }
         5220  +    oo::class create foocls {
         5221  +	superclass oo::class parent
         5222  +	definitionnamespace foodef
         5223  +    }
         5224  +    foocls create foo
         5225  +    lappend result [catch {oo::define foo sparkle} msg] $msg
         5226  +    namespace delete foodef
         5227  +    lappend result [catch {oo::define foo sparkle} msg] $msg
         5228  +    namespace eval foodef {
         5229  +	namespace path ::oo::objdefine
         5230  +	proc sparkle {} {return ok}
         5231  +    }
         5232  +    lappend result [catch {oo::define foo sparkle} msg] $msg
         5233  +} -cleanup {
         5234  +    parent destroy
         5235  +    catch {namespace delete foodef}
         5236  +} -result {0 ok 1 {invalid command name "sparkle"} 0 ok}
         5237  +test oo-43.7 {TIP 524: definition namespace control: semantics} -setup {
         5238  +    oo::class create parent
         5239  +    namespace eval foodef {}
         5240  +} -body {
         5241  +    namespace eval foodef {
         5242  +	namespace path ::oo::define
         5243  +	proc sparkle {x} {return ok}
         5244  +    }
         5245  +    oo::class create foocls {
         5246  +	superclass oo::class parent
         5247  +	definitionnamespace foodef
         5248  +    }
         5249  +    foocls create foo {
         5250  +	superclass parent
         5251  +    }
         5252  +    oo::define foo spar gorp
         5253  +} -cleanup {
         5254  +    parent destroy
         5255  +    namespace delete foodef
         5256  +} -result ok
         5257  +test oo-43.8 {TIP 524: definition namespace control: semantics} -setup {
         5258  +    oo::class create parent
         5259  +    namespace eval foodef {}
         5260  +} -body {
         5261  +    namespace eval foodef {
         5262  +	namespace path ::oo::objdefine
         5263  +	proc sparkle {} {return ok}
         5264  +    }
         5265  +    oo::class create foo {
         5266  +	superclass parent
         5267  +	definitionnamespace -instance foodef
         5268  +    }
         5269  +    oo::objdefine [foo new] {
         5270  +	method x y z
         5271  +	sparkle
         5272  +    }
         5273  +} -cleanup {
         5274  +    parent destroy
         5275  +    namespace delete foodef
         5276  +} -result ok
         5277  +test oo-43.9 {TIP 524: definition namespace control: syntax} -body {
         5278  +    oo::class create foo {
         5279  +	definitionnamespace -gorp foodef
         5280  +    }
         5281  +} -returnCodes error -result {bad kind "-gorp": must be -class or -instance}
         5282  +test oo-43.10 {TIP 524: definition namespace control: syntax} -body {
         5283  +    oo::class create foo {
         5284  +	definitionnamespace -class foodef x
         5285  +    }
         5286  +} -returnCodes error -result {wrong # args: should be "definitionnamespace ?kind? namespace"}
         5287  +test oo-43.11 {TIP 524: definition namespace control: syntax} -setup {
         5288  +    catch {namespace delete ::no_such_ns}
         5289  +} -body {
         5290  +    oo::class create foo {
         5291  +	definitionnamespace -class ::no_such_ns
         5292  +    }
         5293  +} -returnCodes error -result {namespace "::no_such_ns" not found}
         5294  +test oo-43.12 {TIP 524: definition namespace control: user-level introspection} -setup {
         5295  +    oo::class create parent
         5296  +    namespace eval foodef {}
         5297  +} -body {
         5298  +    namespace eval foodef {}
         5299  +    oo::class create foo {
         5300  +	superclass oo::class parent
         5301  +    }
         5302  +    list [info class definitionnamespace foo] \
         5303  +	[oo::define foo definitionnamespace foodef] \
         5304  +	[info class definitionnamespace foo] \
         5305  +	[oo::define foo definitionnamespace {}] \
         5306  +	[info class definitionnamespace foo]
         5307  +} -cleanup {
         5308  +    parent destroy
         5309  +    namespace delete foodef
         5310  +} -result {{} {} ::foodef {} {}}
         5311  +test oo-43.13 {TIP 524: definition namespace control: user-level introspection} -setup {
         5312  +    oo::class create parent
         5313  +    namespace eval foodef {}
         5314  +} -body {
         5315  +    namespace eval foodef {}
         5316  +    oo::class create foo {
         5317  +	superclass parent
         5318  +    }
         5319  +    list [info class definitionnamespace foo -instance] \
         5320  +	[oo::define foo definitionnamespace -instance foodef] \
         5321  +	[info class definitionnamespace foo -instance] \
         5322  +	[oo::define foo definitionnamespace -instance {}] \
         5323  +	[info class definitionnamespace foo -instance]
         5324  +} -cleanup {
         5325  +    parent destroy
         5326  +    namespace delete foodef
         5327  +} -result {{} {} ::foodef {} {}}
  5079   5328   
  5080   5329   cleanupTests
  5081   5330   return
  5082   5331   
  5083   5332   # Local Variables:
  5084   5333   # mode: tcl
  5085   5334   # End: