summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2017-06-13 11:10:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2017-06-13 11:10:11 (GMT)
commit84481c3d32d19d3c3d8bdc97d6b378fb9665ced7 (patch)
tree3b79410505d091c821a29a15cb0eace59bffbaac
parent728c64fc037b7b9cbad80e040b2c58317d78271a (diff)
downloadtcl-84481c3d32d19d3c3d8bdc97d6b378fb9665ced7.zip
tcl-84481c3d32d19d3c3d8bdc97d6b378fb9665ced7.tar.gz
tcl-84481c3d32d19d3c3d8bdc97d6b378fb9665ced7.tar.bz2
Add tests and docs.
-rw-r--r--doc/define.n15
-rw-r--r--tests/oo.test107
2 files changed, 122 insertions, 0 deletions
diff --git a/doc/define.n b/doc/define.n
index 7599ec0..1692c94 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -142,6 +142,8 @@ be afterwards.
\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
@@ -151,6 +153,13 @@ 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
@@ -265,6 +274,12 @@ 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
diff --git a/tests/oo.test b/tests/oo.test
index e03911b..ae36f87 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -3766,6 +3766,113 @@ test oo-35.4 {Bug 593baa032c: mixins list teardown} {
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