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