From 77aceb5c5fa1c705713e90b474e94be2799f233a Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Sun, 15 Jul 2018 15:46:33 +0000
Subject: Added more tests and made [initialize] an alternate spelling for
 [initialise].

---
 doc/define.n          |  2 ++
 generic/tclOOScript.h | 45 +++++++++++++++++++++++++++------------------
 tests/ooUtil.test     | 45 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 74 insertions(+), 18 deletions(-)

diff --git a/doc/define.n b/doc/define.n
index 860218f..6353d00 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -132,6 +132,8 @@ below), this command creates private forwarded methods.
 .RE
 .TP
 \fBinitialise\fI script\fR
+.TP
+\fBinitialize\fI script\fR
 .VS TIP478
 This evaluates \fIscript\fR in a context which supports local variables and
 where the current namespace is the instance namespace of the class object
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index 4b58337..ffdedb8 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -73,21 +73,6 @@ static const char *tclOOSetupScript =
 "    string cat [info object namespace $class] {:: oo ::delegate}\n"
 "}\n"
 
-"proc ::oo::define::classmethod {name {args {}} {body {}}} {\n"
-"    # Create the method on the class if the caller gave arguments and body\n"
-"    set argc [llength [info level 0]]\n"
-"    if {$argc == 3} {\n"
-"        return -code error [string cat {wrong # args: should be \"}"
-"                [lindex [info level 0] 0] { name ?args body?\"}]\n"
-"    }\n"
-"    set cls [uplevel 1 self]\n"
-"    if {$argc == 4} {\n"
-"        ::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
-"    }\n"
-"    # Make the connection by forwarding\n"
-"    tailcall forward $name myclass $name\n"
-"}\n"
-
 "proc ::oo::MixinClassDelegates {class} {\n"
 "    if {![info object isa class $class]} {\n"
 "        return\n"
@@ -106,9 +91,33 @@ static const char *tclOOSetupScript =
 "    ::oo::objdefine $class mixin -append $delegate\n"
 "}\n"
 
-"::proc ::oo::define::initialise {body} {\n"
-"    set clsns [info object namespace [uplevel 1 self]]\n"
-"    tailcall apply [list {} $body $clsns]\n"
+"::namespace eval ::oo::define {"
+"    ::proc classmethod {name {args {}} {body {}}} {\n"
+"        # Create the method on the class if the caller gave arguments and body\n"
+"        ::set argc [::llength [::info level 0]]\n"
+"        ::if {$argc == 3} {\n"
+"            ::return -code error [::string cat {wrong # args: should be \"}"
+"                    [::lindex [::info level 0] 0] { name ?args body?\"}]\n"
+"        }\n"
+"        ::set cls [::uplevel 1 self]\n"
+"        ::if {$argc == 4} {\n"
+"            ::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
+"        }\n"
+"        # Make the connection by forwarding\n"
+"        ::tailcall forward $name myclass $name\n"
+"    }\n"
+
+"    ::proc initialise {body} {\n"
+"        ::set clsns [::info object namespace [::uplevel 1 self]]\n"
+"        ::tailcall apply [::list {} $body $clsns]\n"
+"    }\n"
+
+"    # Make the initialise command appear with US spelling too\n"
+"    ::namespace export initialise\n"
+"    ::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
+"    ::rename ::oo::define::tmp::initialise initialize\n"
+"    ::namespace delete tmp\n"
+"    ::namespace export -clear\n"
 "}\n"
 
 "::oo::define ::oo::Slot {\n"
diff --git a/tests/ooUtil.test b/tests/ooUtil.test
index e00c70c..e796637 100644
--- a/tests/ooUtil.test
+++ b/tests/ooUtil.test
@@ -286,6 +286,51 @@ test ooUtil-3.2 {TIP 478: class variables} -setup {
 } -cleanup {
     parent destroy
 } -result {124 125 126 127 128 129}
+test ooUtil-3.3 {TIP 478: class initialisation} -setup {
+    oo::class create parent
+    catch {rename ::foobar-3.3 {}}
+} -body {
+    oo::class create ::cls {
+	superclass parent
+	initialize {
+	    proc foobar-3.3 {} {return ok}
+	}
+	method calls {} {
+	    list [catch foobar-3.3 msg] $msg \
+		[namespace eval [info object namespace [self class]] foobar-3.3]
+	}
+    }
+    [cls new] calls
+} -cleanup {
+    parent destroy
+} -result {1 {invalid command name "foobar-3.3"} ok}
+test ooUtil-3.4 {TIP 478: class initialisation} -setup {
+    oo::class create parent
+    catch {rename ::appendToResultVar {}}
+    proc ::appendToResultVar args {
+	lappend ::result {*}$args
+    }
+    set result {}
+} -body {
+    trace add execution oo::define::initialise enter appendToResultVar
+    oo::class create ::cls {
+	superclass parent
+	initialize {proc xyzzy {} {}}
+    }
+    return $result
+} -cleanup {
+    catch {
+	trace remove execution oo::define::initialise enter appendToResultVar
+    }
+    rename ::appendToResultVar {}
+    parent destroy
+} -result {{initialize {proc xyzzy {} {}}} enter}
+test ooUtil-3.5 {TIP 478: class initialisation} -body {
+    oo::define oo::object {
+	::list [::namespace which initialise] [::namespace which initialize] \
+	     [::namespace origin initialise] [::namespace origin initialize]
+    }
+} -result {::oo::define::initialise ::oo::define::initialize ::oo::define::initialise ::oo::define::initialise}
 
 test ooUtil-4.1 {TIP 478: singleton} -setup {
     oo::class create parent
-- 
cgit v0.12