Tcl Source Code

Changes On Branch tip-470
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-470 Excluding Merge-Ins

This is equivalent to a diff from 9aaee27679 to bc0550924f

2017-06-22
21:50
Implement TIP #470: Reliable Access to OO Definition Context Object check-in: 0ae0df0685 user: dkf tags: trunk
21:48
merge trunk Closed-Leaf check-in: bc0550924f user: dkf tags: tip-470
21:46
Implement TIP #463: Command-Driven Substitutions for regsub check-in: 9aaee27679 user: dkf tags: trunk
12:25
merge trunk Closed-Leaf check-in: d26f75a105 user: dgp tags: tip-463
08:59
merge core-8-6-branch check-in: 1d11dc7a53 user: jan.nijtmans tags: trunk
2017-06-13
11:10
Add tests and docs. check-in: e19250e477 user: dkf tags: tip-470

Changes to doc/define.n.

138
139
140
141
142
143
144


145
146
147
148
149
150
151
152
153







154
155
156
157
158
159
160
...
260
261
262
263
264
265
266






267
268
269
270
271
272
273
(except when they have a call chain through the class being modified). Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.TP
\fBself\fI subcommand arg ...\fR
.TP
\fBself\fI script\fR


.
This command is equivalent to calling \fBoo::objdefine\fR on the class being
defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
supported values of \fIsubcommand\fR). It follows the same general pattern of
argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands,
and
.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
operates identically to
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .







.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
................................................................................
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.






.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the object through the object's command, but instead
just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined






>
>









>
>
>
>
>
>
>







 







>
>
>
>
>
>







138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
...
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
(except when they have a call chain through the class being modified). Does
not change the export status of the method; if it was exported before, it will
be afterwards.
.TP
\fBself\fI subcommand arg ...\fR
.TP
\fBself\fI script\fR
.TP
\fBself\fR
.
This command is equivalent to calling \fBoo::objdefine\fR on the class being
defined (see \fBCONFIGURING OBJECTS\fR below for a description of the
supported values of \fIsubcommand\fR). It follows the same general pattern of
argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands,
and
.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
operates identically to
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
.RS
.PP
.VS TIP470
If no arguments at all are used, this gives the name of the class currently
being configured.
.VE TIP470
.RE
.TP
\fBsuperclass\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
................................................................................
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.
.TP
\fBself \fR
.
.VS TIP470
This gives the name of the object currently being configured.
.VE TIP470
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the object through the object's command, but instead
just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined

Changes to generic/tclOO.c.

37
38
39
40
41
42
43

44
45
46
47
48
49
50
}, objdefCmds[] = {
    {"class", TclOODefineClassObjCmd, 1},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
    {"export", TclOODefineExportObjCmd, 1},
    {"forward", TclOODefineForwardObjCmd, 1},
    {"method", TclOODefineMethodObjCmd, 1},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},

    {"unexport", TclOODefineUnexportObjCmd, 1},
    {NULL, NULL, 0}
};

/*
 * What sort of size of things we like to allocate.
 */






>







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
}, objdefCmds[] = {
    {"class", TclOODefineClassObjCmd, 1},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
    {"export", TclOODefineExportObjCmd, 1},
    {"forward", TclOODefineForwardObjCmd, 1},
    {"method", TclOODefineMethodObjCmd, 1},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
    {"self", TclOODefineObjSelfObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 1},
    {NULL, NULL, 0}
};

/*
 * What sort of size of things we like to allocate.
 */

Changes to generic/tclOODefineCmds.c.

1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026





1027
1028
1029
1030
1031
1032
1033
....
1053
1054
1055
1056
1057
1058
1059

































1060
1061
1062
1063
1064
1065
1066
    int objc,
    Tcl_Obj *const *objv)
{
    Foundation *fPtr = TclOOGetFoundation(interp);
    Object *oPtr;
    int result;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "arg ?arg ...?");
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }






    /*
     * Make the oo::objdefine namespace the current namespace and evaluate the
     * command(s).
     */

    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
................................................................................
    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}

































 
/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineClassObjCmd --
 *	Implementation of the "class" subcommand of the "oo::objdefine"
 *	command.






<
<
<
<
<




>
>
>
>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1011
1012
1013
1014
1015
1016
1017





1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
....
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
    int objc,
    Tcl_Obj *const *objv)
{
    Foundation *fPtr = TclOOGetFoundation(interp);
    Object *oPtr;
    int result;






    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    if (objc < 2) {
	Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
	return TCL_OK;
    }

    /*
     * Make the oo::objdefine namespace the current namespace and evaluate the
     * command(s).
     */

    if (InitDefineContext(interp, fPtr->objdefNs, oPtr, objc,objv) != TCL_OK){
................................................................................
    /*
     * Restore the previous "current" namespace.
     */

    TclPopStackFrame(interp);
    return result;
}
 
/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineObjSelfObjCmd --
 *	Implementation of the "self" subcommand of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineObjSelfObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;

    if (objc != 1) {
	Tcl_WrongNumArgs(interp, 1, objv, NULL);
	return TCL_ERROR;
    }

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }

    Tcl_SetObjResult(interp, TclOOObjectName(interp, oPtr));
    return TCL_OK;
}
 
/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineClassObjCmd --
 *	Implementation of the "class" subcommand of the "oo::objdefine"
 *	command.

Changes to generic/tclOOInt.h.

426
427
428
429
430
431
432



433
434
435
436
437
438
439
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,



			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);






>
>
>







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineObjSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOCopyObjectCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);

Changes to tests/oo.test.

3762
3763
3764
3765
3766
3767
3768

















3769


























































































3770
3771
3772
3773
3774
3775
test oo-35.4 {Bug 593baa032c: mixins list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {mixin B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}


















 


























































































cleanupTests
return

# Local Variables:
# mode: tcl
# End:






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






3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
3775
3776
3777
3778
3779
3780
3781
3782
3783
3784
3785
3786
3787
3788
3789
3790
3791
3792
3793
3794
3795
3796
3797
3798
3799
3800
3801
3802
3803
3804
3805
3806
3807
3808
3809
3810
3811
3812
3813
3814
3815
3816
3817
3818
3819
3820
3821
3822
3823
3824
3825
3826
3827
3828
3829
3830
3831
3832
3833
3834
3835
3836
3837
3838
3839
3840
3841
3842
3843
3844
3845
3846
3847
3848
3849
3850
3851
3852
3853
3854
3855
3856
3857
3858
3859
3860
3861
3862
3863
3864
3865
3866
3867
3868
3869
3870
3871
3872
3873
3874
3875
3876
3877
3878
3879
3880
3881
3882
test oo-35.4 {Bug 593baa032c: mixins list teardown} {
    # Bug makes this crash, especially with mem-debugging on
    oo::class create B {}
    oo::class create D {mixin B}
    namespace eval [info object namespace D] [list [namespace which B] destroy]
} {}

test oo-36.1 {TIP #470: introspection within oo::define} {
    oo::define oo::object self
} ::oo::object
test oo-36.2 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
} -body {
    oo::define Cls self
} -cleanup {
    Cls destroy
} -result ::Cls
test oo-36.3 {TIP #470: introspection within oo::define} -setup {
    oo::class create Super
    set result uncalled
} -body {
    oo::class create Sub {
	superclass Super
	::set ::result [self]
    }
    return $result
} -cleanup {
    Super destroy
} -result ::Sub
test oo-36.4 {TIP #470: introspection within oo::define} -setup {
    oo::class create Super
    set result uncalled
} -body {
    oo::class create Sub {
	superclass Super
	::set ::result [self {}]
    }
    return $result
} -cleanup {
    Super destroy
} -result {}
test oo-36.5 {TIP #470: introspection within oo::define} -setup {
    oo::class create Super
    set result uncalled
} -body {
    oo::class create Sub {
	superclass Super
	::set ::result [self self]
    }
} -cleanup {
    Super destroy
} -result ::Sub
test oo-36.6 {TIP #470: introspection within oo::objdefine} -setup {
    oo::class create Cls
    set result uncalled
} -body {
    Cls create obj
    oo::objdefine obj {
	::set ::result [self]
    }
} -cleanup {
    Cls destroy
} -result ::obj
test oo-36.7 {TIP #470: introspection within oo::objdefine} -setup {
    oo::class create Cls
} -body {
    Cls create obj
    oo::objdefine obj {
	self
    }
} -cleanup {
    Cls destroy
} -result ::obj
test oo-36.8 {TIP #470: introspection within oo::objdefine} -setup {
    oo::class create Cls
} -body {
    Cls create obj
    oo::objdefine obj {
	self anything
    }
} -returnCodes error -cleanup {
    Cls destroy
} -result {wrong # args: should be "self"}
test oo-36.9 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
    set result uncalled
} -body {
    proc oo::define::testself {} {
	global result
	set result [list [catch {self} msg] $msg \
			[catch {uplevel 1 self} msg] $msg]
	return
    }
    list [oo::define Cls testself] $result
} -cleanup {
    Cls destroy
    catch {rename oo::define::testself {}}
} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::Cls}}
test oo-36.10 {TIP #470: introspection within oo::define} -setup {
    oo::class create Cls
    set result uncalled
} -body {
    proc oo::objdefine::testself {} {
	global result
	set result [list [catch {self} msg] $msg \
			[catch {uplevel 1 self} msg] $msg]
	return
    }
    Cls create obj
    list [oo::objdefine obj testself] $result
} -cleanup {
    Cls destroy
    catch {rename oo::objdefine::testself {}}
} -result {{} {1 {this command may only be called from within the context of an ::oo::define or ::oo::objdefine command} 0 ::obj}}
 
cleanupTests
return

# Local Variables:
# mode: tcl
# End: