diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2021-07-27 22:33:01 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2021-07-27 22:33:01 -0700 |
| commit | ac8a694beb385af6d2bdb464ba67b1a7c044cef7 (patch) | |
| tree | da5f87b3724b24364190ee887a648805415b9015 /tests/012 | |
| parent | 8384b0fbcbf329dd7f234546f50f2600a5c8b6b4 (diff) | |
| download | txr-ac8a694beb385af6d2bdb464ba67b1a7c044cef7.tar.gz txr-ac8a694beb385af6d2bdb464ba67b1a7c044cef7.tar.bz2 txr-ac8a694beb385af6d2bdb464ba67b1a7c044cef7.zip | |
subtypep: handle struct type objects.
The subtypep function has poor requirements, handling only type
symbols. Let's extend it to handle structure type objects.
* lib.c (subtypep): In all cases when an argument is considered to be a
possible structure symbol, and thus subject to find_struct_type,
consider whether it already is a struct type, and just take it as-is.
* tests/012/type.tl: New tests.
* txr.1: Updated.
Diffstat (limited to 'tests/012')
| -rw-r--r-- | tests/012/type.tl | 48 |
1 files changed, 48 insertions, 0 deletions
diff --git a/tests/012/type.tl b/tests/012/type.tl index 0cac2581..97007b3c 100644 --- a/tests/012/type.tl +++ b/tests/012/type.tl @@ -18,3 +18,51 @@ (mtest (subtypep 'stream 'stdio-stream) nil (subtypep 'stdio-stream 'stream) t) + +(defstruct xtime time) +(defstruct nottime nil) + +(mtest + (typep #S(time) 'time) t + (typep #S(time) (find-struct-type 'time)) t + (typep #S(xtime) 'time) t + (typep #S(xtime) (find-struct-type 'time)) t + (typep #S(nottime) 'time) nil + (typep #S(nottime) (find-struct-type 'time)) nil) + +(mtest + (subtypep (find-struct-type 'time) (find-struct-type 'time)) t + (subtypep (find-struct-type 'time) 'time) t + (subtypep 'time (find-struct-type 'time)) t) + +(mtest + (subtypep (find-struct-type 'xtime) (find-struct-type 'time)) t + (subtypep (find-struct-type 'xtime) 'time) t + (subtypep 'xtime (find-struct-type 'time)) t) + +(mtest + (subtypep (find-struct-type 'time) (find-struct-type 'xtime)) nil + (subtypep (find-struct-type 'time) 'xtime) nil + (subtypep 'time (find-struct-type 'xtime)) nil) + +(mtest + (subtypep 'time 'struct) t + (subtypep (find-struct-type 'time) 'struct) t + (subtypep 'hash 'struct) nil) + +(defstruct listlike nil + (:method car (me))) + +(defstruct veclike nil + (:method length (me))) + +(mtest + (subtypep 'listlike 'sequence) t + (subtypep (find-struct-type 'listlike) 'sequence) t + (subtypep 'veclike 'sequence) t + (subtypep (find-struct-type 'veclike) 'sequence) t + (subtypep 'time 'sequence) nil + (subtypep 'hash 'sequence) nil + (subtypep 'str 'sequence) t + (subtypep 'string 'sequence) t + (subtypep 'vec 'sequence) t) |