From ac8a694beb385af6d2bdb464ba67b1a7c044cef7 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 27 Jul 2021 22:33:01 -0700
Subject: 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.
---
 tests/012/type.tl | 48 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)

(limited to 'tests/012/type.tl')

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)
-- 
cgit v1.2.3