From 84481c3d32d19d3c3d8bdc97d6b378fb9665ced7 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Tue, 13 Jun 2017 11:10:11 +0000
Subject: Add tests and docs.

---
 doc/define.n  |  15 ++++++++
 tests/oo.test | 107 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 122 insertions(+)

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
-- 
cgit v0.12