Make <type-error> conform better to the DRM

While looking at getting rid of the `<format-string-condition>` alias for
`<simple-condition>` I ran into recursive errors in the test suite due to the
generic tests for conditions trying to make a `<type-error>` without init args.

* Rather than subclassing `(<error>, <format-string-condition>)` and having a
  make method that also creates the right values for `format-string:` and
  format-arguments:, just subclass `<error>` (as specified by the DRM) and keep the
  already existing condition-to-string method.

* Make both value: and type: be required init keywords. Potentially
  controversial since they're not specified as required in the DRM, but the
  error is meaningless without these slots set and this would have uncovered the
  test suite bug right away.

* Add `make-condition(<type-error>)` method in dylan-test-suite that passes
  value: and type: init args.

* Treat `<slot-type-error>` similarly to `<type-error>`

Author: cgay

documentation/source/library-reference/common-dylan/common-extensions.rst

@@ -132,7 +132,7 @@ The extensions are:
 .. generic-function:: condition-to-string
    :open:
 
-   Returns a string representation of a condition object.
+   Returns a :drm:`<string>` representation of a condition object.
 
    :signature: condition-to-string *condition* => *string*
 
@@ -142,9 +142,18 @@ The extensions are:
    :description:
 
      Returns a string representation of a general instance of
-     :drm:`<condition>`. There is a method on
-     :class:`<format-string-condition>` and method on
-     :drm:`<type-error>`.
+     :drm:`<condition>`.
+
+     For many condition classes it is sufficient to subclass
+     :drm:`<simple-error>`, :drm:`<simple-warning>`, or :drm:`<simple-restart>`
+     and to use the ``format-string:`` and ``format-arguments:`` init keywords
+     they provide (via their superclass :class:`<simple-condition>`) in order
+     to control how the error is displayed to the user. However, in cases where
+     that is insufficient, this method should be implemented.
+
+   :seealso:
+
+      - :class:`<simple-condition>`
 
 .. macro:: debug-assert
    :statement:

sources/common-dylan/format.dylan

@@ -595,6 +595,17 @@ define method condition-to-string
                    type-error-expected-type(error))
 end method condition-to-string;
 
+define method condition-to-string
+    (err :: <slot-type-error>) => (s :: <string>)
+  let descriptor = err.slot-type-error-slot-descriptor;
+  format-to-string("Incorrect type for the %= init-keyword to %=. "
+                     "The given value, %=, is not of type %=.",
+                   descriptor.init-keyword,
+                   descriptor.slot-owner,
+                   err.type-error-value,
+                   err.type-error-expected-type)
+end method;
+
 define method print-pretty-name
     (buffer :: <string-buffer>, condition :: <condition>)
  => ()

sources/common-dylan/tests/condition-test-utilities.dylan

@@ -66,6 +66,12 @@ define method test-condition (condition :: <type-error>) => ()
             ))
 end method test-condition;
 
+define method make-condition (class == <type-error>) => (c :: <type-error>)
+  make(<type-error>,
+       value: #"type-error-value",
+       type: <string>)
+end method;
+
 define method test-condition (condition :: <simple-warning>) => ()
   next-method();
   do(method (function) function(condition) end,

sources/dylan/class.dylan

@@ -240,19 +240,6 @@ define class <slot-type-error> (<type-error>)
     required-init-keyword: slot-descriptor:;
 end;
 
-define method make
-    (class == <slot-type-error>, #rest keys, #key value, type, slot-descriptor)
- => (error :: <slot-type-error>)
-  apply(next-method, class,
-        format-string: "Incorrect type for the %= init-keyword to %=.  "
-          "The given value, %=, is not of type %=.",
-        format-arguments: list(slot-descriptor.init-keyword,
-                               slot-descriptor.slot-owner,
-                               value,
-                               slot-descriptor.slot-type),
-        keys)
-end method make;
-
 define function keyword-value
     (descriptor :: <slot-descriptor>, iclass :: <implementation-class>,
      init-args :: <simple-object-vector>)

sources/dylan/condition-extras.dylan

@@ -89,20 +89,11 @@ end method abort;
 
 /// TYPE-ERRORS
 
-define open class <type-error> (<error>, <format-string-condition>)  // Should be sealed?
-  constant slot type-error-value, init-keyword: value:;
-  constant slot type-error-expected-type :: <type>, init-keyword: type:;
+define sealed class <type-error> (<error>)
+  constant slot type-error-value, required-init-keyword: value:;
+  constant slot type-error-expected-type :: <type>, required-init-keyword: type:;
 end class <type-error>;
 
-define method make
-    (class == <type-error>, #rest keys, #key value, type)
- => (error :: <type-error>)
-  apply(next-method, class,
-        format-string: "%= is not of type %=",
-        format-arguments: vector(value, type),
-        keys)
-end method make;
-
 define inline method check-type (value, type)
   unless (instance?(value, type))
     type-check-error(value, type)

sources/dylan/tests/specification.dylan

@@ -238,7 +238,7 @@ define interface-specification-suite dylan-conditions-specification-suite ()
   open abstract class <serious-condition> (<condition>);
   sealed instantiable class <simple-error> (<error>);
   sealed instantiable class <simple-warning> (<warning>);
-  sealed instantiable class <type-error> (<error>);
+  sealed instantiable class <type-error> (<error>); // make-test-instance method below.
   open abstract class <warning> (<condition>);
 
   /// Restarts
@@ -286,6 +286,12 @@ define interface-specification-suite dylan-conditions-specification-suite ()
     expected-to-fail-reason: "https://github.com/dylan-lang/opendylan/issues/1295";
 end dylan-conditions-specification-suite;
 
+define sideways method make-test-instance (class == <type-error>) => (err :: <type-error>)
+  make(<type-error>,
+       value: #"type-error-value",
+       type: <string>)
+end method;
+
 //--- Bindings not defined by the DRM
 //---*** Are there any others?