diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index ba8089321166e322e2565317b6166458c720b762..2479b7e27c9d66a8edd80a745baeb39714166069 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -420,14 +420,15 @@ the condition to go uncaught if it cannot be classified." ") (defparameter - +base-chars+ #.(concatenate 'string + +base-chars+ #.(concatenate 'simple-base-string "abcdefghijklmnopqrstuvwxyz" "ABCDEFGHIJKLMNOPQRSTUVWXYZ" "0123456789" "<,>.?/\"':;[{]}~`!@#$%^&*()_-+= \\|")) -(defparameter +num-base-chars+ (length +base-chars+)) +(declaim (type simple-base-string +base-chars+)) +(defparameter +num-base-chars+ (length +base-chars+)) (defparameter +alpha-chars+ (subseq +standard-chars+ 0 52)) (defparameter +lower-case-chars+ (subseq +alpha-chars+ 0 26)) @@ -435,11 +436,16 @@ the condition to go uncaught if it cannot be classified." (defparameter +alphanumeric-chars+ (subseq +standard-chars+ 0 62)) (defparameter +digit-chars+ "0123456789") (defparameter +extended-digit-chars+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ") + +(declaim (type simple-base-string +alpha-chars+ +lower-case-chars+ + +upper-case-chars+ +alphanumeric-chars+)) + (defparameter +code-chars+ (coerce (loop for i from 0 below 256 for c = (code-char i) when c collect c) 'string)) + (defparameter +rev-code-chars+ (reverse +code-chars+)) ;;; Used in checking for continuable errors diff --git a/ansi-tests/compile-and-load.lsp b/ansi-tests/compile-and-load.lsp index 435f2f6a1e43c57fd6d4a306a96b98863f0a998b..a1a3e500f2fef2405df09178f4ab9b8741ac90f0 100644 --- a/ansi-tests/compile-and-load.lsp +++ b/ansi-tests/compile-and-load.lsp @@ -30,7 +30,7 @@ (file-write-date compile-pathname)))) (unless (and (not force) former-data - (<= (cadr former-data) source-write-time)) + (>= (cadr former-data) source-write-time)) (when (or (not target-write-time) (<= target-write-time source-write-time)) (compile-file pathname)) diff --git a/ansi-tests/concatenate.lsp b/ansi-tests/concatenate.lsp index 6fdb214fd10a79a2b3a2ca98af296e0f3f5affc7..fd40f3a0c679f52231ac3b783a05659d6741bbb9 100644 --- a/ansi-tests/concatenate.lsp +++ b/ansi-tests/concatenate.lsp @@ -184,6 +184,14 @@ #*01100 nil) +(deftest concatenate.31 + (concatenate 'string "abc" (make-array '(0) :element-type nil) "def") + "abcdef") + +(deftest concatenate.32 + (concatenate '(array nil (*))) + "") + (deftest concatenate.order.1 (let ((i 0) w x y z) (values diff --git a/ansi-tests/copy-seq.lsp b/ansi-tests/copy-seq.lsp index bb2cd1e14767fe33ad83113d5537cd631a469731..4cba413d250bff7807cceb10ffb61c9e612d7af5 100644 --- a/ansi-tests/copy-seq.lsp +++ b/ansi-tests/copy-seq.lsp @@ -154,6 +154,10 @@ (equal-array x y)) t) +(deftest copy-seq.19 + (copy-seq (make-array '(0) :element-type nil)) + "") + (deftest copy-seq.order.1 (let ((i 0)) (values (copy-seq (progn (incf i) "abc")) i)) diff --git a/ansi-tests/equal.lsp b/ansi-tests/equal.lsp index a2a524441f06abb7a8ef10feef8afc855a1538da..e2ab6d789285df376c8f57be6ed7a61a5725609e 100644 --- a/ansi-tests/equal.lsp +++ b/ansi-tests/equal.lsp @@ -61,6 +61,18 @@ (equalt (copy-seq #*000110) (copy-seq #*000111)) nil) +(deftest equal.13 + (let ((x (make-array '(0) :element-type nil)) + (y (make-array '(0) :element-type nil))) + (equalt x y)) + t) + +(deftest equal.14 + (and + (equalt (make-array '(0) :element-type nil) "") + (equalt "" (make-array '(0) :element-type nil))) + t) + (deftest equal.order.1 (let ((i 0) x y) (values diff --git a/ansi-tests/equalp.lsp b/ansi-tests/equalp.lsp index 5248fc735c7bc5d4b2df3a684d30e4b2bf1077da..81468ca2a42e6bcc7e1457447ef41261d07f8674 100644 --- a/ansi-tests/equalp.lsp +++ b/ansi-tests/equalp.lsp @@ -27,6 +27,14 @@ (equalpt "abc" "abd") nil) +(deftest equalp.5 + (equalpt (make-array '(0) :element-type nil) #()) + t) + +(deftest equalp.6 + (equalpt (make-array '(0) :element-type nil) "") + t) + (deftest equalp.order.1 (let ((i 0) x y) (values diff --git a/ansi-tests/make-symbol.lsp b/ansi-tests/make-symbol.lsp index f2aa1936f361172f9c950f17cdffc90e1ffc8fb0..522e198f42f022aa7761c91524bc5348a6f2e384 100644 --- a/ansi-tests/make-symbol.lsp +++ b/ansi-tests/make-symbol.lsp @@ -46,6 +46,10 @@ (symbol-name (make-symbol "")) "") +(deftest make-symbol.11 + (symbol-name (make-symbol (make-array '(0) :element-type nil))) + "") + (deftest make-symbol.order.1 (let ((i 0)) (values diff --git a/ansi-tests/nstring-capitalize.lsp b/ansi-tests/nstring-capitalize.lsp index 9c9eb17026e8862e9041d55902e106d0c102ff04..98a454bba212066d263c28b2e3cd7e8ad06f16f4 100644 --- a/ansi-tests/nstring-capitalize.lsp +++ b/ansi-tests/nstring-capitalize.lsp @@ -60,6 +60,14 @@ ("ABCDEF" "ABCDEF" "ABCDEf") ("ABCDEF" "ABCDEF"))) +(deftest nstring-capitalize.11 + (nstring-capitalize "") + "") + +(deftest nstring-capitalize.12 + (nstring-capitalize (make-array '(0) :element-type nil)) + "") + (deftest nstring-capitalize.order.1 (let ((i 0) a b c (s (copy-seq "abcdef"))) (values diff --git a/ansi-tests/nstring-downcase.lsp b/ansi-tests/nstring-downcase.lsp index 409bc3c7238cf9d71cf2108e652f632cc72f83b6..e3b7ef27afc89dc128fbc9428c4b410e9f760cfa 100644 --- a/ansi-tests/nstring-downcase.lsp +++ b/ansi-tests/nstring-downcase.lsp @@ -67,6 +67,10 @@ ("abcde" "abcDe" "abcDE") ("abcde" "abcdE"))) +(deftest nstring-downcase.11 + (nstring-downcase (make-array '(0) :element-type nil)) + "") + (deftest nstring-downcase.order.1 (let ((i 0) a b c (s (copy-seq "ABCDEF"))) (values diff --git a/ansi-tests/nstring-upcase.lsp b/ansi-tests/nstring-upcase.lsp index 5f6baf17be1e630098e2a5697c35ada68c7c1208..e9c80f488bfa7eed277c9135ce0db123ac37aca3 100644 --- a/ansi-tests/nstring-upcase.lsp +++ b/ansi-tests/nstring-upcase.lsp @@ -66,6 +66,10 @@ ("abcde" "abcDe" "abcDE") ("abcde" "abcdE"))) +(deftest nstring-upcase.11 + (nstring-upcase (make-array '(0) :element-type nil)) + "") + (deftest nstring-upcase.order.1 (let ((i 0) a b c (s (copy-seq "abcdef"))) (values diff --git a/ansi-tests/string-capitalize.lsp b/ansi-tests/string-capitalize.lsp index 82be8ce64e71effe9d3fdcafa48fd4c4e1a33bc9..6c8509e59bf0708a08ce960955539e40ce1cea8e 100644 --- a/ansi-tests/string-capitalize.lsp +++ b/ansi-tests/string-capitalize.lsp @@ -84,6 +84,10 @@ ("ABCDEF" "ABCDEF")) "ABCDEF") +(deftest string-capitalize.11 + (string-capitalize (make-array '(0) :element-type nil)) + "") + (deftest string-capitalize.order.1 (let ((i 0) a b c (s (copy-seq "abcdef"))) (values diff --git a/ansi-tests/string-comparisons.lsp b/ansi-tests/string-comparisons.lsp index 617390eff50eb12178ffe01bfd3fe8fce08d3008..66c5e901ae51c72d5e48321ef3a8115bee78d2de 100644 --- a/ansi-tests/string-comparisons.lsp +++ b/ansi-tests/string-comparisons.lsp @@ -5,6 +5,8 @@ (in-package :cl-test) +(compile-and-load "string-aux.lsp") + (deftest string=.1 (not (string= "abc" (copy-seq "abc"))) nil) @@ -501,6 +503,152 @@ ((= nil 0) (= t 0) (/= nil 0) (/= t 0) (< nil 0) (< t 0) (> nil 0) (> t 0) (<= nil 0) (<= t 0) (>= nil 0) (>= t 0))) +;;; Tests on nil arrays + +(deftest string=.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (notnot (string= s1 s1)) + (notnot (string= s1 (make-array '(0) :element-type nil))) + (notnot (string= s1 (make-array '(0) :element-type 'base-char))) + (notnot (string= s1 "")) + (notnot (string= "" s1)) + (string= s1 "a") + (string= "a" s1))) + t t t t t nil nil) + +(deftest string/=.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string/= s1 s1) + (string/= s1 (make-array '(0) :element-type nil)) + (string/= s1 (make-array '(0) :element-type 'base-char)) + (string/= s1 "") + (string/= "" s1) + (string/= s1 "a") + (string/= "a" s1))) + nil nil nil nil nil 0 0) + +(deftest string<.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string< s1 s1) + (string< s1 (make-array '(0) :element-type nil)) + (string< s1 (make-array '(0) :element-type 'base-char)) + (string< s1 "") + (string< "" s1) + (string< s1 "a") + (string< "a" s1))) + nil nil nil nil nil 0 nil) + +(deftest string<=.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string<= s1 s1) + (string<= s1 (make-array '(0) :element-type nil)) + (string<= s1 (make-array '(0) :element-type 'base-char)) + (string<= s1 "") + (string<= "" s1) + (string<= s1 "a") + (string<= "a" s1))) + 0 0 0 0 0 0 nil) + +(deftest string>.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string> s1 s1) + (string> s1 (make-array '(0) :element-type nil)) + (string> s1 (make-array '(0) :element-type 'base-char)) + (string> s1 "") + (string> "" s1) + (string> s1 "a") + (string> "a" s1))) + nil nil nil nil nil nil 0) + +(deftest string>=.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string>= s1 s1) + (string>= s1 (make-array '(0) :element-type nil)) + (string>= s1 (make-array '(0) :element-type 'base-char)) + (string>= s1 "") + (string>= "" s1) + (string>= s1 "a") + (string>= "a" s1))) + 0 0 0 0 0 nil 0) + +(deftest string-equal.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (notnot (string-equal s1 s1)) + (notnot (string-equal s1 (make-array '(0) :element-type nil))) + (notnot (string-equal s1 (make-array '(0) :element-type 'base-char))) + (notnot (string-equal s1 "")) + (notnot (string-equal "" s1)) + (string-equal s1 "a") + (string-equal "a" s1))) + t t t t t nil nil) + +(deftest string-not-equal.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string-not-equal s1 s1) + (string-not-equal s1 (make-array '(0) :element-type nil)) + (string-not-equal s1 (make-array '(0) :element-type 'base-char)) + (string-not-equal s1 "") + (string-not-equal "" s1) + (string-not-equal s1 "a") + (string-not-equal "a" s1))) + nil nil nil nil nil 0 0) + +(deftest string-lessp.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string-lessp s1 s1) + (string-lessp s1 (make-array '(0) :element-type nil)) + (string-lessp s1 (make-array '(0) :element-type 'base-char)) + (string-lessp s1 "") + (string-lessp "" s1) + (string-lessp s1 "a") + (string-lessp "a" s1))) + nil nil nil nil nil 0 nil) + +(deftest string-not-greaterp.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string-not-greaterp s1 s1) + (string-not-greaterp s1 (make-array '(0) :element-type nil)) + (string-not-greaterp s1 (make-array '(0) :element-type 'base-char)) + (string-not-greaterp s1 "") + (string-not-greaterp "" s1) + (string-not-greaterp s1 "a") + (string-not-greaterp "a" s1))) + 0 0 0 0 0 0 nil) + +(deftest string-greaterp.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string-greaterp s1 s1) + (string-greaterp s1 (make-array '(0) :element-type nil)) + (string-greaterp s1 (make-array '(0) :element-type 'base-char)) + (string-greaterp s1 "") + (string-greaterp "" s1) + (string-greaterp s1 "a") + (string-greaterp "a" s1))) + nil nil nil nil nil nil 0) + +(deftest string-not-lessp.nil-array.1 + (let ((s1 (make-array '(0) :element-type nil))) + (values + (string-not-lessp s1 s1) + (string-not-lessp s1 (make-array '(0) :element-type nil)) + (string-not-lessp s1 (make-array '(0) :element-type 'base-char)) + (string-not-lessp s1 "") + (string-not-lessp "" s1) + (string-not-lessp s1 "a") + (string-not-lessp "a" s1))) + 0 0 0 0 0 nil 0) + diff --git a/ansi-tests/string-downcase.lsp b/ansi-tests/string-downcase.lsp index a1c4dd294545c90215df51cc219444980f273ee0..7377c71306b4a3389d137417f4c2e56ce241e5f2 100644 --- a/ansi-tests/string-downcase.lsp +++ b/ansi-tests/string-downcase.lsp @@ -80,6 +80,11 @@ ("abcde" "abcdE")) "ABCDE") +(deftest string-downcase.11 + (string-downcase (make-array '(0) :element-type nil)) + "") + + (deftest string-downcase.order.1 (let ((i 0) a b c (s (copy-seq "ABCDEF"))) (values diff --git a/ansi-tests/string-left-trim.lsp b/ansi-tests/string-left-trim.lsp index c620670c852bb0d999483fd937e14c52ab116646..19fb44e9b7263164be135fcd0a9bffeab9e0fb88 100644 --- a/ansi-tests/string-left-trim.lsp +++ b/ansi-tests/string-left-trim.lsp @@ -141,6 +141,14 @@ (string-left-trim "abc" (copy-seq "abcabcabc")) "") +(deftest string-left-trim.20 + (string-left-trim "abcd" (make-array '(0) :element-type nil)) + "") + +(deftest string-left-trim.21 + (string-left-trim (make-array '(0) :element-type nil) "abcd") + "abcd") + (deftest string-left-trim.order.1 (let ((i 0) x y) (values diff --git a/ansi-tests/string-right-trim.lsp b/ansi-tests/string-right-trim.lsp index 883348e5e209681b806c0cf1887684731481264c..33b562d17128007d5ba24c1c696b5a9694e26035 100644 --- a/ansi-tests/string-right-trim.lsp +++ b/ansi-tests/string-right-trim.lsp @@ -141,6 +141,14 @@ (string-right-trim "abc" (copy-seq "abcabcabc")) "") +(deftest string-right-trim.20 + (string-right-trim "abcd" (make-array '(0) :element-type nil)) + "") + +(deftest string-right-trim.21 + (string-right-trim (make-array '(0) :element-type nil) "abcd") + "abcd") + (deftest string-right-trim.order.1 (let ((i 0) x y) (values diff --git a/ansi-tests/string-trim.lsp b/ansi-tests/string-trim.lsp index a722268d76f02bb0afcd2d5f1dd2197c97efed75..ec432f51e925ac80e4400d100b927fa0482e10f7 100644 --- a/ansi-tests/string-trim.lsp +++ b/ansi-tests/string-trim.lsp @@ -141,6 +141,14 @@ (string-trim "abc" (copy-seq "abcabcabc")) "") +(deftest string-trim.20 + (string-trim "abcd" (make-array '(0) :element-type nil)) + "") + +(deftest string-trim.21 + (string-trim (make-array '(0) :element-type nil) "abcd") + "abcd") + (deftest string-trim.order.1 (let ((i 0) x y) (values diff --git a/ansi-tests/string-upcase.lsp b/ansi-tests/string-upcase.lsp index 4999f5cd7e53386a5d19d83e47afb0813afd295e..8777beee34d30f90aec7236c1a835ed318b2001f 100644 --- a/ansi-tests/string-upcase.lsp +++ b/ansi-tests/string-upcase.lsp @@ -80,6 +80,10 @@ ("abcde" "abcdE")) "abcde") +(deftest string-upcase.11 + (string-upcase (make-array '(0) :element-type nil)) + "") + (deftest string-upcase.order.1 (let ((i 0) a b c (s (copy-seq "abcdef"))) (values diff --git a/ansi-tests/string.lsp b/ansi-tests/string.lsp index 6752ddbd4162486b7c26cb7f996550eede43fc8e..b2039cadf13ad00f2b5cce054319430687ba7978 100644 --- a/ansi-tests/string.lsp +++ b/ansi-tests/string.lsp @@ -38,6 +38,30 @@ (type-error () :caught))) t) +(deftest string.8 + (subtypep* '(array nil (*)) 'string) + t t) + +(deftest string.9 + (subtypep* '(array nil 1) 'string) + t t) + +(deftest string.10 + (string (make-array '(0) :element-type nil)) + "") + +(deftest string.11 + (typep* "abcd" 'string) + t) + +(deftest string.12 + (typep* (make-array '(17) :element-type nil) 'string) + t) + +(deftest string.13 + (typep* (make-array '(0) :element-type nil) 'string) + t) + ;;; Tests of base-string (deftest base-string.1 @@ -56,6 +80,14 @@ (subtypep* 'base-string 'sequence) t t) +(deftest base-string.5 + (subtypep* '(array nil (*)) 'base-string) + nil t) + +(deftest base-string.6 + (subtypep* 'string 'base-string) + nil t) + ;;; Tests of simple-string (deftest simple-string.1 @@ -78,6 +110,38 @@ (subtypep* 'simple-string 'sequence) t t) +(deftest simple-string.6 + (subtypep* 'simple-string '(simple-array * (*))) + t t) + +(deftest simple-string.7 + (subtypep* 'simple-string '(simple-array * 1)) + t t) + +(deftest simple-string.8 + (subtypep* 'simple-string '(simple-array character (*))) + nil t) + +(deftest simple-string.9 + (subtypep* 'simple-string '(simple-array base-char (*))) + nil t) + +(deftest simple-string.10 + (subtypep* 'simple-string 'simple-base-string) + nil t) + +(deftest simple-string.11 + (subtypep* '(simple-array nil (*)) 'simple-string) + t t) + +(deftest simple-string.12 + (typep* (make-array '(0) :element-type nil) 'simple-string) + t) + +(deftest simple-string.13 + (typep* (make-array '(12) :element-type nil) 'simple-string) + t) + ;;; Tests for simple-base-string (deftest simple-base-string.1 @@ -112,6 +176,18 @@ (subtypep* 'simple-base-string 'simple-vector) nil t) +(deftest simple-base-string.9 + (subtypep* '(simple-array nil (*)) 'simple-base-string) + nil t) + +(deftest simple-base-string.10 + (typep* (make-array '(0) :element-type nil) 'simple-base-string) + nil) + +(deftest simple-base-string.11 + (typep* (make-array '(12) :element-type nil) 'simple-base-string) + nil) + ;;; Tests for simple-string-p (deftest simple-string-p.1 @@ -122,7 +198,7 @@ t) (deftest simple-string-p.2 - (notnot (simple-string-p "ancd")) + (notnot-mv (simple-string-p "ancd")) t) (deftest simple-string-p.3 @@ -136,15 +212,17 @@ nil) (deftest simple-string-p.5 - (notnot (simple-string-p (make-array - 4 :element-type 'base-char - :initial-contents '(#\a #\a #\a #\b)))) + (notnot-mv + (simple-string-p (make-array + 4 :element-type 'base-char + :initial-contents '(#\a #\a #\a #\b)))) t) (deftest simple-string-p.6 - (notnot (simple-string-p (make-array - 4 :element-type 'standard-char - :initial-contents '(#\a #\a #\a #\b)))) + (notnot-mv + (simple-string-p (make-array + 4 :element-type 'standard-char + :initial-contents '(#\a #\a #\a #\b)))) t) (deftest simple-string-p.7 @@ -156,6 +234,14 @@ (simple-string-p s2)) nil) +(deftest simple-string-p.8 + (notnot-mv (simple-string-p (make-array '(0) :element-type nil))) + t) + +(deftest simple-string-p.9 + (notnot-mv (simple-string-p (make-array '(37) :element-type nil))) + t) + ;;; Tests of stringp (deftest stringp.1 @@ -200,3 +286,11 @@ :displaced-index-offset 2))) (notnot (stringp s2))) t) + +(deftest stringp.9 + (notnot-mv (stringp (make-array '(0) :element-type nil))) + t) + +(deftest stringp.10 + (notnot-mv (stringp (make-array '(37) :element-type nil))) + t)