From b301f2d985abc3ab76618ff29e1dc6b1cd04cacd Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Thu, 2 Sep 2004 11:47:20 +0000
Subject: [PATCH] More specialized string tests

---
 ansi-tests/pathname.lsp | 46 +++++++++++++++++++++++++++++++++++++++++
 ansi-tests/stringp.lsp  | 25 ++++++++++++++++++++++
 2 files changed, 71 insertions(+)

diff --git a/ansi-tests/pathname.lsp b/ansi-tests/pathname.lsp
index f5d64b92..08ac1280 100644
--- a/ansi-tests/pathname.lsp
+++ b/ansi-tests/pathname.lsp
@@ -31,6 +31,52 @@
 	always (eq x (pathname x)))
   t)
 
+(deftest pathname.6
+  (equalt #p"ansi-aux.lsp"
+	  (pathname (make-array 12 :initial-contents "ansi-aux.lsp"
+				:element-type 'base-char)))
+  t)
+
+(deftest pathname.7
+  (equalt #p"ansi-aux.lsp"
+	  (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX"
+				:element-type 'base-char
+				:fill-pointer 12)))
+  t)
+
+(deftest pathname.8
+  (equalt #p"ansi-aux.lsp"
+	  (pathname (make-array 12 :initial-contents "ansi-aux.lsp"
+				:element-type 'base-char
+				:adjustable t)))
+  t)
+
+(deftest pathname.9
+  (equalt #p"ansi-aux.lsp"
+	  (pathname (make-array 15 :initial-contents "ansi-aux.lspXXX"
+				:element-type 'character
+				:fill-pointer 12)))
+  t)
+
+(deftest pathname.10
+  (equalt #p"ansi-aux.lsp"
+	  (pathname (make-array 12 :initial-contents "ansi-aux.lsp"
+				:element-type 'character
+				:adjustable t)))
+  t)
+
+(deftest pathname.11
+  (loop for etype in '(standard-char base-char character)
+	collect
+	(equalt #p"ansi-aux.lsp"
+		(pathname
+		 (let* ((s (make-array 15 :initial-contents "XXansi-aux.lspX"
+				       :element-type etype)))
+		   (make-array 12 :element-type etype
+			       :displaced-to s
+			       :displaced-index-offset 2)))))
+  (t t t))
+
 ;;; Error tests
 
 (deftest pathname.error.1
diff --git a/ansi-tests/stringp.lsp b/ansi-tests/stringp.lsp
index 81fb2268..8fc72a87 100644
--- a/ansi-tests/stringp.lsp
+++ b/ansi-tests/stringp.lsp
@@ -57,3 +57,28 @@
   :notes (:nil-vectors-are-strings)
   (notnot-mv (stringp (make-array '(37) :element-type nil)))
   t)
+
+(deftest stringp.11
+  (notnot (stringp (make-array 4 :element-type 'base-char
+			       :fill-pointer 2
+			       :initial-contents '(#\a #\b #\c #\d))))
+  t)
+
+(deftest stringp.12
+  (notnot (stringp (make-array 4 :element-type 'base-char
+			       :adjustable t
+			       :initial-contents '(#\a #\b #\c #\d))))
+  t)
+
+(deftest stringp.13
+  (notnot (stringp (make-array 4 :element-type 'character
+			       :fill-pointer 2
+			       :initial-contents '(#\a #\b #\c #\d))))
+  t)
+
+(deftest stringp.14
+  (notnot (stringp (make-array 4 :element-type 'character
+			       :adjustable t
+			       :initial-contents '(#\a #\b #\c #\d))))
+  t)
+
-- 
GitLab