Skip to content

Commit

Permalink
Make <type-error> conform better to the DRM
Browse files Browse the repository at this point in the history
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>`
  • Loading branch information
cgay committed Jun 12, 2024
1 parent 54f53bb commit b7a91ec
Show file tree
Hide file tree
Showing 6 changed files with 40 additions and 30 deletions.
Original file line number Diff line number Diff line change
Expand Up @@ -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*

Expand All @@ -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:
Expand Down
11 changes: 11 additions & 0 deletions sources/common-dylan/format.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -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>)
=> ()
Expand Down
6 changes: 6 additions & 0 deletions sources/common-dylan/tests/condition-test-utilities.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down
13 changes: 0 additions & 13 deletions sources/dylan/class.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -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>)
Expand Down
15 changes: 3 additions & 12 deletions sources/dylan/condition-extras.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
8 changes: 7 additions & 1 deletion sources/dylan/tests/specification.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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?

Expand Down

0 comments on commit b7a91ec

Please sign in to comment.