diff options
| -rw-r--r-- | tests/struct.scm | 7 | ||||
| -rw-r--r-- | weeb/struct.scm | 5 |
2 files changed, 12 insertions, 0 deletions
diff --git a/tests/struct.scm b/tests/struct.scm index 64f4137..dcc6770 100644 --- a/tests/struct.scm +++ b/tests/struct.scm @@ -24,6 +24,13 @@ (test-eqv 5 x) (test-eqv 15 y))))) +(test-group "instance-of?" + (define-struct <animal> species) + (define-struct <dog> breed) + (let ((my-dog (make-struct <dog> "Labrador"))) + (test-assert (instance-of? <dog> my-dog)) + (test-assert (not (instance-of? <animal> my-dog))))) + (test-group "error-handling" (define-struct <empty>) (test-error #t (make-struct <empty> 1))) diff --git a/weeb/struct.scm b/weeb/struct.scm index 64349ef..65fa2ab 100644 --- a/weeb/struct.scm +++ b/weeb/struct.scm @@ -20,6 +20,7 @@ #:use-module (ice-9 regex) #:export (define-struct make-struct + instance-of? with-accessors call-with-slots)) @@ -40,6 +41,10 @@ instantiate the record's fields." (apply (record-constructor type) args)) +(define (instance-of? type rtd) + "Returns true if RTD is an instance of TYPE." + ((record-predicate type) rtd)) + ;; Bind the accessors for the fields of the record RTD to local ;; variables in BODY. RTD must be a record type descriptor. (define-syntax with-accessors |