From 90a49ef206a9da28f0575a2515f87d84cdfef01f Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Tue, 4 Mar 2003 13:38:36 +0000
Subject: [PATCH] Tests for equivalence of some vector types with their
 definitions.

---
 ansi-tests/subtypep-array.lsp | 147 +++++++++++++++++++++++++++++++++-
 1 file changed, 146 insertions(+), 1 deletion(-)

diff --git a/ansi-tests/subtypep-array.lsp b/ansi-tests/subtypep-array.lsp
index 3fbe1300..33ea691e 100644
--- a/ansi-tests/subtypep-array.lsp
+++ b/ansi-tests/subtypep-array.lsp
@@ -95,4 +95,149 @@
   nil)
 
 		 
-		 
\ No newline at end of file
+
+;;;; Tests on the definitions of various vector types
+
+(deftest string-is-vector-of-character.1
+  (subtypep* 'string '(vector character))
+  t t)
+
+(deftest string-is-vector-of-character.2
+  (subtypep* '(vector character) 'string)
+  t t)
+
+(deftest string-is-vector-of-character.3
+  (subtypep* '(string *) '(vector character))
+  t t)
+
+(deftest string-is-vector-of-character.4
+  (subtypep* '(vector character) '(string *))
+  t t)
+
+(deftest string-is-vector-of-character.5
+  (subtypep* '(string 17) '(vector character 17))
+  t t)
+
+(deftest string-is-vector-of-character.6
+  (subtypep* '(vector character 17) '(string 17))
+  t t)
+
+(deftest base-string-is-vector-of-base-char.1
+  (subtypep* 'base-string '(vector base-char))
+  t t)
+
+(deftest base-string-is-vector-of-base-char.2
+  (subtypep* '(vector base-char) 'base-string)
+  t t)
+
+(deftest base-string-is-vector-of-base-char.3
+  (subtypep* '(base-string *) '(vector base-char))
+  t t)
+
+(deftest base-string-is-vector-of-base-char.4
+  (subtypep* '(vector base-char) '(base-string *))
+  t t)
+
+(deftest base-string-is-vector-of-base-char.5
+  (subtypep* '(base-string 17) '(vector base-char 17))
+  t t)
+
+(deftest base-string-is-vector-of-base-char.6
+  (subtypep* '(vector base-char 17) '(base-string 17))
+  t t)
+
+(deftest simple-base-string-is-simple-1d-array-of-base-char.1
+  (subtypep* 'simple-base-string '(simple-array base-char (*)))
+  t t)
+
+(deftest simple-base-string-is-simple-1d-array-of-base-char.2
+  (subtypep* '(simple-array base-char (*)) 'simple-base-string)
+  t t)
+
+(deftest simple-base-string-is-simple-1d-array-of-base-char.3
+  (subtypep* '(simple-base-string *) '(simple-array base-char (*)))
+  t t)
+
+(deftest simple-base-string-is-simple-1d-array-of-base-char.4
+  (subtypep* '(simple-array base-char (*)) '(simple-base-string *))
+  t t)
+
+(deftest simple-base-string-is-simple-1d-array-of-base-char.5
+  (subtypep* '(simple-base-string 17) '(simple-array base-char (17)))
+  t t)
+
+(deftest simple-base-string-is-simple-1d-array-of-base-char.6
+  (subtypep* '(simple-array base-char (17)) '(simple-base-string 17))
+  t t)
+
+(deftest simple-string-is-simple-1d-array-of-character.1
+  (subtypep* 'simple-string '(simple-array character (*)))
+  t t)
+
+(deftest simple-string-is-simple-1d-array-of-character.2
+  (subtypep* '(simple-array character (*)) 'simple-string)
+  t t)
+
+(deftest simple-string-is-simple-1d-array-of-character.3
+  (subtypep* '(simple-string *) '(simple-array character (*)))
+  t t)
+
+(deftest simple-string-is-simple-1d-array-of-character.4
+  (subtypep* '(simple-array character (*)) '(simple-string *))
+  t t)
+
+(deftest simple-string-is-simple-1d-array-of-character.5
+  (subtypep* '(simple-string 17) '(simple-array character (17)))
+  t t)
+
+(deftest simple-string-is-simple-1d-array-of-character.6
+  (subtypep* '(simple-array character (17)) '(simple-string 17))
+  t t)
+
+(deftest vector-is-1d-array.1
+  (subtypep* 'vector '(array * (*)))
+  t t)
+
+(deftest vector-is-1d-array.2
+  (subtypep* '(array * (*)) 'vector)
+  t t)
+
+(deftest vector-is-1d-array.3
+  (subtypep* '(vector *) '(array * (*)))
+  t t)
+
+(deftest vector-is-1d-array.4
+  (subtypep* '(array * (*)) '(vector *))
+  t t)
+
+(deftest vector-is-1d-array.5
+  (subtypep* '(vector * 17) '(array * (17)))
+  t t)
+
+(deftest vector-is-1d-array.6
+  (subtypep* '(array * (17)) '(vector * 17))
+  t t)
+
+(deftest simple-vector-is-simple-1d-array.1
+  (subtypep* 'simple-vector '(simple-array t (*)))
+  t t)
+
+(deftest simple-vector-is-simple-1d-array.2
+  (subtypep* '(simple-array t (*)) 'simple-vector)
+  t t)
+
+(deftest simple-vector-is-simple-1d-array.3
+  (subtypep* '(simple-vector *) '(simple-array t (*)))
+  t t)
+
+(deftest simple-vector-is-simple-1d-array.4
+  (subtypep* '(simple-array t (*)) '(simple-vector *))
+  t t)
+
+(deftest simple-vector-is-simple-1d-array.5
+  (subtypep* '(simple-vector 17) '(simple-array t (17)))
+  t t)
+
+(deftest simple-vector-is-simple-1d-array.6
+  (subtypep* '(simple-array t (17)) '(simple-vector 17))
+  t t)
-- 
GitLab