Merge 8.7

12 files changed, 2877 insertions, 73 deletions

diff --git a/doc/configurable.n b/doc/configurable.n
new file mode 100644
index 0000000..6477894
--- /dev/null
+++ b/doc/configurable.n
@@ -0,0 +1,334 @@
+'\"
+'\" Copyright © 2019 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH configurable n 0.1 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::configurable, configure, property \- class that makes configurable classes and objects, and supports making configurable properties
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::configurable create \fIclass\fR \fR?\fIdefinitionScript\fR?
+
+\fBoo::define \fIclass\fB {\fR
+    \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...?
+\fB}\fR
+
+\fBoo::objdefine \fIobject\fB {\fR
+    \fBproperty \fIpropName\fR ?\fIoptions...\fR? ?\fIpropName\fR ?\fIoptions...\fR?...?
+\fB}\fR
+
+\fIobjectName \fBconfigure\fR
+\fIobjectName \fBconfigure\fR \fI\-prop\fR
+\fIobjectName \fBconfigure\fR \fI\-prop value\fR ?\fI\-prop value\fR...\fR
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+   \(-> \fBoo::class\fR
+       \(-> \fBoo::configurable\fR
+
+\fBoo::object\fR
+   \(-> \fBoo::class\fR
+       \(-> \fBoo::configurablesupport::configurable\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+Configurable objects are objects that support being configured with a
+\fBconfigure\fR method. Each of the configurable entities of the object is
+known as a property of the object. Properties may be defined on classes or
+instances; when configuring an object, any of the properties defined by its
+classes (direct or indirect) or by the instance itself may be configured.
+.PP
+The \fBoo::configurable\fR metaclass installs basic support for making
+configurable objects into a class. This consists of making a \fBproperty\fR
+definition command available in definition scripts for the class and instances
+(e.g., from the class's constructor, within \fBoo::define\fR and within
+\fBoo::objdefine\fR) and making a \fBconfigure\fR method available within the
+instances.
+.SS "CONFIGURE METHOD"
+.PP
+The behavior of the \fBconfigure\fR method is modelled after the
+\fBfconfigure\fR/\fBchan configure\fR command.
+.PP
+If passed no additional arguments, the \fBconfigure\fR method returns an
+alphabetically sorted dictionary of all \fIreadable\fR and \fIread-write\fR
+properties and their current values.
+.PP
+If passed a single additional argument, that argument to the \fBconfigure\fR
+method must be the name of a property to read (or an unambiguous prefix
+thereof); its value is returned.
+.PP
+Otherwise, if passed an even number of arguments then each pair of arguments
+specifies a property name (or an unambiguous prefix thereof) and the value to
+set it to. The properties will be set in the order specified, including
+duplicates. If the setting of any property fails, the overall \fBconfigure\fR
+method fails, the preceding pairs (if any) will continue to have been applied,
+and the succeeding pairs (if any) will be not applied. On success, the result
+of the \fBconfigure\fR method in this mode operation will be an empty string.
+.SS "PROPERTY DEFINITIONS"
+.PP
+When a class has been manufactured by the \fBoo::configurable\fR metaclass (or
+one of its subclasses), it gains an extra definition, \fBproperty\fR. The
+\fBproperty\fR definition defines one or more properties that will be exposed
+by the class's instances.
+.PP
+The \fBproperty\fR command takes the name of a property to define first,
+\fIwithout a leading hyphen\fR, followed by a number of option-value pairs
+that modify the basic behavior of the property. This can then be followed by
+an arbitrary number of other property definitions. The supported options are:
+.TP
+\fB\-get \fIgetterScript\fR
+.
+This defines the implementation of how to read from the property; the
+\fIgetterScript\fR will become the body of a method (taking no arguments)
+defined on the class, if the kind of the property is such that the property
+can be read from. The method will be named
+\fB<ReadProp-\fIpropertyName\fB>\fR, and will default to being a simple read
+of the instance variable with the same name as the property (e.g.,
+.QW "\fBproperty\fR xyz"
+will result in a method
+.QW <ReadProp-xyz>
+being created).
+.TP
+\fB\-kind \fIpropertyKind\fR
+.
+This defines what sort of property is being created. The \fIpropertyKind\fR
+must be exactly one of \fBreadable\fR, \fBwritable\fR, or \fBreadwrite\fR
+(which is the default) which will make the property read-only, write-only or
+read-write, respectively.  Read-only properties can only ever be read from,
+write-only properties can only ever be written to, and read-write properties
+can be both read and written.
+.RS
+.PP
+Note that write-only properties are not particularly discoverable as they are
+never reported by the \fBconfigure\fR method other than by error messages when
+attempting to write to a property that does not exist.
+.RE
+.TP
+\fB\-set \fIsetterScript\fR
+.
+This defines the implementation of how to write to the property; the
+\fIsetterScript\fR will become the body of a method taking a single argument,
+\fIvalue\fR, defined on the class, if the kind of the property is such that
+the property can be written to. The method will be named
+\fB<WriteProp-\fIpropertyName\fB>\fR, and will default to being a simple write
+of the instance variable with the same name as the property (e.g.,
+.QW "\fBproperty\fR xyz"
+will result in a method
+.QW <WriteProp-xyz>
+being created).
+.PP
+Instances of the class that was created by \fBoo::configurable\fR will also
+support \fBproperty\fR definitions; the semantics will be exactly as above
+except that the properties will be defined on the instance alone.
+.PP
+Note that the property implementation methods that \fBproperty\fR defines
+should not be private, as this makes them inaccessible from the implementation
+of \fBconfigure\fR (by design; the property configuration mechanism is
+intended for use mainly from outside a class, whereas a class may access
+variables directly). The variables accessed by the default implementations of
+the properties \fImay\fR be private, if so declared.
+.SH "ADVANCED USAGE"
+.PP
+The configurable class system is comprised of several pieces. The
+\fBoo::configurable\fR metaclass works by mixing in a class and setting
+definition namespaces during object creation that provide the other bits and
+pieces of machinery. The key pieces of the implementation are enumerated here
+so that they can be used by other code:
+.TP
+\fBoo::configuresupport::configurable\fR
+.
+This is a class that provids the implementation of the \fBconfigure\fR method
+(described above in \fBCONFIGURE METHOD\fR).
+.TP
+\fBoo::configuresupport::configurableclass\fR
+.
+This is a namespace that contains the definition dialect that provides the
+\fBproperty\fR declaration for use in classes (i.e., via \fBoo::define\fR, and
+class constructors under normal circumstances), as described above in
+\fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its \fBproperty\fR
+command so that it may be used easily in user definition dialects.
+.TP
+.
+\fBoo::configuresupport::configurableobject\fR
+.
+This is a namespace that contains the definition dialect that provides the
+\fBproperty\fR declaration for use in instance objects (i.e., via
+\fBoo::objdefine\fR, and the\fB self\R declaration in \fBoo::define), as
+described above in \fBPROPERTY DEFINITIONS\fR. It \fBnamespace export\fRs its
+\fBproperty\fR command so that it may be used easily in user definition
+dialects.
+.PP
+The underlying property discovery mechanism relies on four slots (see
+\fBoo::define\fR for what that implies) that list the properties that can be
+configured. These slots do not themselves impose any semantics on what the
+slots mean other than that they have unique names, no important order, can be
+inherited and discovered on classes and instances.
+.PP
+These slots, and their intended semantics, are:
+.TP
+\fBoo::configuresupport::readableproperties\fR
+.
+The set of properties of a class (not including those from its superclasses)
+that may be read from when configuring an instance of the class. This slot can
+also be read with the \fBinfo class properties\fR command.
+.TP
+\fBoo::configuresupport::writableproperties\fR
+.
+The set of properties of a class (not including those from its superclasses)
+that may be written to when configuring an instance of the class. This slot
+can also be read with the \fBinfo class properties\fR command.
+.TP
+\fBoo::configuresupport::objreadableproperties\fR
+.
+The set of properties of an object instance (not including those from its
+classes) that may be read from when configuring the object. This slot can
+also be read with the \fBinfo object properties\fR command.
+.TP
+\fBoo::configuresupport::objwritableproperties\fR
+.
+The set of properties of an object instance (not including those from its
+classes) that may be written to when configuring the object. This slot can
+also be read with the \fBinfo object properties\fR command.
+.PP
+Note that though these are slots, they are \fInot\fR in the standard
+\fBoo::define\fR or \fBoo::objdefine\fR namespaces; in order to use them
+inside a definition script, they need to be referred to by full name. This is
+because they are intended to be building bricks of configurable property
+system, and not directly used by normal user code.
+.SS "IMPLEMENTATION NOTE"
+.PP
+The implementation of the \fBconfigure\fR method uses
+\fBinfo object properties\fR with the \fB\-all\fR option to discover what
+properties it may manipulate.
+.SH EXAMPLES
+.PP
+Here we create a simple configurable class and demonstrate how it can be
+configured:
+.PP
+.CS
+\fBoo::configurable\fR create Point {
+    \fBproperty\fR x y
+    constructor args {
+        my \fBconfigure\fR -x 0 -y 0 {*}$args
+    }
+    variable x y
+    method print {} {
+        puts "x=$x, y=$y"
+    }
+}
+
+set pt [Point new -x 27]
+$pt print;   \fI# x=27, y=0\fR
+$pt \fBconfigure\fR -y 42
+$pt print;   \fI# x=27, y=42\fR
+puts "distance from origin: [expr {
+    hypot([$pt \fBconfigure\fR -x], [$pt \fBconfigure\fR -y])
+}]";         \fI# distance from origin: 49.92995093127971\fR
+puts [$pt \fBconfigure\fR]
+             \fI# -x 27 -y 42\fR
+.CE
+.PP
+Such a configurable class can be extended by subclassing, though the subclass
+needs to also be created by \fBoo::configurable\fR if it will use the
+\fBproperty\fR definition:
+.PP
+.CS
+\fBoo::configurable\fR create Point3D {
+    superclass Point
+    \fBproperty\fR z
+    constructor args {
+        next -z 0 {*}$args
+    }
+}
+
+set pt2 [Point3D new -x 2 -y 3 -z 4]
+puts [$pt2 \fBconfigure\fR]
+             \fI# -x 2 -y 3 -z 4\fR
+.CE
+.PP
+Once you have a configurable class, you can also add instance properties to
+it. (The backing variables for all properties start unset.) Note below that we
+are using an unambiguous prefix of a property name when setting it; this is
+supported for all properties though full names are normally recommended
+because subclasses will not make an unambiguous prefix become ambiguous in
+that case.
+.PP
+.CS
+oo::objdefine $pt {
+    \fBproperty\fR color
+}
+$pt \fBconfigure\fR -c bisque
+puts [$pt \fBconfigure\fR]
+             \fI# -color bisque -x 27 -y 42\fR
+.CE
+.PP
+You can also do derived properties by making them read-only and supplying a
+script that computes them.
+.PP
+.CS
+\fBoo::configurable\fR create PointMk2 {
+    \fBproperty\fR x y
+    \fBproperty\fR distance -kind readable -get {
+        return [expr {hypot($x, $y)}]
+    }
+    variable x y
+    constructor args {
+        my \fBconfigure\fR -x 0 -y 0 {*}$args
+    }
+}
+
+set pt3 [PointMk2 new -x 3 -y 4]
+puts [$pt3 \fBconfigure\fR -distance]
+             \fI# 5.0\fR
+$pt3 \fBconfigure\fR -distance 10
+             \fI# ERROR: bad property "-distance": must be -x or -y\fR
+.CE
+.PP
+Setters are used to validate the type of a property:
+.PP
+.CS
+\fBoo::configurable\fR create PointMk3 {
+    \fBproperty\fR x -set {
+        if {![string is double -strict $value]} {
+            error "-x property must be a number"
+        }
+        set x $value
+    }
+    \fBproperty\fR y -set {
+        if {![string is double -strict $value]} {
+            error "-y property must be a number"
+        }
+        set y $value
+    }
+    variable x y
+    constructor args {
+        my \fBconfigure\fR -x 0 -y 0 {*}$args
+    }
+}
+
+set pt4 [PointMk3 new]
+puts [$pt4 \fBconfigure\fR]
+             \fI# -x 0 -y 0\fR
+$pt4 \fBconfigure\fR -x 3 -y 4
+puts [$pt4 \fBconfigure\fR]
+             \fI# -x 3 -y 4\fR
+$pt4 \fBconfigure\fR -x "obviously not a number"
+             \fI# ERROR: -x property must be a number\fR
+.CE
+.SH "SEE ALSO"
+info(n), oo::class(n), oo::define(n)
+.SH KEYWORDS
+class, object, properties, configuration
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/define.n b/doc/define.n
index f1e799b..c5e93ac 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -493,6 +493,12 @@ the slot:
 .
 This appends the given \fImember\fR elements to the slot definition.
 .TP
+\fIslot\fR \fB\-appendifnew\fR ?\fImember ...\fR?
+.VS TIP558
+This appends the given \fImember\fR elements to the slot definition if they
+do not already exist.
+.VE TIP558
+.TP
 \fIslot\fR \fB\-clear\fR
 .
 This sets the slot definition to the empty list.
diff --git a/doc/info.n b/doc/info.n
index 8a61ba9..b84b2c7 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -490,6 +490,29 @@ be discovered with \fBinfo class forward\fR.
 This subcommand returns a list of all classes that have been mixed into the
 class named \fIclass\fR.
 .TP
+\fBinfo class properties\fI class\fR ?\fIoptions...\fR
+.VS "TIP 558"
+This subcommand returns a sorted list of properties defined on the class named
+\fIclass\fR. The \fIoptions\fR define exactly which properties are returned:
+.RS
+.TP
+\fB\-all\fR
+.
+With this option, the properties from the superclasses and mixins of the class
+are also returned.
+.TP
+\fB\-readable\fR
+.
+This option (the default behavior) asks for the readable properties to be
+returned. Only readable or writable properties are returned, not both.
+.TP
+\fB\-writable\fR
+.
+This option asks for the writable properties to be returned.  Only readable or
+writable properties are returned, not both.
+.RE
+.VE "TIP 558"
+.TP
 \fBinfo class subclasses\fI class\fR ?\fIpattern\fR?
 .
 This subcommand returns a list of direct subclasses of class \fIclass\fR. If
@@ -679,6 +702,30 @@ object named \fIobject\fR.
 This subcommand returns the name of the internal namespace of the object named
 \fIobject\fR.
 .TP
+\fBinfo object properties\fI object\fR ?\fIoptions...\fR
+.VS "TIP 558"
+This subcommand returns a sorted list of properties defined on the object
+named \fIobject\fR. The \fIoptions\fR define exactly which properties are
+returned:
+.RS
+.TP
+\fB\-all\fR
+.
+With this option, the properties from the class, superclasses and mixins of
+the object are also returned.
+.TP
+\fB\-readable\fR
+.
+This option (the default behavior) asks for the readable properties to be
+returned. Only readable or writable properties are returned, not both.
+.TP
+\fB\-writable\fR
+.
+This option asks for the writable properties to be returned. Only readable or
+writable properties are returned, not both.
+.RE
+.VE "TIP 558"
+.TP
 \fBinfo object variables\fI object\fRR ?\fB\-private\fR?
 .
 This subcommand returns a list of all variables that have been declared for
diff --git a/generic/tclOO.c b/generic/tclOO.c
index b05fe1f..8bf29fe 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -3,7 +3,7 @@
  *
  *	This file contains the object-system core (NB: not Tcl_Obj, but ::oo)
  *
- * Copyright © 2005-2012 Donal K. Fellows
+ * Copyright © 2005-2019 Donal K. Fellows
  * Copyright © 2017 Nathan Coulter
  *
  * See the file "license.terms" for information on usage and redistribution of
@@ -327,6 +327,7 @@ InitFoundation(
 	    DeletedObjdefNamespace);
     fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
 	    DeletedHelpersNamespace);
+    Tcl_CreateNamespace(interp, "::oo::configuresupport", NULL, NULL);
     fPtr->epoch = 1;
     fPtr->tsdPtr = tsdPtr;
     TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
@@ -964,7 +965,7 @@ TclOOReleaseClassContents(
     Class *clsPtr = oPtr->classPtr, *tmpClsPtr;
     Method *mPtr;
     Foundation *fPtr = oPtr->fPtr;
-    Tcl_Obj *variableObj;
+    Tcl_Obj *variableObj, *propertyObj;
     PrivateVariableMapping *privateVariable;
 
     /*
@@ -1018,6 +1019,29 @@ TclOOReleaseClassContents(
     }
 
     /*
+     * Squelch the property lists.
+     */
+
+    if (clsPtr->properties.allReadableCache) {
+	Tcl_DecrRefCount(clsPtr->properties.allReadableCache);
+    }
+    if (clsPtr->properties.allWritableCache) {
+	Tcl_DecrRefCount(clsPtr->properties.allWritableCache);
+    }
+    if (clsPtr->properties.readable.num) {
+	FOREACH(propertyObj, clsPtr->properties.readable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	ckfree(clsPtr->properties.readable.list);
+    }
+    if (clsPtr->properties.writable.num) {
+	FOREACH(propertyObj, clsPtr->properties.writable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	ckfree(clsPtr->properties.writable.list);
+    }
+
+    /*
      * Squelch our filter list.
      */
 
@@ -1118,7 +1142,7 @@ ObjectNamespaceDeleted(
     FOREACH_HASH_DECLS;
     Class *mixinPtr;
     Method *mPtr;
-    Tcl_Obj *filterObj, *variableObj;
+    Tcl_Obj *filterObj, *variableObj, *propertyObj;
     PrivateVariableMapping *privateVariable;
     Tcl_Interp *interp = oPtr->fPtr->interp;
     Tcl_Size i;
@@ -1272,6 +1296,29 @@ ObjectNamespaceDeleted(
     }
 
     /*
+     * Squelch the property lists.
+     */
+
+    if (oPtr->properties.allReadableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allReadableCache);
+    }
+    if (oPtr->properties.allWritableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allWritableCache);
+    }
+    if (oPtr->properties.readable.num) {
+	FOREACH(propertyObj, oPtr->properties.readable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	ckfree(oPtr->properties.readable.list);
+    }
+    if (oPtr->properties.writable.num) {
+	FOREACH(propertyObj, oPtr->properties.writable) {
+	    Tcl_DecrRefCount(propertyObj);
+	}
+	ckfree(oPtr->properties.writable.list);
+    }
+
+    /*
      * Because an object can be a class that is an instance of itself, the
      * class object's class structure should only be cleaned after most of
      * the cleanup on the object is done.
diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 5c9c986..39fd020 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -2,9 +2,10 @@
  * tclOOCall.c --
  *
  *	This file contains the method call chain management code for the
- *	object-system core.
+ *	object-system core. It also contains everything else that does
+ *	inheritance hierarchy traversal.
  *
- * Copyright © 2005-2012 Donal K. Fellows
+ * Copyright © 2005-2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -58,6 +59,7 @@ typedef struct {
 #define BUILDING_MIXINS	   0x400000
 #define TRAVERSED_MIXIN	   0x800000
 #define OBJECT_MIXIN	   0x1000000
+#define DEFINE_FOR_CLASS   0x2000000
 #define MIXIN_CONSISTENT(flags) \
     (((flags) & OBJECT_MIXIN) ||					\
 	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
@@ -1907,7 +1909,7 @@ TclOOGetDefineContextNamespace(
     DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
     DefineEntry *entryPtr;
     Tcl_Namespace *nsPtr = NULL;
-    int i;
+    int i, flags = (forClass ? DEFINE_FOR_CLASS : 0);
 
     define.list = staticSpace;
     define.num = 0;
@@ -1918,8 +1920,8 @@ TclOOGetDefineContextNamespace(
      * class mixins right.
      */
 
-    AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
-    AddSimpleDefineNamespaces(oPtr, &define, forClass);
+    AddSimpleDefineNamespaces(oPtr, &define, flags | BUILDING_MIXINS);
+    AddSimpleDefineNamespaces(oPtr, &define, flags);
 
     /*
      * Go through the list until we find a namespace whose name we can
@@ -2003,7 +2005,7 @@ AddSimpleClassDefineNamespaces(
 		flags | TRAVERSED_MIXIN);
     }
 
-    if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
+    if (flags & DEFINE_FOR_CLASS) {
 	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
 		definePtr, flags);
     } else {
@@ -2113,6 +2115,259 @@ AddDefinitionNamespaceToChain(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * FindClassProps --
+ *
+ *	Discover the properties known to a class and its superclasses.
+ *	The property names become the keys in the accumulator hash table
+ *	(which is used as a set).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+FindClassProps(
+    Class *clsPtr,		/* The object to inspect. Must exist. */
+    int writable,		/* Whether we're after the readable or writable
+				 * property set. */
+    Tcl_HashTable *accumulator)	/* Where to gather the names. */
+{
+    int i, dummy;
+    Tcl_Obj *propName;
+    Class *mixin, *sup;
+
+  tailRecurse:
+    if (writable) {
+	FOREACH(propName, clsPtr->properties.writable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    } else {
+	FOREACH(propName, clsPtr->properties.readable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    }
+    if (clsPtr->thisPtr->flags & ROOT_OBJECT) {
+	/*
+	 * We do *not* traverse upwards from the root!
+	 */
+	return;
+    }
+    FOREACH(mixin, clsPtr->mixins) {
+	FindClassProps(mixin, writable, accumulator);
+    }
+    if (clsPtr->superclasses.num == 1) {
+	clsPtr = clsPtr->superclasses.list[0];
+	goto tailRecurse;
+    }
+    FOREACH(sup, clsPtr->superclasses) {
+	FindClassProps(sup, writable, accumulator);
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * FindObjectProps --
+ *
+ *	Discover the properties known to an object and all its classes.
+ *	The property names become the keys in the accumulator hash table
+ *	(which is used as a set).
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+FindObjectProps(
+    Object *oPtr,		/* The object to inspect. Must exist. */
+    int writable,		/* Whether we're after the readable or writable
+				 * property set. */
+    Tcl_HashTable *accumulator)	/* Where to gather the names. */
+{
+    int i, dummy;
+    Tcl_Obj *propName;
+    Class *mixin;
+
+    if (writable) {
+	FOREACH(propName, oPtr->properties.writable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    } else {
+	FOREACH(propName, oPtr->properties.readable) {
+	    Tcl_CreateHashEntry(accumulator, (void *) propName, &dummy);
+	}
+    }
+    FOREACH(mixin, oPtr->mixins) {
+	FindClassProps(mixin, writable, accumulator);
+    }
+    FindClassProps(oPtr->selfCls, writable, accumulator);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetAllClassProperties --
+ *
+ *	Get the list of all properties known to a class, including to its
+ *	superclasses. Manages a cache so this operation is usually cheap.
+ *	The order of properties in the resulting list is undefined.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOOGetAllClassProperties(
+    Class *clsPtr,		/* The class to inspect. Must exist. */
+    int writable,		/* Whether to get writable properties. If
+				 * false, readable properties will be returned
+				 * instead. */
+    int *allocated)		/* Address of variable to set to true if a
+				 * Tcl_Obj was allocated and may be safely
+				 * modified by the caller. */
+{
+    Tcl_HashTable hashTable;
+    FOREACH_HASH_DECLS;
+    Tcl_Obj *propName, *result;
+    void *dummy;
+
+    /*
+     * Look in the cache.
+     */
+
+    if (clsPtr->properties.epoch == clsPtr->thisPtr->fPtr->epoch) {
+	if (writable) {
+	    if (clsPtr->properties.allWritableCache) {
+		*allocated = 0;
+		return clsPtr->properties.allWritableCache;
+	    }
+	} else {
+	    if (clsPtr->properties.allReadableCache) {
+		*allocated = 0;
+		return clsPtr->properties.allReadableCache;
+	    }
+	}
+    }
+
+    /*
+     * Gather the information. Unsorted! (Caller will sort.)
+     */
+
+    *allocated = 1;
+    Tcl_InitObjHashTable(&hashTable);
+    FindClassProps(clsPtr, writable, &hashTable);
+    result = Tcl_NewObj();
+    FOREACH_HASH(propName, dummy, &hashTable) {
+	Tcl_ListObjAppendElement(NULL, result, propName);
+    }
+    Tcl_DeleteHashTable(&hashTable);
+
+    /*
+     * Cache the information. Also purges the cache.
+     */
+
+    if (clsPtr->properties.epoch != clsPtr->thisPtr->fPtr->epoch) {
+	if (clsPtr->properties.allWritableCache) {
+	    Tcl_DecrRefCount(clsPtr->properties.allWritableCache);
+	    clsPtr->properties.allWritableCache = NULL;
+	}
+	if (clsPtr->properties.allReadableCache) {
+	    Tcl_DecrRefCount(clsPtr->properties.allReadableCache);
+	    clsPtr->properties.allReadableCache = NULL;
+	}
+    }
+    clsPtr->properties.epoch = clsPtr->thisPtr->fPtr->epoch;
+    if (writable) {
+	clsPtr->properties.allWritableCache = result;
+    } else {
+	clsPtr->properties.allReadableCache = result;
+    }
+    Tcl_IncrRefCount(result);
+    return result;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetAllObjectProperties --
+ *
+ *	Get the list of all properties known to a object, including to its
+ *	classes. Manages a cache so this operation is usually cheap.
+ *	The order of properties in the resulting list is undefined.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclOOGetAllObjectProperties(
+    Object *oPtr,		/* The object to inspect. Must exist. */
+    int writable,		/* Whether to get writable properties. If
+				 * false, readable properties will be returned
+				 * instead. */
+    int *allocated)		/* Address of variable to set to true if a
+				 * Tcl_Obj was allocated and may be safely
+				 * modified by the caller. */
+{
+    Tcl_HashTable hashTable;
+    FOREACH_HASH_DECLS;
+    Tcl_Obj *propName, *result;
+    void *dummy;
+
+    /*
+     * Look in the cache.
+     */
+
+    if (oPtr->properties.epoch == oPtr->fPtr->epoch) {
+	if (writable) {
+	    if (oPtr->properties.allWritableCache) {
+		*allocated = 0;
+		return oPtr->properties.allWritableCache;
+	    }
+	} else {
+	    if (oPtr->properties.allReadableCache) {
+		*allocated = 0;
+		return oPtr->properties.allReadableCache;
+	    }
+	}
+    }
+
+    /*
+     * Gather the information. Unsorted! (Caller will sort.)
+     */
+
+    *allocated = 1;
+    Tcl_InitObjHashTable(&hashTable);
+    FindObjectProps(oPtr, writable, &hashTable);
+    result = Tcl_NewObj();
+    FOREACH_HASH(propName, dummy, &hashTable) {
+	Tcl_ListObjAppendElement(NULL, result, propName);
+    }
+    Tcl_DeleteHashTable(&hashTable);
+
+    /*
+     * Cache the information.
+     */
+
+    if (oPtr->properties.epoch != oPtr->fPtr->epoch) {
+	if (oPtr->properties.allWritableCache) {
+	    Tcl_DecrRefCount(oPtr->properties.allWritableCache);
+	    oPtr->properties.allWritableCache = NULL;
+	}
+	if (oPtr->properties.allReadableCache) {
+	    Tcl_DecrRefCount(oPtr->properties.allReadableCache);
+	    oPtr->properties.allReadableCache = NULL;
+	}
+    }
+    oPtr->properties.epoch = oPtr->fPtr->epoch;
+    if (writable) {
+	oPtr->properties.allWritableCache = result;
+    } else {
+	oPtr->properties.allReadableCache = result;
+    }
+    Tcl_IncrRefCount(result);
+    return result;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 84204f9..8879e26 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -4,7 +4,7 @@
  *	This file contains the implementation of the ::oo::define command,
  *	part of the object-system core (NB: not Tcl_Obj, but ::oo).
  *
- * Copyright © 2006-2013 Donal K. Fellows
+ * Copyright © 2006-2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -60,6 +60,7 @@ struct DeclaredSlot {
  */
 
 static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
+static inline void	BumpInstanceEpoch(Object *oPtr);
 static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
 			    Tcl_Namespace *const namespacePtr);
 static inline void	GenerateErrorInfo(Tcl_Interp *interp, Object *oPtr,
@@ -102,6 +103,8 @@ static int		ClassVarsGet(void *clientData,
 static int		ClassVarsSet(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
+static Tcl_MethodCallProc ClassRPropsGet, ClassRPropsSet;
+static Tcl_MethodCallProc ClassWPropsGet, ClassWPropsSet;
 static int		ObjFilterGet(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
@@ -120,6 +123,8 @@ static int		ObjVarsGet(void *clientData,
 static int		ObjVarsSet(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
+static Tcl_MethodCallProc ObjRPropsGet, ObjRPropsSet;
+static Tcl_MethodCallProc ObjWPropsGet, ObjWPropsSet;
 static int		ResolveClass(void *clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
@@ -136,6 +141,14 @@ static const struct DeclaredSlot slots[] = {
     SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
     SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
     SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
+    SLOT("configuresupport::readableproperties",
+	    ClassRPropsGet, ClassRPropsSet, NULL),
+    SLOT("configuresupport::writableproperties",
+	    ClassWPropsGet, ClassWPropsSet, NULL),
+    SLOT("configuresupport::objreadableproperties",
+	    ObjRPropsGet, ObjRPropsSet, NULL),
+    SLOT("configuresupport::objwritableproperties",
+	    ObjWPropsGet, ObjWPropsSet, NULL),
     {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
 };
 
@@ -201,13 +214,26 @@ BumpGlobalEpoch(
 
 	if (classPtr->thisPtr->mixins.num > 0) {
 	    classPtr->thisPtr->epoch++;
+
+	    /*
+	     * Invalidate the property caches directly.
+	     */
+
+	    if (classPtr->properties.allReadableCache) {
+		Tcl_DecrRefCount(classPtr->properties.allReadableCache);
+		classPtr->properties.allReadableCache = NULL;
+	    }
+	    if (classPtr->properties.allWritableCache) {
+		Tcl_DecrRefCount(classPtr->properties.allWritableCache);
+		classPtr->properties.allWritableCache = NULL;
+	    }
 	}
 	return;
     }
 
     /*
      * Either there's no class (?!) or we're reconfiguring something that is
-     * in use. Force regeneration of call chains.
+     * in use. Force regeneration of call chains and properties.
      */
 
     TclOOGetFoundation(interp)->epoch++;
@@ -216,6 +242,33 @@ BumpGlobalEpoch(
 /*
  * ----------------------------------------------------------------------
  *
+ * BumpInstanceEpoch --
+ *
+ *	Advances the epoch and clears the property cache of an object. The
+ *	equivalent for classes is BumpGlobalEpoch(), as classes have a more
+ *	complex set of relationships to other entities.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+BumpInstanceEpoch(
+    Object *oPtr)
+{
+    oPtr->epoch++;
+    if (oPtr->properties.allReadableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allReadableCache);
+	oPtr->properties.allReadableCache = NULL;
+    }
+    if (oPtr->properties.allWritableCache) {
+	Tcl_DecrRefCount(oPtr->properties.allWritableCache);
+	oPtr->properties.allWritableCache = NULL;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * RecomputeClassCacheFlag --
  *
  *	Determine whether the object is prototypical of its class, and hence
@@ -292,7 +345,7 @@ TclOOObjectSetFilters(
 	oPtr->filters.num = numFilters;
 	oPtr->flags &= ~USE_CLASS_CACHE;
     }
-    oPtr->epoch++;		/* Only this object can be affected. */
+    BumpInstanceEpoch(oPtr);	/* Only this object can be affected. */
 }
 
 /*
@@ -415,7 +468,7 @@ TclOOObjectSetMixins(
 	    }
 	}
     }
-    oPtr->epoch++;
+    BumpInstanceEpoch(oPtr);
 }
 
 /*
@@ -482,6 +535,7 @@ TclOOClassSetMixins(
  *
  * ----------------------------------------------------------------------
  */
+
 static inline void
 InstallStandardVariableMapping(
     VariableNameList *vnlPtr,
@@ -1507,7 +1561,7 @@ TclOODefineClassObjCmd(
 	if (oPtr->classPtr != NULL) {
 	    BumpGlobalEpoch(interp, oPtr->classPtr);
 	} else {
-	    oPtr->epoch++;
+	    BumpInstanceEpoch(oPtr);
 	}
     }
     return TCL_OK;
@@ -1717,7 +1771,7 @@ TclOODefineDeleteMethodObjCmd(
     }
 
     if (isInstanceDeleteMethod) {
-	oPtr->epoch++;
+	BumpInstanceEpoch(oPtr);
     } else {
 	BumpGlobalEpoch(interp, oPtr->classPtr);
     }
@@ -1877,7 +1931,7 @@ TclOODefineExportObjCmd(
 
     if (changed) {
 	if (isInstanceExport) {
-	    oPtr->epoch++;
+	    BumpInstanceEpoch(oPtr);
 	} else {
 	    BumpGlobalEpoch(interp, clsPtr);
 	}
@@ -2095,7 +2149,7 @@ TclOODefineRenameMethodObjCmd(
     }
 
     if (isInstanceRenameMethod) {
-	oPtr->epoch++;
+	BumpInstanceEpoch(oPtr);
     } else {
 	BumpGlobalEpoch(interp, oPtr->classPtr);
     }
@@ -2189,7 +2243,7 @@ TclOODefineUnexportObjCmd(
 
     if (changed) {
 	if (isInstanceUnexport) {
-	    oPtr->epoch++;
+	    BumpInstanceEpoch(oPtr);
 	} else {
 	    BumpGlobalEpoch(interp, clsPtr);
 	}
@@ -3082,6 +3136,398 @@ ResolveClass(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * ClassRPropsGet, ClassRPropsSet, ObjRPropsGet, ObjRPropsSet --
+ *
+ *	Implementations of the "readableproperties" slot accessors for classes
+ *	and instances.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InstallReadableProps(
+    PropertyStorage *props,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *propObj;
+    int i, n, created;
+    Tcl_HashTable uniqueTable;
+
+    if (props->allReadableCache) {
+	Tcl_DecrRefCount(props->allReadableCache);
+	props->allReadableCache = NULL;
+    }
+
+    for (i=0 ; i<objc ; i++) {
+	Tcl_IncrRefCount(objv[i]);
+    }
+    FOREACH(propObj, props->readable) {
+	Tcl_DecrRefCount(propObj);
+    }
+    if (i != objc) {
+	if (objc == 0) {
+	    ckfree(props->readable.list);
+	} else if (i) {
+	    props->readable.list = (Tcl_Obj **)ckrealloc(props->readable.list,
+		    sizeof(Tcl_Obj *) * objc);
+	} else {
+	    props->readable.list = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * objc);
+	}
+    }
+    props->readable.num = 0;
+    if (objc > 0) {
+	Tcl_InitObjHashTable(&uniqueTable);
+	for (i=n=0 ; i<objc ; i++) {
+	    Tcl_CreateHashEntry(&uniqueTable, objv[i], &created);
+	    if (created) {
+		props->readable.list[n++] = objv[i];
+	    } else {
+		Tcl_DecrRefCount(objv[i]);
+	    }
+	}
+	props->readable.num = n;
+
+	/*
+	 * Shouldn't be necessary, but maintain num/list invariant.
+	 */
+
+	if (n != objc) {
+	    props->readable.list = (Tcl_Obj **)ckrealloc(props->readable.list,
+		    sizeof(Tcl_Obj *) * n);
+	}
+	Tcl_DeleteHashTable(&uniqueTable);
+    }
+}
+
+static int
+ClassRPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->classPtr->properties.readable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ClassRPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    int varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"filterList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallReadableProps(&oPtr->classPtr->properties, varc, varv);
+    BumpGlobalEpoch(interp, oPtr->classPtr);
+    return TCL_OK;
+}
+
+static int
+ObjRPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->properties.readable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ObjRPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    int varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"filterList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallReadableProps(&oPtr->properties, varc, varv);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * ClassWPropsGet, ClassWPropsSet, ObjWPropsGet, ObjWPropsSet --
+ *
+ *	Implementations of the "writableproperties" slot accessors for classes
+ *	and instances.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+InstallWritableProps(
+    PropertyStorage *props,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_Obj *propObj;
+    int i, n, created;
+    Tcl_HashTable uniqueTable;
+
+    if (props->allWritableCache) {
+	Tcl_DecrRefCount(props->allWritableCache);
+	props->allWritableCache = NULL;
+    }
+
+    for (i=0 ; i<objc ; i++) {
+	Tcl_IncrRefCount(objv[i]);
+    }
+    FOREACH(propObj, props->writable) {
+	Tcl_DecrRefCount(propObj);
+    }
+    if (i != objc) {
+	if (objc == 0) {
+	    ckfree(props->writable.list);
+	} else if (i) {
+	    props->writable.list = (Tcl_Obj **)ckrealloc(props->writable.list,
+		    sizeof(Tcl_Obj *) * objc);
+	} else {
+	    props->writable.list = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * objc);
+	}
+    }
+    props->writable.num = 0;
+    if (objc > 0) {
+	Tcl_InitObjHashTable(&uniqueTable);
+	for (i=n=0 ; i<objc ; i++) {
+	    Tcl_CreateHashEntry(&uniqueTable, objv[i], &created);
+	    if (created) {
+		props->writable.list[n++] = objv[i];
+	    } else {
+		Tcl_DecrRefCount(objv[i]);
+	    }
+	}
+	props->writable.num = n;
+
+	/*
+	 * Shouldn't be necessary, but maintain num/list invariant.
+	 */
+
+	if (n != objc) {
+	    props->writable.list = (Tcl_Obj **)ckrealloc(props->writable.list,
+		    sizeof(Tcl_Obj *) * n);
+	}
+	Tcl_DeleteHashTable(&uniqueTable);
+    }
+}
+
+static int
+ClassWPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->classPtr->properties.writable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ClassWPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    int varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"propertyList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (!oPtr->classPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"attempt to misuse API", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallWritableProps(&oPtr->classPtr->properties, varc, varv);
+    BumpGlobalEpoch(interp, oPtr->classPtr);
+    return TCL_OK;
+}
+
+static int
+ObjWPropsGet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Tcl_Obj *resultObj, *propNameObj;
+    int i;
+
+    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		NULL);
+	return TCL_ERROR;
+    }
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+
+    resultObj = Tcl_NewObj();
+    FOREACH(propNameObj, oPtr->properties.writable) {
+	Tcl_ListObjAppendElement(NULL, resultObj, propNameObj);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+static int
+ObjWPropsSet(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    int varc;
+    Tcl_Obj **varv;
+
+    if (Tcl_ObjectContextSkippedArgs(context) + 1 != objc) {
+	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
+		"propertyList");
+	return TCL_ERROR;
+    }
+    objv += Tcl_ObjectContextSkippedArgs(context);
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
+	    &varv) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    InstallWritableProps(&oPtr->properties, varc, varv);
+    return TCL_OK;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c
index 1f27b41..bbaaf02 100644
--- a/generic/tclOOInfo.c
+++ b/generic/tclOOInfo.c
@@ -4,7 +4,7 @@
  *	This file contains the implementation of the ::oo-related [info]
  *	subcommands.
  *
- * Copyright © 2006-2011 Donal K. Fellows
+ * Copyright © 2006-2019 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,6 +17,7 @@
 #include "tclOOInt.h"
 
 static inline Class *	GetClassFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		SortPropList(Tcl_Obj *list);
 static Tcl_ObjCmdProc InfoObjectCallCmd;
 static Tcl_ObjCmdProc InfoObjectClassCmd;
 static Tcl_ObjCmdProc InfoObjectDefnCmd;
@@ -28,6 +29,7 @@ static Tcl_ObjCmdProc InfoObjectMethodsCmd;
 static Tcl_ObjCmdProc InfoObjectMethodTypeCmd;
 static Tcl_ObjCmdProc InfoObjectMixinsCmd;
 static Tcl_ObjCmdProc InfoObjectNsCmd;
+static Tcl_ObjCmdProc InfoObjectPropCmd;
 static Tcl_ObjCmdProc InfoObjectVarsCmd;
 static Tcl_ObjCmdProc InfoObjectVariablesCmd;
 static Tcl_ObjCmdProc InfoClassCallCmd;
@@ -41,6 +43,7 @@ static Tcl_ObjCmdProc InfoClassInstancesCmd;
 static Tcl_ObjCmdProc InfoClassMethodsCmd;
 static Tcl_ObjCmdProc InfoClassMethodTypeCmd;
 static Tcl_ObjCmdProc InfoClassMixinsCmd;
+static Tcl_ObjCmdProc InfoClassPropCmd;
 static Tcl_ObjCmdProc InfoClassSubsCmd;
 static Tcl_ObjCmdProc InfoClassSupersCmd;
 static Tcl_ObjCmdProc InfoClassVariablesCmd;
@@ -61,6 +64,7 @@ static const EnsembleImplMap infoObjectCmds[] = {
     {"methodtype", InfoObjectMethodTypeCmd, TclCompileBasic2ArgCmd, NULL, NULL, 0},
     {"mixins",	   InfoObjectMixinsCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"namespace",  InfoObjectNsCmd,	    TclCompileInfoObjectNamespaceCmd, NULL, NULL, 0},
+    {"properties", InfoObjectPropCmd,	    TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"variables",  InfoObjectVariablesCmd,  TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {"vars",	   InfoObjectVarsCmd,	    TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {NULL, NULL, NULL, NULL, NULL, 0}
@@ -82,6 +86,7 @@ static const EnsembleImplMap infoClassCmds[] = {
     {"methods",	     InfoClassMethodsCmd,	TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"methodtype",   InfoClassMethodTypeCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
     {"mixins",	     InfoClassMixinsCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+    {"properties",   InfoClassPropCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
     {"subclasses",   InfoClassSubsCmd,		TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
     {"superclasses", InfoClassSupersCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"variables",    InfoClassVariablesCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
@@ -1717,6 +1722,184 @@ InfoClassCallCmd(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * InfoClassPropCmd, InfoObjectPropCmd --
+ *
+ *	Implements [info class properties $clsName ?$option...?] and
+ *	[info object properties $objName ?$option...?]
+ *
+ * ----------------------------------------------------------------------
+ */
+
+enum PropOpt {
+    PROP_ALL, PROP_READABLE, PROP_WRITABLE
+};
+static const char *const propOptNames[] = {
+    "-all", "-readable", "-writable",
+    NULL
+};
+
+static int
+InfoClassPropCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Class *clsPtr;
+    int i, idx, all = 0, writable = 0, allocated = 0;
+    Tcl_Obj *result, *propObj;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "className ?options...?");
+	return TCL_ERROR;
+    }
+    clsPtr = GetClassFromObj(interp, objv[1]);
+    if (clsPtr == NULL) {
+	return TCL_ERROR;
+    }
+    for (i = 2; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
+		&idx) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (idx) {
+	case PROP_ALL:
+	    all = 1;
+	    break;
+	case PROP_READABLE:
+	    writable = 0;
+	    break;
+	case PROP_WRITABLE:
+	    writable = 1;
+	    break;
+	}
+    }
+
+    /*
+     * Get the properties.
+     */
+
+    if (all) {
+	result = TclOOGetAllClassProperties(clsPtr, writable, &allocated);
+	if (allocated) {
+	    SortPropList(result);
+	}
+    } else {
+	result = Tcl_NewObj();
+	if (writable) {
+	    FOREACH(propObj, clsPtr->properties.writable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	} else {
+	    FOREACH(propObj, clsPtr->properties.readable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	}
+	SortPropList(result);
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+static int
+InfoObjectPropCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    Object *oPtr;
+    int i, idx, all = 0, writable = 0, allocated = 0;
+    Tcl_Obj *result, *propObj;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "objName ?options...?");
+	return TCL_ERROR;
+    }
+    oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[1]);
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    }
+    for (i = 2; i < objc; i++) {
+	if (Tcl_GetIndexFromObj(interp, objv[i], propOptNames, "option", 0,
+		&idx) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	switch (idx) {
+	case PROP_ALL:
+	    all = 1;
+	    break;
+	case PROP_READABLE:
+	    writable = 0;
+	    break;
+	case PROP_WRITABLE:
+	    writable = 1;
+	    break;
+	}
+    }
+
+    /*
+     * Get the properties.
+     */
+
+    if (all) {
+	result = TclOOGetAllObjectProperties(oPtr, writable, &allocated);
+	if (allocated) {
+	    SortPropList(result);
+	}
+    } else {
+	result = Tcl_NewObj();
+	if (writable) {
+	    FOREACH(propObj, oPtr->properties.writable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	} else {
+	    FOREACH(propObj, oPtr->properties.readable) {
+		Tcl_ListObjAppendElement(NULL, result, propObj);
+	    }
+	}
+	SortPropList(result);
+    }
+    Tcl_SetObjResult(interp, result);
+    return TCL_OK;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * SortPropList --
+ *	Sort a list of names of properties. Simple support function. Assumes
+ *	that the list Tcl_Obj is unshared and doesn't have a string
+ *	representation.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+PropNameCompare(
+    const void *a,
+    const void *b)
+{
+    Tcl_Obj *first = *(Tcl_Obj **) a;
+    Tcl_Obj *second = *(Tcl_Obj **) b;
+
+    return strcmp(Tcl_GetString(first), Tcl_GetString(second));
+}
+
+static void
+SortPropList(
+    Tcl_Obj *list)
+{
+    int ec;
+    Tcl_Obj **ev;
+
+    Tcl_ListObjGetElements(NULL, list, &ec, &ev);
+    qsort(ev, ec, sizeof(Tcl_Obj *), PropNameCompare);
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index 0e666e9..031b910 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -161,6 +161,26 @@ typedef LIST_STATIC(Tcl_Obj *) VariableNameList;
 typedef LIST_STATIC(PrivateVariableMapping) PrivateVariableList;
 
 /*
+ * This type is used in various places.
+ */
+
+typedef struct {
+    LIST_STATIC(Tcl_Obj *) readable;
+				/* The readable properties slot. */
+    LIST_STATIC(Tcl_Obj *) writable;
+				/* The writable properties slot. */
+    Tcl_Obj *allReadableCache;	/* The cache of all readable properties
+				 * exposed by this object or class (in its
+				 * stereotypical instancs). Contains a sorted
+				 * unique list if not NULL. */
+    Tcl_Obj *allWritableCache;	/* The cache of all writable properties
+				 * exposed by this object or class (in its
+				 * stereotypical instances). Contains a sorted
+				 * unique list if not NULL. */
+    int epoch;			/* The epoch that the caches are valid for. */
+} PropertyStorage;
+
+/*
  * Now, the definition of what an object actually is.
  */
 
@@ -182,8 +202,8 @@ typedef struct Object {
     LIST_STATIC(Tcl_Obj *) filters;
 				/* List of filter names. */
     struct Class *classPtr;	/* This is non-NULL for all classes, and NULL
-				 *  for everything else. It points to the class
-				 *  structure. */
+				 * for everything else. It points to the class
+				 * structure. */
     Tcl_Size refCount;		/* Number of strong references to this object.
 				 * Note that there may be many more weak
 				 * references; this mechanism exists to
@@ -211,12 +231,15 @@ typedef struct Object {
 				 * used inside methods. */
     Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
 				 * command. */
+    PropertyStorage properties;	/* Information relating to the lists of
+				 * properties that this object *claims* to
+				 * support. */
 } Object;
 
-#define OBJECT_DESTRUCTING	1	/* Indicates that an object is being or has
-								 *  been destroyed  */
-#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor script for the
-							   object has began */
+#define OBJECT_DESTRUCTING 1	/* Indicates that an object is being or has
+				 *  been destroyed  */
+#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor
+				 * script for the object has began */
 #define OO_UNUSED_4	4	/* No longer used.  */
 #define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
 				 * the class hierarchy and should be treated
@@ -319,6 +342,9 @@ typedef struct Class {
 				 * namespace is defined but doesn't exist; we
 				 * also check at setting time but don't check
 				 * between times. */
+    PropertyStorage properties;	/* Information relating to the lists of
+				 * properties that this class *claims* to
+				 * support. */
 } Class;
 
 /*
@@ -521,6 +547,10 @@ MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
 MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
 			    Object *oPtr);
 MODULE_SCOPE void	TclOODelMethodRef(Method *method);
+MODULE_SCOPE Tcl_Obj *	TclOOGetAllClassProperties(Class *clsPtr,
+			    int writable, int *allocated);
+MODULE_SCOPE Tcl_Obj *	TclOOGetAllObjectProperties(Object *oPtr,
+			    int writable, int *allocated);
 MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
 			    Tcl_Obj *methodNameObj, int flags,
 			    Object *contextObjPtr, Class *contextClsPtr,
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
index f2e99b0..407e919 100644
--- a/generic/tclOOScript.h
+++ b/generic/tclOOScript.h
@@ -29,7 +29,7 @@ static const char *tclOOSetupScript =
 "::namespace eval ::oo {\n"
 "\t::namespace path {}\n"
 "\tnamespace eval Helpers {\n"
-"\t\t::namespace path {}\n"
+"\t\tnamespace path {}\n"
 "\t\tproc callback {method args} {\n"
 "\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
 "\t\t}\n"
@@ -98,9 +98,9 @@ static const char *tclOOSetupScript =
 "\t\t\tif {![info object isa class $d]} {\n"
 "\t\t\t\tcontinue\n"
 "\t\t\t}\n"
-"\t\t\tdefine $delegate ::oo::define::superclass -append $d\n"
+"\t\t\tdefine $delegate ::oo::define::superclass -appendifnew $d\n"
 "\t\t}\n"
-"\t\tobjdefine $class ::oo::objdefine::mixin -append $delegate\n"
+"\t\tobjdefine $class ::oo::objdefine::mixin -appendifnew $delegate\n"
 "\t}\n"
 "\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
 "\t\tset originDelegate [DelegateName $originObject]\n"
@@ -141,34 +141,44 @@ static const char *tclOOSetupScript =
 "\t\t::namespace delete tmp\n"
 "\t}\n"
 "\tdefine Slot {\n"
-"\t\tmethod Get {} {\n"
+"\t\tmethod Get -unexport {} {\n"
 "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
 "\t\t}\n"
-"\t\tmethod Set list {\n"
+"\t\tmethod Set -unexport list {\n"
 "\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
 "\t\t}\n"
-"\t\tmethod Resolve list {\n"
+"\t\tmethod Resolve -unexport list {\n"
 "\t\t\treturn $list\n"
 "\t\t}\n"
-"\t\tmethod -set args {\n"
+"\t\tmethod -set -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\ttailcall my Set $args\n"
 "\t\t}\n"
-"\t\tmethod -append args {\n"
+"\t\tmethod -append -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
 "\t\t}\n"
-"\t\tmethod -clear {} {tailcall my Set {}}\n"
-"\t\tmethod -prepend args {\n"
+"\t\tmethod -appendifnew -export args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\tset args [lmap a $args {\n"
+"\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
+"\t\t\t\tif {$a in $current} continue\n"
+"\t\t\t\tset a\n"
+"\t\t\t}]\n"
+"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
+"\t\t}\n"
+"\t\tmethod -clear -export {} {tailcall my Set {}}\n"
+"\t\tmethod -prepend -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
 "\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
 "\t\t}\n"
-"\t\tmethod -remove args {\n"
+"\t\tmethod -remove -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
@@ -177,7 +187,7 @@ static const char *tclOOSetupScript =
 "\t\t\t}]\n"
 "\t\t}\n"
 "\t\tforward --default-operation my -append\n"
-"\t\tmethod unknown {args} {\n"
+"\t\tmethod unknown -unexport {args} {\n"
 "\t\t\tset def --default-operation\n"
 "\t\t\tif {[llength $args] == 0} {\n"
 "\t\t\t\ttailcall my $def\n"
@@ -186,13 +196,12 @@ static const char *tclOOSetupScript =
 "\t\t\t}\n"
 "\t\t\tnext {*}$args\n"
 "\t\t}\n"
-"\t\texport -set -append -clear -prepend -remove\n"
-"\t\tunexport unknown destroy\n"
+"\t\tunexport destroy\n"
 "\t}\n"
 "\tobjdefine define::superclass forward --default-operation my -set\n"
 "\tobjdefine define::mixin forward --default-operation my -set\n"
 "\tobjdefine objdefine::mixin forward --default-operation my -set\n"
-"\tdefine object method <cloned> {originObject} {\n"
+"\tdefine object method <cloned> -unexport {originObject} {\n"
 "\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
 "\t\t\tset args [info args $p]\n"
 "\t\t\tset idx -1\n"
@@ -219,7 +228,7 @@ static const char *tclOOSetupScript =
 "\t\t\t}\n"
 "\t\t}\n"
 "\t}\n"
-"\tdefine class method <cloned> {originObject} {\n"
+"\tdefine class method <cloned> -unexport {originObject} {\n"
 "\t\tnext $originObject\n"
 "\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
 "\t}\n"
@@ -235,7 +244,7 @@ static const char *tclOOSetupScript =
 "\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
 "\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
 "\t\t\t\t\t}\n"
-"\t\t\t\t\tmethod <cloned> {originObject} {\n"
+"\t\t\t\t\tmethod <cloned> -unexport {originObject} {\n"
 "\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
 "\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
 "\t\t\t\t\t}\n"
@@ -248,6 +257,226 @@ static const char *tclOOSetupScript =
 "\t\tsuperclass class\n"
 "\t\tunexport create createWithNamespace new\n"
 "\t}\n"
+"\t::namespace eval configuresupport {\n"
+"\t\tnamespace path ::tcl\n"
+"\t\tproc PropertyImpl {readslot writeslot args} {\n"
+"\t\t\tfor {set i 0} {$i < [llength $args]} {incr i} {\n"
+"\t\t\t\tset prop [lindex $args $i]\n"
+"\t\t\t\tif {[string match \"-*\" $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not begin with -\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {$prop ne [list $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must be a simple word\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {[string first \"::\" $prop] != -1} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain namespace separators\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {[string match {*[()]*} $prop]} {\n"
+"\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t-errorcode {TCLOO PROPERTY_FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad property name \\\"$prop\\\": must not contain parentheses\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tset realprop [string cat \"-\" $prop]\n"
+"\t\t\t\tset getter [format {::set [my varname %s]} $prop]\n"
+"\t\t\t\tset setter [format {::set [my varname %s] $value} $prop]\n"
+"\t\t\t\tset kind readwrite\n"
+"\t\t\t\twhile {[set next [lindex $args [expr {$i + 1}]]\n"
+"\t\t\t\t\t\tstring match \"-*\" $next]} {\n"
+"\t\t\t\t\tset arg [lindex $args [incr i 2]]\n"
+"\t\t\t\t\tswitch [prefix match -error [list -level 2 -errorcode \\\n"
+"\t\t\t\t\t\t\t[list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {\n"
+"\t\t\t\t\t\t-get {\n"
+"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\t\t\"missing body to go with -get option\"\n"
+"\t\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t\tset getter $arg\n"
+"\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t-set {\n"
+"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\t\t\"missing body to go with -set option\"\n"
+"\t\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t\tset setter $arg\n"
+"\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t-kind {\n"
+"\t\t\t\t\t\t\tif {$i >= [llength $args]} {\n"
+"\t\t\t\t\t\t\t\treturn -code error -level 2\\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t\t\t\t\"missing kind value to go with -kind option\"\n"
+"\t\t\t\t\t\t\t}\n"
+"\t\t\t\t\t\t\tset kind [prefix match -message \"kind\" -error [list \\\n"
+"\t\t\t\t\t\t\t\t\t-level 2 \\\n"
+"\t\t\t\t\t\t\t\t\t-errorcode [list TCL LOOKUP INDEX kind $arg]] {\n"
+"\t\t\t\t\t\t\t\treadable readwrite writable\n"
+"\t\t\t\t\t\t\t} $arg]\n"
+"\t\t\t\t\t\t}\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t}\n"
+"\t\t\t\tset reader <ReadProp$realprop>\n"
+"\t\t\t\tset writer <WriteProp$realprop>\n"
+"\t\t\t\tswitch $kind {\n"
+"\t\t\t\t\treadable {\n"
+"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list $writeslot -remove $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\twritable {\n"
+"\t\t\t\t\t\tuplevel 2 [list $readslot -remove $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\treadwrite {\n"
+"\t\t\t\t\t\tuplevel 2 [list $readslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list $writeslot -append $realprop]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $reader -unexport {} $getter]\n"
+"\t\t\t\t\t\tuplevel 2 [list method $writer -unexport {value} $setter]\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t}\n"
+"\t\tnamespace eval configurableclass {\n"
+"\t\t\t::proc property args {\n"
+"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
+"\t\t\t\t\t::oo::configuresupport::readableproperties \\\n"
+"\t\t\t\t\t::oo::configuresupport::writableproperties {*}$args\n"
+"\t\t\t}\n"
+"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
+"\t\t\t::namespace path ::oo::define\n"
+"\t\t\t::namespace export property\n"
+"\t\t}\n"
+"\t\tnamespace eval configurableobject {\n"
+"\t\t\t::proc property args {\n"
+"\t\t\t\t::oo::configuresupport::PropertyImpl \\\n"
+"\t\t\t\t\t::oo::configuresupport::objreadableproperties \\\n"
+"\t\t\t\t\t::oo::configuresupport::objwritableproperties {*}$args\n"
+"\t\t\t}\n"
+"\t\t\t::proc properties args {::tailcall property {*}$args}\n"
+"\t\t\t::namespace path ::oo::objdefine\n"
+"\t\t\t::namespace export property\n"
+"\t\t}\n"
+"\t\tproc ReadAll {object my} {\n"
+"\t\t\tset result {}\n"
+"\t\t\tforeach prop [info object properties $object -all -readable] {\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\tdict set result $prop [$my <ReadProp$prop>]\n"
+"\t\t\t\t} on error {msg opt} {\n"
+"\t\t\t\t\tdict set opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on return {msg opt} {\n"
+"\t\t\t\t\tdict incr opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on break {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property getter for $prop did a break\"\n"
+"\t\t\t\t} on continue {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property getter for $prop did a continue\"\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\treturn $result\n"
+"\t\t}\n"
+"\t\tproc ReadOne {object my propertyName} {\n"
+"\t\t\tset props [info object properties $object -all -readable]\n"
+"\t\t\ttry {\n"
+"\t\t\t\tset prop [prefix match -message \"property\" $props $propertyName]\n"
+"\t\t\t} on error {msg} {\n"
+"\t\t\t\tcatch {\n"
+"\t\t\t\t\tset wps [info object properties $object -all -writable]\n"
+"\t\t\t\t\tset wprop [prefix match $wps $propertyName]\n"
+"\t\t\t\t\tset msg \"property \\\"$wprop\\\" is write only\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
+"\t\t\t\t\t\tTCL LOOKUP INDEX property $propertyName] $msg\n"
+"\t\t\t}\n"
+"\t\t\ttry {\n"
+"\t\t\t\tset value [$my <ReadProp$prop>]\n"
+"\t\t\t} on error {msg opt} {\n"
+"\t\t\t\tdict set opt -level 2\n"
+"\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t} on return {msg opt} {\n"
+"\t\t\t\tdict incr opt -level 2\n"
+"\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t} on break {} {\n"
+"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\"property getter for $prop did a break\"\n"
+"\t\t\t} on continue {} {\n"
+"\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\"property getter for $prop did a continue\"\n"
+"\t\t\t}\n"
+"\t\t\treturn $value\n"
+"\t\t}\n"
+"\t\tproc WriteMany {object my setterMap} {\n"
+"\t\t\tset props [info object properties $object -all -writable]\n"
+"\t\t\tforeach {prop value} $setterMap {\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\tset prop [prefix match -message \"property\" $props $prop]\n"
+"\t\t\t\t} on error {msg} {\n"
+"\t\t\t\t\tcatch {\n"
+"\t\t\t\t\t\tset rps [info object properties $object -all -readable]\n"
+"\t\t\t\t\t\tset rprop [prefix match $rps $prop]\n"
+"\t\t\t\t\t\tset msg \"property \\\"$rprop\\\" is read only\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode [list \\\n"
+"\t\t\t\t\t\t\tTCL LOOKUP INDEX property $prop] $msg\n"
+"\t\t\t\t}\n"
+"\t\t\t\ttry {\n"
+"\t\t\t\t\t$my <WriteProp$prop> $value\n"
+"\t\t\t\t} on error {msg opt} {\n"
+"\t\t\t\t\tdict set opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on return {msg opt} {\n"
+"\t\t\t\t\tdict incr opt -level 2\n"
+"\t\t\t\t\treturn -options $opt $msg\n"
+"\t\t\t\t} on break {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property setter for $prop did a break\"\n"
+"\t\t\t\t} on continue {} {\n"
+"\t\t\t\t\treturn -code error -level 2 -errorcode {TCLOO SHENANIGANS} \\\n"
+"\t\t\t\t\t\t\"property setter for $prop did a continue\"\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t\t::oo::class create configurable {\n"
+"\t\t\tprivate variable my\n"
+"\t\t\tmethod configure -export args {\n"
+"\t\t\t\t::if {![::info exists my]} {\n"
+"\t\t\t\t\t::set my [::namespace which my]\n"
+"\t\t\t\t}\n"
+"\t\t\t\t::if {[::llength $args] == 0} {\n"
+"\t\t\t\t\t::oo::configuresupport::ReadAll [self] $my\n"
+"\t\t\t\t} elseif {[::llength $args] == 1} {\n"
+"\t\t\t\t\t::oo::configuresupport::ReadOne [self] $my \\\n"
+"\t\t\t\t\t\t[::lindex $args 0]\n"
+"\t\t\t\t} elseif {[::llength $args] % 2 == 0} {\n"
+"\t\t\t\t\t::oo::configuresupport::WriteMany [self] $my $args\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\t::return -code error -errorcode {TCL WRONGARGS} \\\n"
+"\t\t\t\t\t\t[::format {wrong # args: should be \"%s\"} \\\n"
+"\t\t\t\t\t\t\t\"[self] configure \?-option value ...\?\"]\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\tdefinitionnamespace -instance configurableobject\n"
+"\t\t\tdefinitionnamespace -class configurableclass\n"
+"\t\t}\n"
+"\t}\n"
+"\tclass create configurable {\n"
+"\t\tsuperclass class\n"
+"\t\tconstructor {{definitionScript \"\"}} {\n"
+"\t\t\tnext {mixin ::oo::configuresupport::configurable}\n"
+"\t\t\tnext $definitionScript\n"
+"\t\t}\n"
+"\t\tdefinitionnamespace -class configuresupport::configurableclass\n"
+"\t}\n"
 "}\n"
 /* !END!: Do not edit above this line. */
 ;
diff --git a/tests/oo.test b/tests/oo.test
index ff67cc1..291060d 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -376,7 +376,7 @@ test oo-1.21 {basic test of OO functionality: default relations} -setup {
     }] {lsort [lsearch -all -not -inline $x *::delegate]}
 } -cleanup {
     interp delete $fresh
-} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
+} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::configurable ::oo::configuresupport::configurable ::oo::object ::oo::singleton} {::oo::configuresupport::objreadableproperties ::oo::configuresupport::objwritableproperties ::oo::configuresupport::readableproperties ::oo::configuresupport::writableproperties ::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class ::oo::configuresupport::configurable} {::oo::abstract ::oo::configurable ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
 
 test oo-2.1 {basic test of OO functionality: constructor} -setup {
     # This is a bit complex because it needs to run in a sub-interp as
@@ -2458,7 +2458,7 @@ test oo-16.2 {OO: object introspection} -body {
 } -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
 test oo-16.3 {OO: object introspection} -body {
     info object gorp oo::object
-} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, variables, or vars}
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, class, creationid, definition, filters, forward, isa, methods, methodtype, mixins, namespace, properties, variables, or vars}
 test oo-16.4 {OO: object introspection} -setup {
     oo::class create meta { superclass oo::class }
     [meta create instance1] create instance2
@@ -2677,7 +2677,7 @@ test oo-17.3 {OO: class introspection} -setup {
 } -result {"foo" is not a class}
 test oo-17.4 {OO: class introspection} -body {
     info class gorp oo::object
-} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, subclasses, superclasses, or variables}
+} -returnCodes 1 -result {unknown or ambiguous subcommand "gorp": must be call, constructor, definition, definitionnamespace, destructor, filters, forward, instances, methods, methodtype, mixins, properties, subclasses, superclasses, or variables}
 test oo-17.5 {OO: class introspection} -setup {
     oo::class create testClass
 } -body {
@@ -4197,7 +4197,7 @@ test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
 } -returnCodes error -cleanup [SampleSlotCleanup {
     rename $s {}
 }] -result \
-    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}
+    {unknown method "-grill": must be -append, -appendifnew, -clear, -prepend, -remove, -set, contents or ops}
 
 test oo-34.1 {TIP 380: slots - presence} -setup {
     set obj [oo::object new]
@@ -4220,32 +4220,32 @@ test oo-34.1 {TIP 380: slots - presence} -setup {
 } -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
 test oo-34.2 {TIP 380: slots - presence} {
     lsort [info class instances oo::Slot]
-} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
+} {::oo::configuresupport::objreadableproperties ::oo::configuresupport::objwritableproperties ::oo::configuresupport::readableproperties ::oo::configuresupport::writableproperties ::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
 proc getMethods obj {
     list [lsort [info object methods $obj -all]] \
 	[lsort [info object methods $obj -private]]
 }
 test oo-34.3 {TIP 380: slots - presence} {
     getMethods oo::define::filter
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.4 {TIP 380: slots - presence} {
     getMethods oo::define::mixin
-} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.5 {TIP 380: slots - presence} {
     getMethods oo::define::superclass
-} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.6 {TIP 380: slots - presence} {
     getMethods oo::define::variable
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.7 {TIP 380: slots - presence} {
     getMethods oo::objdefine::filter
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.8 {TIP 380: slots - presence} {
     getMethods oo::objdefine::mixin
-} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.9 {TIP 380: slots - presence} {
     getMethods oo::objdefine::variable
-} {{-append -clear -prepend -remove -set} {Get Set}}
+} {{-append -appendifnew -clear -prepend -remove -set} {Get Set}}
 test oo-34.10 {TIP 516: slots - resolution} -setup {
     oo::class create parent
     set result {}
diff --git a/tests/ooProp.test b/tests/ooProp.test
new file mode 100644
index 0000000..8120f88
--- /dev/null
+++ b/tests/ooProp.test
@@ -0,0 +1,885 @@
+# This file contains a collection of tests for Tcl's built-in object system,
+# specifically the parts that support configurable properties on objects.
+# Sourcing this file into Tcl runs the tests and generates output for errors.
+# No output means no errors were found.
+#
+# Copyright © 2019-2020 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcl::oo 1.0.3
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+    namespace import -force ::tcltest::*
+}
+
+test ooProp-1.1 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::readableproperties -set a b c
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::readableproperties -set f e d
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::readableproperties -set a a a
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::readableproperties -set
+    lappend result [info class properties c] [info class properties c -writable]
+} -cleanup {
+    parent destroy
+} -result {{} {} {a b c} {} {d e f} {} a {} {} {}}
+test ooProp-1.2 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set a b c
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set f e d
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set a a a
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+} -cleanup {
+    parent destroy
+} -result {{} {} {a b c} {} {d e f} {} a {} {} {}}
+test ooProp-1.3 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::writableproperties -set a b c
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::writableproperties -set f e d
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::writableproperties -set a a a
+    lappend result [info class properties c] [info class properties c -writable]
+    oo::define c ::oo::configuresupport::writableproperties -set
+    lappend result [info class properties c] [info class properties c -writable]
+} -cleanup {
+    parent destroy
+} -result {{} {} {} {a b c} {} {d e f} {} a {} {}}
+test ooProp-1.4 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set a b c
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set f e d
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set a a a
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set
+    lappend result [info class properties c -all] [info class properties c -writable -all]
+} -cleanup {
+    parent destroy
+} -result {{} {} {} {a b c} {} {d e f} {} a {} {}}
+test ooProp-1.5 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    oo::class create d {superclass c}
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set a b c
+    oo::define d ::oo::configuresupport::readableproperties -set x y z
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set f e d
+    oo::define d ::oo::configuresupport::readableproperties -set r p q
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set a a h
+    oo::define d ::oo::configuresupport::readableproperties -set g h g
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define d ::oo::configuresupport::readableproperties -set
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+} -cleanup {
+    parent destroy
+} -result {{} {} {a b c x y z} {} {d e f p q r} {} {a g h} {} {g h} {} {} {}}
+test ooProp-1.6 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    oo::class create d {superclass c}
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set a b c
+    oo::define d ::oo::configuresupport::writableproperties -set x y z
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set f e d
+    oo::define d ::oo::configuresupport::writableproperties -set r p q
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set a a h
+    oo::define d ::oo::configuresupport::writableproperties -set g h g
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+    oo::define d ::oo::configuresupport::writableproperties -set
+    lappend result [info class properties d -all] [info class properties d -writable -all]
+} -cleanup {
+    parent destroy
+} -result {{} {} {} {a b c x y z} {} {d e f p q r} {} {a g h} {} {g h} {} {}}
+test ooProp-1.7 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    c create o
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objreadableproperties -set a b c
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objreadableproperties -set f e d
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objreadableproperties -set a a h
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objreadableproperties -set
+    lappend result [info object properties o] [info object properties o -writable]
+} -cleanup {
+    parent destroy
+} -result {{} {} {a b c} {} {d e f} {} {a h} {} {} {}}
+test ooProp-1.8 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    c create o
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objwritableproperties -set a b c
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objwritableproperties -set f e d
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objwritableproperties -set a a h
+    lappend result [info object properties o] [info object properties o -writable]
+    oo::objdefine o ::oo::configuresupport::objwritableproperties -set
+    lappend result [info object properties o] [info object properties o -writable]
+} -cleanup {
+    parent destroy
+} -result {{} {} {} {a b c} {} {d e f} {} {a h} {} {}}
+test ooProp-1.9 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    oo::class create d {superclass c}
+    d create o
+    lappend result [info object properties o -all] [info object properties o -writable -all]
+    oo::define c ::oo::configuresupport::readableproperties -set a b
+    oo::define d ::oo::configuresupport::readableproperties -set c d
+    oo::objdefine o ::oo::configuresupport::objreadableproperties -set e f
+    lappend result [info object properties o -all] [info object properties o -writable -all]
+    oo::objdefine o ::oo::configuresupport::objreadableproperties -set f e d b e
+    lappend result [info object properties o -all] [info object properties o -writable -all]
+} -cleanup {
+    parent destroy
+} -result {{} {} {a b c d e f} {} {a b c d e f} {}}
+test ooProp-1.10 {TIP 558: properties: core support} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::class create c {superclass parent}
+    oo::class create d {superclass c}
+    d create o
+    lappend result [info object properties o -all] [info object properties o -writable -all]
+    oo::define c ::oo::configuresupport::writableproperties -set a b
+    oo::define d ::oo::configuresupport::writableproperties -set c d
+    oo::objdefine o ::oo::configuresupport::objwritableproperties -set e f
+    lappend result [info object properties o -all] [info object properties o -writable -all]
+    oo::objdefine o ::oo::configuresupport::objwritableproperties -set f e d b e
+    lappend result [info object properties o -all] [info object properties o -writable -all]
+} -cleanup {
+    parent destroy
+} -result {{} {} {} {a b c d e f} {} {a b c d e f}}
+test ooProp-1.11 {TIP 558: properties: core support cache} -setup {
+    oo::class create parent
+    unset -nocomplain result
+} -body {
+    oo::class create m {
+	superclass parent
+	::oo::configuresupport::readableproperties -set a
+	::oo::configuresupport::writableproperties -set c
+    }
+    oo::class create c {
+	superclass parent
+	::oo::configuresupport::readableproperties -set b
+	::oo::configuresupport::writableproperties -set d
+    }
+    c create o
+    lappend result [info object properties o -all -readable] \
+	[info object properties o -all -writable]
+    oo::objdefine o mixin m
+    lappend result [info object properties o -all -readable] \
+	[info object properties o -all -writable]
+} -cleanup {
+    parent destroy
+} -result {b d {a b} {c d}}
+
+test ooProp-2.1 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+        variable x y
+        method report {} {
+            lappend ::result "x=$x, y=$y"
+        }
+    }
+    set pt [Point new -x 3]
+    $pt report
+    $pt configure -y 4
+    $pt report
+    lappend result [$pt configure -x],[$pt configure -y] [$pt configure]
+} -cleanup {
+    parent destroy
+} -result {{x=3, y=0} {x=3, y=4} 3,4 {-x 3 -y 4}}
+test ooProp-2.2 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+    }
+    oo::configurable create 3DPoint {
+	superclass Point
+	property z
+	constructor args {
+	    next -z 0 {*}$args
+	}
+    }
+    set pt [3DPoint new -x 3 -y 4 -z 5]
+    list [$pt configure -x],[$pt configure -y],[$pt configure -z] \
+	[$pt configure]
+} -cleanup {
+    parent destroy
+} -result {3,4,5 {-x 3 -y 4 -z 5}}
+test ooProp-2.3 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+    }
+    set pt [Point new -x 3 -y 4]
+    oo::objdefine $pt property z
+    $pt configure -z 5
+    list [$pt configure -x],[$pt configure -y],[$pt configure -z] \
+	[$pt configure]
+} -cleanup {
+    parent destroy
+} -result {3,4,5 {-x 3 -y 4 -z 5}}
+test ooProp-2.4 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+    }
+    [Point new] configure gorp
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property "gorp": must be -x or -y}
+test ooProp-2.5 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+    }
+    oo::configurable create 3DPoint {
+	superclass Point
+	property z
+	constructor args {
+	    next -z 0 {*}$args
+	}
+    }
+    [3DPoint new] configure gorp
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property "gorp": must be -x, -y, or -z}
+test ooProp-2.6 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+    }
+    [Point create p] configure -x 1 -y
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {wrong # args: should be "::p configure ?-option value ...?"}
+test ooProp-2.7 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+    unset -nocomplain msg
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y -kind writable
+        constructor args {
+            my configure -x 0 -y 0 {*}$args
+        }
+    }
+    Point create p
+    list [p configure -y ok] [catch {p configure -y} msg] $msg
+} -cleanup {
+    parent destroy
+} -result {{} 1 {property "-y" is write only}}
+test ooProp-2.8 {TIP 558: properties: configurable class system} -setup {
+    oo::class create parent
+    unset -nocomplain msg
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x y -kind readable
+        constructor args {
+            my configure -x 0 {*}$args
+	    variable y 123
+        }
+    }
+    Point create p
+    list [p configure] [p configure -y] [catch {p configure -y foo} msg] $msg
+} -cleanup {
+    parent destroy
+} -result {{-x 0 -y 123} 123 1 {property "-y" is read only}}
+
+test ooProp-3.1 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	variable xyz
+	property x -get {
+	    global result
+	    lappend result "get"
+	    return [lrepeat 3 $xyz]
+	} -set {
+	    global result
+	    lappend result [list set $value]
+	    set xyz [expr {$value * 3}]
+	}
+    }
+    Point create pt
+    pt configure -x 5
+    lappend result >[pt configure -x]<
+} -cleanup {
+    parent destroy
+} -result {{set 5} get {>15 15 15<}}
+test ooProp-3.2 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+    unset -nocomplain result
+    set result {}
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	variable xyz
+	property x -get {
+	    global result
+	    lappend result "get"
+	    return [lrepeat 3 $xyz]
+	} -set {
+	    global result
+	    lappend result [list set $value]
+	    set xyz [expr {$value * 3}]
+	} y -kind readable -get {return $xyz}
+    }
+    Point create pt
+    pt configure -x 5
+    lappend result >[pt configure -x]< [pt configure -y]
+} -cleanup {
+    parent destroy
+} -result {{set 5} get {>15 15 15<} 15}
+test ooProp-3.3 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	variable xyz
+	property -x -get {return $xyz}
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property name "-x": must not begin with -}
+test ooProp-3.4 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property "x y"
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property name "x y": must be a simple word}
+test ooProp-3.5 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property ::x
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property name "::x": must not contain namespace separators}
+test ooProp-3.6 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property x(
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property name "x(": must not contain parentheses}
+test ooProp-3.7 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property x)
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad property name "x)": must not contain parentheses}
+test ooProp-3.8 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property x -get
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {missing body to go with -get option}
+test ooProp-3.9 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property x -set
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {missing body to go with -set option}
+test ooProp-3.10 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property x -kind
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {missing kind value to go with -kind option}
+test ooProp-3.11 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {superclass parent}
+    oo::define Point {
+	property x -get {} -set
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {missing body to go with -set option}
+test ooProp-3.12 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {} -get {return ok}
+    }
+    [Point new] configure -x
+} -cleanup {
+    parent destroy
+} -result ok
+test ooProp-3.13 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -kind gorp
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad kind "gorp": must be readable, readwrite, or writable}
+test ooProp-3.14 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -k reada -g {return ok}
+    }
+    [Point new] configure -x
+} -cleanup {
+    parent destroy
+} -result ok
+test ooProp-3.15 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property {*}{
+	    x -kind writable
+	    y -get {return ok}
+	}
+    }
+    [Point new] configure -y
+} -cleanup {
+    parent destroy
+} -result ok
+test ooProp-3.16 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+    unset -nocomplain msg
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	variable xy
+	property x -kind readable -get {return $xy}
+	property x -kind writable -set {set xy $value}
+    }
+    Point create pt
+    list [catch {
+	pt configure -x ok
+    } msg] $msg [catch {
+	pt configure -x
+    } msg] $msg [catch {
+	pt configure -y 1
+    } msg] $msg
+} -cleanup {
+    parent destroy
+} -result {0 {} 1 {property "-x" is write only} 1 {bad property "-y": must be -x}}
+test ooProp-3.17 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {return -code break}
+    }
+    while 1 {
+	[Point new] configure -x
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {property getter for -x did a break}
+test ooProp-3.18 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {return -code break}
+    }
+    while 1 {
+	[Point new] configure
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {property getter for -x did a break}
+test ooProp-3.19 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {error "boo"}
+    }
+    while 1 {
+	[Point new] configure -x
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result boo
+test ooProp-3.20 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {error "boo"}
+    }
+    while 1 {
+	[Point new] configure
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result boo
+test ooProp-3.21 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {return -code continue}
+    }
+    while 1 {
+	[Point new] configure -x
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {property getter for -x did a continue}
+test ooProp-3.22 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {return -level 2 ok}
+    }
+    apply {{} {
+	[Point new] configure
+	return bad
+    }}
+} -cleanup {
+    parent destroy
+} -result ok
+test ooProp-3.23 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -get {return -level 2 ok}
+    }
+    apply {{} {
+	[Point new] configure -x
+	return bad
+    }}
+} -cleanup {
+    parent destroy
+} -result ok
+test ooProp-3.24 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -set {return -code break}
+    }
+    while 1 {
+	[Point new] configure -x gorp
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {property setter for -x did a break}
+test ooProp-3.25 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -set {return -code continue}
+    }
+    while 1 {
+	[Point new] configure -x gorp
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {property setter for -x did a continue}
+test ooProp-3.26 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -set {error "boo"}
+    }
+    while 1 {
+	[Point new] configure -x gorp
+	break
+    }
+} -returnCodes error -cleanup {
+    parent destroy
+} -result boo
+test ooProp-3.27 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x -set {return -level 2 ok}
+    }
+    apply {{} {
+	[Point new] configure -x gorp
+	return bad
+    }}
+} -cleanup {
+    parent destroy
+} -result ok
+test ooProp-3.28 {TIP 558: properties: declaration semantics} -setup {
+    oo::class create parent
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	private property var
+    }
+    Point create pt
+    pt configure -var ok
+    pt configure -var
+} -cleanup {
+    parent destroy
+} -result ok
+
+test ooProp-4.1 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {superclass parent}
+    list [catch {oo::define Point {property -x}} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {bad property name "-x": must not begin with -
+    while executing
+"property -x"
+    (in definition script for class "::Point" line 1)
+    invoked from within
+"oo::define Point {property -x}"} {TCLOO PROPERTY_FORMAT}}
+test ooProp-4.2 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {superclass parent}
+    list [catch {oo::define Point {property x -get}} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {missing body to go with -get option
+    while executing
+"property x -get"
+    (in definition script for class "::Point" line 1)
+    invoked from within
+"oo::define Point {property x -get}"} {TCL WRONGARGS}}
+test ooProp-4.3 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {superclass parent}
+    list [catch {oo::define Point {property x -set}} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {missing body to go with -set option
+    while executing
+"property x -set"
+    (in definition script for class "::Point" line 1)
+    invoked from within
+"oo::define Point {property x -set}"} {TCL WRONGARGS}}
+test ooProp-4.4 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {superclass parent}
+    list [catch {oo::define Point {property x -kind}} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {missing kind value to go with -kind option
+    while executing
+"property x -kind"
+    (in definition script for class "::Point" line 1)
+    invoked from within
+"oo::define Point {property x -kind}"} {TCL WRONGARGS}}
+test ooProp-4.5 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {superclass parent}
+    list [catch {oo::define Point {property x -kind gorp}} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {bad kind "gorp": must be readable, readwrite, or writable
+    while executing
+"property x -kind gorp"
+    (in definition script for class "::Point" line 1)
+    invoked from within
+"oo::define Point {property x -kind gorp}"} {TCL LOOKUP INDEX kind gorp}}
+test ooProp-4.6 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {superclass parent}
+    list [catch {oo::define Point {property x -gorp}} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {bad option "-gorp": must be -get, -kind, or -set
+    while executing
+"property x -gorp"
+    (in definition script for class "::Point" line 1)
+    invoked from within
+"oo::define Point {property x -gorp}"} {TCL LOOKUP INDEX option -gorp}}
+test ooProp-4.7 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x
+    }
+    Point create pt
+    list [catch {pt configure -gorp} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {bad property "-gorp": must be -x
+    while executing
+"pt configure -gorp"} {TCL LOOKUP INDEX property -gorp}}
+test ooProp-4.8 {TIP 558: properties: error details} -setup {
+    oo::class create parent
+    unset -nocomplain msg opt
+} -body {
+    oo::configurable create Point {
+	superclass parent
+	property x
+    }
+    Point create pt
+    list [catch {pt configure -gorp blarg} msg opt] \
+	[dict get $opt -errorinfo] [dict get $opt -errorcode]
+} -cleanup {
+    parent destroy
+} -result {1 {bad property "-gorp": must be -x
+    while executing
+"pt configure -gorp blarg"} {TCL LOOKUP INDEX property -gorp}}
+
+cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tools/tclOOScript.tcl b/tools/tclOOScript.tcl
index 941f15c..4591a1b 100644
--- a/tools/tclOOScript.tcl
+++ b/tools/tclOOScript.tcl
@@ -4,7 +4,7 @@
 # 	that the code can be definitely run even in safe interpreters; TclOO's
 # 	core setup is safe.
 #
-# Copyright © 2012-2018 Donal K. Fellows
+# Copyright © 2012-2019 Donal K. Fellows
 # Copyright © 2013 Andreas Kupries
 # Copyright © 2017 Gerald Lester
 #
@@ -18,7 +18,7 @@
     # Commands that are made available to objects by default.
     #
     namespace eval Helpers {
-	::namespace path {}
+	namespace path {}
 
 	# ------------------------------------------------------------------
 	#
@@ -153,9 +153,9 @@
 	    if {![info object isa class $d]} {
 		continue
 	    }
-	    define $delegate ::oo::define::superclass -append $d
+	    define $delegate ::oo::define::superclass -appendifnew $d
 	}
-	objdefine $class ::oo::objdefine::mixin -append $delegate
+	objdefine $class ::oo::objdefine::mixin -appendifnew $delegate
     }
 
     # ----------------------------------------------------------------------
@@ -257,7 +257,7 @@
 	#
 	# ------------------------------------------------------------------
 
-	method Get {} {
+	method Get -unexport {} {
 	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
 	}
 
@@ -270,7 +270,7 @@
 	#
 	# ------------------------------------------------------------------
 
-	method Set list {
+	method Set -unexport list {
 	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
 	}
 
@@ -284,7 +284,7 @@
 	#
 	# ------------------------------------------------------------------
 
-	method Resolve list {
+	method Resolve -unexport list {
 	    return $list
 	}
 
@@ -297,25 +297,36 @@
 	#
 	# ------------------------------------------------------------------
 
-	method -set args {
+	method -set -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    tailcall my Set $args
 	}
-	method -append args {
+	method -append -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    set current [uplevel 1 [list $my Get]]
 	    tailcall my Set [list {*}$current {*}$args]
 	}
-	method -clear {} {tailcall my Set {}}
-	method -prepend args {
+	method -appendifnew -export args {
+	    set my [namespace which my]
+	    set current [uplevel 1 [list $my Get]]
+	    foreach a $args {
+		set a [uplevel 1 [list $my Resolve $a]]
+		if {$a ni $current} {
+		    lappend current $a
+		}
+	    }
+	    tailcall my Set $current
+	}
+	method -clear -export {} {tailcall my Set {}}
+	method -prepend -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    set current [uplevel 1 [list $my Get]]
 	    tailcall my Set [list {*}$args {*}$current]
 	}
-	method -remove args {
+	method -remove -export args {
 	    set my [namespace which my]
 	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
 	    set current [uplevel 1 [list $my Get]]
@@ -326,7 +337,7 @@
 
 	# Default handling
 	forward --default-operation my -append
-	method unknown {args} {
+	method unknown -unexport {args} {
 	    set def --default-operation
 	    if {[llength $args] == 0} {
 		tailcall my $def
@@ -336,9 +347,8 @@
 	    next {*}$args
 	}
 
-	# Set up what is exported and what isn't
-	export -set -append -clear -prepend -remove
-	unexport unknown destroy
+	# Hide destroy
+	unexport destroy
     }
 
     # Set the default operation differently for these slots
@@ -356,7 +366,7 @@
     #
     # ----------------------------------------------------------------------
 
-    define object method <cloned> {originObject} {
+    define object method <cloned> -unexport {originObject} {
 	# Copy over the procedures from the original namespace
 	foreach p [info procs [info object namespace $originObject]::*] {
 	    set args [info args $p]
@@ -397,7 +407,7 @@
     #
     # ----------------------------------------------------------------------
 
-    define class method <cloned> {originObject} {
+    define class method <cloned> -unexport {originObject} {
 	next $originObject
 	# Rebuild the class inheritance delegation class
 	::oo::UpdateClassDelegatesAfterClone $originObject [self]
@@ -424,7 +434,7 @@
 			::return -code error -errorcode {TCLOO SINGLETON} \
 			    "may not destroy a singleton object"
 		    }
-		    method <cloned> {originObject} {
+		    method <cloned> -unexport {originObject} {
 			::return -code error -errorcode {TCLOO SINGLETON} \
 			    "may not clone a singleton object"
 		    }
@@ -447,6 +457,338 @@
 	superclass class
 	unexport create createWithNamespace new
     }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::configuresupport --
+    #
+    #	Namespace that holds all the implementation details of TIP #558.
+    #	Also includes the commands:
+    #
+    #	 * readableproperties
+    #	 * writableproperties
+    #	 * objreadableproperties
+    #	 * objwritableproperties
+    #
+    #	Those are all slot implementations that provide access to the C layer
+    #	of property support (i.e., very fast cached lookup of property names).
+    #
+    # ----------------------------------------------------------------------
+
+    ::namespace eval configuresupport {
+	namespace path ::tcl
+
+	# ------------------------------------------------------------------
+	#
+	# oo::configuresupport --
+	#
+	#	A metaclass that is used to make classes that can be configured.
+	#
+	# ------------------------------------------------------------------
+
+	proc PropertyImpl {readslot writeslot args} {
+	    for {set i 0} {$i < [llength $args]} {incr i} {
+		# Parse the property name
+		set prop [lindex $args $i]
+		if {[string match "-*" $prop]} {
+		    return -code error -level 2 \
+			-errorcode {TCLOO PROPERTY_FORMAT} \
+			"bad property name \"$prop\": must not begin with -"
+		}
+		if {$prop ne [list $prop]} {
+		    return -code error -level 2 \
+			-errorcode {TCLOO PROPERTY_FORMAT} \
+			"bad property name \"$prop\": must be a simple word"
+		}
+		if {[string first "::" $prop] != -1} {
+		    return -code error -level 2 \
+			-errorcode {TCLOO PROPERTY_FORMAT} \
+			"bad property name \"$prop\": must not contain namespace separators"
+		}
+		if {[string match {*[()]*} $prop]} {
+		    return -code error -level 2 \
+			-errorcode {TCLOO PROPERTY_FORMAT} \
+			"bad property name \"$prop\": must not contain parentheses"
+		}
+		set realprop [string cat "-" $prop]
+		set getter [format {::set [my varname %s]} $prop]
+		set setter [format {::set [my varname %s] $value} $prop]
+		set kind readwrite
+
+		# Parse the extra options
+		while {[set next [lindex $args [expr {$i + 1}]]
+			string match "-*" $next]} {
+		    set arg [lindex $args [incr i 2]]
+		    switch [prefix match -error [list -level 2 -errorcode \
+			    [list TCL LOOKUP INDEX option $next]] {-get -kind -set} $next] {
+			-get {
+			    if {$i >= [llength $args]} {
+				return -code error -level 2 \
+				    -errorcode {TCL WRONGARGS} \
+				    "missing body to go with -get option"
+			    }
+			    set getter $arg
+			}
+			-set {
+			    if {$i >= [llength $args]} {
+				return -code error -level 2 \
+				    -errorcode {TCL WRONGARGS} \
+				    "missing body to go with -set option"
+			    }
+			    set setter $arg
+			}
+			-kind {
+			    if {$i >= [llength $args]} {
+				return -code error -level 2\
+				    -errorcode {TCL WRONGARGS} \
+				    "missing kind value to go with -kind option"
+			    }
+			    set kind [prefix match -message "kind" -error [list \
+				    -level 2 \
+				    -errorcode [list TCL LOOKUP INDEX kind $arg]] {
+				readable readwrite writable
+			    } $arg]
+			}
+		    }
+		}
+
+		# Install the option
+		set reader <ReadProp$realprop>
+		set writer <WriteProp$realprop>
+		switch $kind {
+		    readable {
+			uplevel 2 [list $readslot -append $realprop]
+			uplevel 2 [list $writeslot -remove $realprop]
+			uplevel 2 [list method $reader -unexport {} $getter]
+		    }
+		    writable {
+			uplevel 2 [list $readslot -remove $realprop]
+			uplevel 2 [list $writeslot -append $realprop]
+			uplevel 2 [list method $writer -unexport {value} $setter]
+		    }
+		    readwrite {
+			uplevel 2 [list $readslot -append $realprop]
+			uplevel 2 [list $writeslot -append $realprop]
+			uplevel 2 [list method $reader -unexport {} $getter]
+			uplevel 2 [list method $writer -unexport {value} $setter]
+		    }
+		}
+	    }
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# oo::configuresupport::configurableclass,
+	# oo::configuresupport::configurableobject --
+	#
+	#	Namespaces used as implementation vectors for oo::define and
+	#	oo::objdefine when the class/instance is configurable.
+	#
+	# ------------------------------------------------------------------
+
+	namespace eval configurableclass {
+	    ::proc property args {
+		::oo::configuresupport::PropertyImpl \
+		    ::oo::configuresupport::readableproperties \
+		    ::oo::configuresupport::writableproperties {*}$args
+	    }
+	    # Plural alias just in case; deliberately NOT documented!
+	    ::proc properties args {::tailcall property {*}$args}
+	    ::namespace path ::oo::define
+	    ::namespace export property
+	}
+
+	namespace eval configurableobject {
+	    ::proc property args {
+		::oo::configuresupport::PropertyImpl \
+		    ::oo::configuresupport::objreadableproperties \
+		    ::oo::configuresupport::objwritableproperties {*}$args
+	    }
+	    # Plural alias just in case; deliberately NOT documented!
+	    ::proc properties args {::tailcall property {*}$args}
+	    ::namespace path ::oo::objdefine
+	    ::namespace export property
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# oo::configuresupport::ReadAll --
+	#
+	#	The implementation of [$o configure] with no extra arguments.
+	#
+	# ------------------------------------------------------------------
+
+	proc ReadAll {object my} {
+	    set result {}
+	    foreach prop [info object properties $object -all -readable] {
+		try {
+		    dict set result $prop [$my <ReadProp$prop>]
+		} on error {msg opt} {
+		    dict set opt -level 2
+		    return -options $opt $msg
+		} on return {msg opt} {
+		    dict incr opt -level 2
+		    return -options $opt $msg
+		} on break {} {
+		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
+			"property getter for $prop did a break"
+		} on continue {} {
+		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
+			"property getter for $prop did a continue"
+		}
+	    }
+	    return $result
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# oo::configuresupport::ReadOne --
+	#
+	#	The implementation of [$o configure -prop] with that single
+	#	extra argument.
+	#
+	# ------------------------------------------------------------------
+
+	proc ReadOne {object my propertyName} {
+	    set props [info object properties $object -all -readable]
+	    try {
+		set prop [prefix match -message "property" $props $propertyName]
+	    } on error {msg} {
+		catch {
+		    set wps [info object properties $object -all -writable]
+		    set wprop [prefix match $wps $propertyName]
+		    set msg "property \"$wprop\" is write only"
+		}
+		return -code error -level 2 -errorcode [list \
+			TCL LOOKUP INDEX property $propertyName] $msg
+	    }
+	    try {
+		set value [$my <ReadProp$prop>]
+	    } on error {msg opt} {
+		dict set opt -level 2
+		return -options $opt $msg
+	    } on return {msg opt} {
+		dict incr opt -level 2
+		return -options $opt $msg
+	    } on break {} {
+		return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
+		    "property getter for $prop did a break"
+	    } on continue {} {
+		return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
+		    "property getter for $prop did a continue"
+	    }
+	    return $value
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# oo::configuresupport::WriteMany --
+	#
+	#	The implementation of [$o configure -prop val ?-prop val...?].
+	#
+	# ------------------------------------------------------------------
+
+	proc WriteMany {object my setterMap} {
+	    set props [info object properties $object -all -writable]
+	    foreach {prop value} $setterMap {
+		try {
+		    set prop [prefix match -message "property" $props $prop]
+		} on error {msg} {
+		    catch {
+			set rps [info object properties $object -all -readable]
+			set rprop [prefix match $rps $prop]
+			set msg "property \"$rprop\" is read only"
+		    }
+		    return -code error -level 2 -errorcode [list \
+			    TCL LOOKUP INDEX property $prop] $msg
+		}
+		try {
+		    $my <WriteProp$prop> $value
+		} on error {msg opt} {
+		    dict set opt -level 2
+		    return -options $opt $msg
+		} on return {msg opt} {
+		    dict incr opt -level 2
+		    return -options $opt $msg
+		} on break {} {
+		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
+			"property setter for $prop did a break"
+		} on continue {} {
+		    return -code error -level 2 -errorcode {TCLOO SHENANIGANS} \
+			"property setter for $prop did a continue"
+		}
+	    }
+	    return
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# oo::configuresupport::configurable --
+	#
+	#	The class that contains the implementation of the actual
+	#	'configure' method (mixed into actually configurable classes).
+	#	Great care needs to be taken in these methods as they are
+	#	potentially used in classes where the current namespace is set
+	#	up very strangely.
+	#
+	# ------------------------------------------------------------------
+
+	::oo::class create configurable {
+	    private variable my
+	    #
+	    # configure --
+	    #	Method for providing client access to the property mechanism.
+	    #	Has a user-facing API similar to that of [chan configure].
+	    #
+	    method configure -export args {
+		::if {![::info exists my]} {
+		    ::set my [::namespace which my]
+		}
+		::if {[::llength $args] == 0} {
+		    # Read all properties
+		    ::oo::configuresupport::ReadAll [self] $my
+		} elseif {[::llength $args] == 1} {
+		    # Read a single property
+		    ::oo::configuresupport::ReadOne [self] $my \
+			[::lindex $args 0]
+		} elseif {[::llength $args] % 2 == 0} {
+		    # Set properties, one or several
+		    ::oo::configuresupport::WriteMany [self] $my $args
+		} else {
+		    # Invalid call
+		    ::return -code error -errorcode {TCL WRONGARGS} \
+			[::format {wrong # args: should be "%s"} \
+			    "[self] configure ?-option value ...?"]
+		}
+	    }
+
+	    definitionnamespace -instance configurableobject
+	    definitionnamespace -class configurableclass
+	}
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::configurable --
+    #
+    #	A metaclass that is used to make classes that can be configured in
+    #	their creation phase (and later too). All the metaclass itself does is
+    #	arrange for the class created to have a 'configure' method and for
+    #	oo::define and oo::objdefine (on the class and its instances) to have
+    #	a property definition for setting things up for 'configure'.
+    #
+    # ----------------------------------------------------------------------
+
+    class create configurable {
+	superclass class
+
+	constructor {{definitionScript ""}} {
+	    next {mixin ::oo::configuresupport::configurable}
+	    next $definitionScript
+	}
+
+	definitionnamespace -class configuresupport::configurableclass
+    }
 }
 
 # Local Variables: