From b7a91ecfaa2edc7fc341125db0de395461ddc2fd Mon Sep 17 00:00:00 2001 From: Carl Gay Date: Wed, 12 Jun 2024 10:20:00 -0400 Subject: [PATCH] Make conform better to the DRM While looking at getting rid of the `` alias for `` I ran into recursive errors in the test suite due to the generic tests for conditions trying to make a `` without init args. * Rather than subclassing `(, )` and having a make method that also creates the right values for `format-string:` and format-arguments:, just subclass `` (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()` method in dylan-test-suite that passes value: and type: init args. * Treat `` similarly to `` --- .../common-dylan/common-extensions.rst | 17 +++++++++++++---- sources/common-dylan/format.dylan | 11 +++++++++++ .../tests/condition-test-utilities.dylan | 6 ++++++ sources/dylan/class.dylan | 13 ------------- sources/dylan/condition-extras.dylan | 15 +++------------ sources/dylan/tests/specification.dylan | 8 +++++++- 6 files changed, 40 insertions(+), 30 deletions(-) diff --git a/documentation/source/library-reference/common-dylan/common-extensions.rst b/documentation/source/library-reference/common-dylan/common-extensions.rst index 7bb3fffe67..ea1cb6bf86 100644 --- a/documentation/source/library-reference/common-dylan/common-extensions.rst +++ b/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:`` 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:``. There is a method on - :class:`` and method on - :drm:``. + :drm:``. + + For many condition classes it is sufficient to subclass + :drm:``, :drm:``, or :drm:`` + and to use the ``format-string:`` and ``format-arguments:`` init keywords + they provide (via their superclass :class:``) 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:`` .. macro:: debug-assert :statement: diff --git a/sources/common-dylan/format.dylan b/sources/common-dylan/format.dylan index 6860ddcfac..a01c14b8e5 100644 --- a/sources/common-dylan/format.dylan +++ b/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 :: ) => (s :: ) + 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 :: , condition :: ) => () diff --git a/sources/common-dylan/tests/condition-test-utilities.dylan b/sources/common-dylan/tests/condition-test-utilities.dylan index d9ca4d8ec2..c47811638e 100644 --- a/sources/common-dylan/tests/condition-test-utilities.dylan +++ b/sources/common-dylan/tests/condition-test-utilities.dylan @@ -66,6 +66,12 @@ define method test-condition (condition :: ) => () )) end method test-condition; +define method make-condition (class == ) => (c :: ) + make(, + value: #"type-error-value", + type: ) +end method; + define method test-condition (condition :: ) => () next-method(); do(method (function) function(condition) end, diff --git a/sources/dylan/class.dylan b/sources/dylan/class.dylan index e681c823e7..a2536cd012 100644 --- a/sources/dylan/class.dylan +++ b/sources/dylan/class.dylan @@ -240,19 +240,6 @@ define class () required-init-keyword: slot-descriptor:; end; -define method make - (class == , #rest keys, #key value, type, slot-descriptor) - => (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 :: , iclass :: , init-args :: ) diff --git a/sources/dylan/condition-extras.dylan b/sources/dylan/condition-extras.dylan index 5d9e09fb86..073333d84c 100644 --- a/sources/dylan/condition-extras.dylan +++ b/sources/dylan/condition-extras.dylan @@ -89,20 +89,11 @@ end method abort; /// TYPE-ERRORS -define open class (, ) // Should be sealed? - constant slot type-error-value, init-keyword: value:; - constant slot type-error-expected-type :: , init-keyword: type:; +define sealed class () + constant slot type-error-value, required-init-keyword: value:; + constant slot type-error-expected-type :: , required-init-keyword: type:; end class ; -define method make - (class == , #rest keys, #key value, 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) diff --git a/sources/dylan/tests/specification.dylan b/sources/dylan/tests/specification.dylan index 81daafbb38..46c50f63da 100644 --- a/sources/dylan/tests/specification.dylan +++ b/sources/dylan/tests/specification.dylan @@ -238,7 +238,7 @@ define interface-specification-suite dylan-conditions-specification-suite () open abstract class (); sealed instantiable class (); sealed instantiable class (); - sealed instantiable class (); + sealed instantiable class (); // make-test-instance method below. open abstract class (); /// 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 == ) => (err :: ) + make(, + value: #"type-error-value", + type: ) +end method; + //--- Bindings not defined by the DRM //---*** Are there any others?