Improving the singleton

5 files changed, 46 insertions, 12 deletions

diff --git a/doc/abstract.n b/doc/abstract.n
index c11202b..022c24b 100644
--- a/doc/abstract.n
+++ b/doc/abstract.n
@@ -36,7 +36,9 @@ The \fBoo::abstract\fR class does not define an explicit constructor; this
 means that it is effectively the same as the constructor of the
 \fBoo::class\fR class.
 .SS DESTRUCTOR
-The \fBoo::abstract\fR class does not define an explicit destructor.
+The \fBoo::abstract\fR class does not define an explicit destructor;
+destroying an instance of it is just like destroying an ordinary class (and
+will destroy all its subclasses).
 .SS "EXPORTED METHODS"
 The \fBoo::abstract\fR class defines no new exported methods.
 .SS "NON-EXPORTED METHODS"
diff --git a/doc/define.n b/doc/define.n
index 099e59f..860218f 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -1,5 +1,5 @@
 '\"
-'\" Copyright (c) 2007 Donal K. Fellows
+'\" Copyright (c) 2007-2018 Donal K. Fellows
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/doc/singleton.n b/doc/singleton.n
index 6319abe..568a8bd 100644
--- a/doc/singleton.n
+++ b/doc/singleton.n
@@ -32,16 +32,20 @@ not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
 inherited. It is not recommended that a singleton class's constructor take any
 arguments.
 .PP
-Instances have their\fB destroy\fR method (from \fBoo::object\fR) unexported
-in order to discourage destruction of the object, but destruction remains
-possible if strictly necessary (e.g., by destroying the class or using
-\fBrename\fR to delete it).
+Instances have their\fB destroy\fR method overridden with a method that always
+returns an error in order to discourage destruction of the object, but
+destruction remains possible if strictly necessary (e.g., by destroying the
+class or using \fBrename\fR to delete it). They also have a (non-exported)
+\fB<cloned>\fR method defined on them that similarly always returns errors to
+make attempts to use the singleton instance with \fBoo::copy\fR fail.
 .SS CONSTRUCTOR
 The \fBoo::singleton\fR class does not define an explicit constructor; this
 means that it is effectively the same as the constructor of the
 \fBoo::class\fR class.
 .SS DESTRUCTOR
-The \fBoo::singleton\fR class does not define an explicit destructor.
+The \fBoo::singleton\fR class does not define an explicit destructor;
+destroying an instance of it is just like destroying an ordinary class (and
+will destroy the singleton object).
 .SS "EXPORTED METHODS"
 .TP
 \fIcls \fBnew \fR?\fIarg ...\fR?
@@ -53,11 +57,13 @@ manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
 method.
 .RS
 .PP
-This is an override of the behaviour of a superclass's method.
+This is an override of the behaviour of a superclass's method with an
+identical call signature to the superclass's implementation.
 .RE
 .SS "NON-EXPORTED METHODS"
 The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
-\fBcreateWithNamespace\fR are unexported.
+\fBcreateWithNamespace\fR are unexported; callers should not assume that they
+have control over either the name or the namespace name of the singleton instance.
 .SH EXAMPLE
 .PP
 This example demonstrates that there is only one instance even though the
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index 237bff5..d96ee76 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -161,7 +161,12 @@ static const char *tclOOSetupScript =
 "    method new args {\n"
 "        if {![info exists object] || ![info object isa object $object]} {\n"
 "            set object [next {*}$args]\n"
-"            ::oo::objdefine $object unexport destroy\n"
+"            ::oo::objdefine $object method destroy {} {\n"
+"                return -code error {may not destroy a singleton object}\n"
+"            }\n"
+"            ::oo::objdefine $object method <cloned> {originObject} {\n"
+"                return -code error {may not clone a singleton object}\n"
+"            }\n"
 "        }\n"
 "        return $object\n"
 "    }\n"
diff --git a/tests/ooUtil.test b/tests/ooUtil.test
index 28ab9c7..e00c70c 100644
--- a/tests/ooUtil.test
+++ b/tests/ooUtil.test
@@ -298,12 +298,33 @@ test ooUtil-4.1 {TIP 478: singleton} -setup {
     set z [xyz new]
     set code [catch {$x destroy} msg]
     set p [xyz new]
-    lappend code $msg [catch {rename $x ""}]
+    lappend code [catch {rename $x ""}]
     set q [xyz new]
     string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
 } -cleanup {
     parent destroy
-} -result {1 {object "ONE" has no visible methods} 0 ONE ONE ONE ONE TWO TWO}
+} -result {1 0 ONE ONE ONE ONE TWO TWO}
+test ooUtil-4.2 {TIP 478: singleton errors} -setup {
+    oo::class create parent
+} -body {
+    oo::singleton create xyz {
+	superclass parent
+    }
+    [xyz new] destroy
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {may not destroy a singleton object}
+test ooUtil-4.3 {TIP 478: singleton errors} -setup {
+    oo::class create parent
+} -body {
+    oo::singleton create xyz {
+	superclass parent
+    }
+    oo::copy [xyz new]
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {may not clone a singleton object}
+
 
 test ooUtil-5.1 {TIP 478: abstract} -setup {
     oo::class create parent