Commit 58458ec7 authored by pfdietz's avatar pfdietz

I just realized that (array nil (*)) vectors are strings (since nil is a...

I just realized that (array nil (*)) vectors are strings (since nil is a subtype of character).  These new tests are for these strings and for the implications on subtypep.
parent 4f176076
...@@ -420,14 +420,15 @@ the condition to go uncaught if it cannot be classified." ...@@ -420,14 +420,15 @@ the condition to go uncaught if it cannot be classified."
") ")
(defparameter (defparameter
+base-chars+ #.(concatenate 'string +base-chars+ #.(concatenate 'simple-base-string
"abcdefghijklmnopqrstuvwxyz" "abcdefghijklmnopqrstuvwxyz"
"ABCDEFGHIJKLMNOPQRSTUVWXYZ" "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"0123456789" "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 +alpha-chars+ (subseq +standard-chars+ 0 52))
(defparameter +lower-case-chars+ (subseq +alpha-chars+ 0 26)) (defparameter +lower-case-chars+ (subseq +alpha-chars+ 0 26))
...@@ -435,11 +436,16 @@ the condition to go uncaught if it cannot be classified." ...@@ -435,11 +436,16 @@ the condition to go uncaught if it cannot be classified."
(defparameter +alphanumeric-chars+ (subseq +standard-chars+ 0 62)) (defparameter +alphanumeric-chars+ (subseq +standard-chars+ 0 62))
(defparameter +digit-chars+ "0123456789") (defparameter +digit-chars+ "0123456789")
(defparameter +extended-digit-chars+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ") (defparameter +extended-digit-chars+ "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")
(declaim (type simple-base-string +alpha-chars+ +lower-case-chars+
+upper-case-chars+ +alphanumeric-chars+))
(defparameter +code-chars+ (defparameter +code-chars+
(coerce (loop for i from 0 below 256 (coerce (loop for i from 0 below 256
for c = (code-char i) for c = (code-char i)
when c collect c) when c collect c)
'string)) 'string))
(defparameter +rev-code-chars+ (reverse +code-chars+)) (defparameter +rev-code-chars+ (reverse +code-chars+))
;;; Used in checking for continuable errors ;;; Used in checking for continuable errors
......
...@@ -30,7 +30,7 @@ ...@@ -30,7 +30,7 @@
(file-write-date compile-pathname)))) (file-write-date compile-pathname))))
(unless (and (not force) (unless (and (not force)
former-data former-data
(<= (cadr former-data) source-write-time)) (>= (cadr former-data) source-write-time))
(when (or (not target-write-time) (when (or (not target-write-time)
(<= target-write-time source-write-time)) (<= target-write-time source-write-time))
(compile-file pathname)) (compile-file pathname))
......
...@@ -184,6 +184,14 @@ ...@@ -184,6 +184,14 @@
#*01100 #*01100
nil) 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 (deftest concatenate.order.1
(let ((i 0) w x y z) (let ((i 0) w x y z)
(values (values
......
...@@ -154,6 +154,10 @@ ...@@ -154,6 +154,10 @@
(equal-array x y)) (equal-array x y))
t) t)
(deftest copy-seq.19
(copy-seq (make-array '(0) :element-type nil))
"")
(deftest copy-seq.order.1 (deftest copy-seq.order.1
(let ((i 0)) (let ((i 0))
(values (copy-seq (progn (incf i) "abc")) i)) (values (copy-seq (progn (incf i) "abc")) i))
......
...@@ -61,6 +61,18 @@ ...@@ -61,6 +61,18 @@
(equalt (copy-seq #*000110) (copy-seq #*000111)) (equalt (copy-seq #*000110) (copy-seq #*000111))
nil) 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 (deftest equal.order.1
(let ((i 0) x y) (let ((i 0) x y)
(values (values
......
...@@ -27,6 +27,14 @@ ...@@ -27,6 +27,14 @@
(equalpt "abc" "abd") (equalpt "abc" "abd")
nil) 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 (deftest equalp.order.1
(let ((i 0) x y) (let ((i 0) x y)
(values (values
......
...@@ -46,6 +46,10 @@ ...@@ -46,6 +46,10 @@
(symbol-name (make-symbol "")) (symbol-name (make-symbol ""))
"") "")
(deftest make-symbol.11
(symbol-name (make-symbol (make-array '(0) :element-type nil)))
"")
(deftest make-symbol.order.1 (deftest make-symbol.order.1
(let ((i 0)) (let ((i 0))
(values (values
......
...@@ -60,6 +60,14 @@ ...@@ -60,6 +60,14 @@
("ABCDEF" "ABCDEF" "ABCDEf") ("ABCDEF" "ABCDEF" "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 (deftest nstring-capitalize.order.1
(let ((i 0) a b c (s (copy-seq "abcdef"))) (let ((i 0) a b c (s (copy-seq "abcdef")))
(values (values
......
...@@ -67,6 +67,10 @@ ...@@ -67,6 +67,10 @@
("abcde" "abcDe" "abcDE") ("abcde" "abcDe" "abcDE")
("abcde" "abcdE"))) ("abcde" "abcdE")))
(deftest nstring-downcase.11
(nstring-downcase (make-array '(0) :element-type nil))
"")
(deftest nstring-downcase.order.1 (deftest nstring-downcase.order.1
(let ((i 0) a b c (s (copy-seq "ABCDEF"))) (let ((i 0) a b c (s (copy-seq "ABCDEF")))
(values (values
......
...@@ -66,6 +66,10 @@ ...@@ -66,6 +66,10 @@
("abcde" "abcDe" "abcDE") ("abcde" "abcDe" "abcDE")
("abcde" "abcdE"))) ("abcde" "abcdE")))
(deftest nstring-upcase.11
(nstring-upcase (make-array '(0) :element-type nil))
"")
(deftest nstring-upcase.order.1 (deftest nstring-upcase.order.1
(let ((i 0) a b c (s (copy-seq "abcdef"))) (let ((i 0) a b c (s (copy-seq "abcdef")))
(values (values
......
...@@ -84,6 +84,10 @@ ...@@ -84,6 +84,10 @@
("ABCDEF" "ABCDEF")) ("ABCDEF" "ABCDEF"))
"ABCDEF") "ABCDEF")
(deftest string-capitalize.11
(string-capitalize (make-array '(0) :element-type nil))
"")
(deftest string-capitalize.order.1 (deftest string-capitalize.order.1
(let ((i 0) a b c (s (copy-seq "abcdef"))) (let ((i 0) a b c (s (copy-seq "abcdef")))
(values (values
......
...@@ -5,6 +5,8 @@ ...@@ -5,6 +5,8 @@
(in-package :cl-test) (in-package :cl-test)
(compile-and-load "string-aux.lsp")
(deftest string=.1 (deftest string=.1
(not (string= "abc" (copy-seq "abc"))) (not (string= "abc" (copy-seq "abc")))
nil) nil)
...@@ -501,6 +503,152 @@ ...@@ -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)
(> 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)
......
...@@ -80,6 +80,11 @@ ...@@ -80,6 +80,11 @@
("abcde" "abcdE")) ("abcde" "abcdE"))
"ABCDE") "ABCDE")
(deftest string-downcase.11
(string-downcase (make-array '(0) :element-type nil))
"")
(deftest string-downcase.order.1 (deftest string-downcase.order.1
(let ((i 0) a b c (s (copy-seq "ABCDEF"))) (let ((i 0) a b c (s (copy-seq "ABCDEF")))
(values (values
......
...@@ -141,6 +141,14 @@ ...@@ -141,6 +141,14 @@
(string-left-trim "abc" (copy-seq "abcabcabc")) (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 (deftest string-left-trim.order.1
(let ((i 0) x y) (let ((i 0) x y)
(values (values
......
...@@ -141,6 +141,14 @@ ...@@ -141,6 +141,14 @@
(string-right-trim "abc" (copy-seq "abcabcabc")) (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 (deftest string-right-trim.order.1
(let ((i 0) x y) (let ((i 0) x y)
(values (values
......
...@@ -141,6 +141,14 @@ ...@@ -141,6 +141,14 @@
(string-trim "abc" (copy-seq "abcabcabc")) (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 (deftest string-trim.order.1
(let ((i 0) x y) (let ((i 0) x y)
(values (values
......
...@@ -80,6 +80,10 @@ ...@@ -80,6 +80,10 @@
("abcde" "abcdE")) ("abcde" "abcdE"))
"abcde") "abcde")
(deftest string-upcase.11
(string-upcase (make-array '(0) :element-type nil))
"")
(deftest string-upcase.order.1 (deftest string-upcase.order.1
(let ((i 0) a b c (s (copy-seq "abcdef"))) (let ((i 0) a b c (s (copy-seq "abcdef")))
(values (values
......
...@@ -38,6 +38,30 @@ ...@@ -38,6 +38,30 @@
(type-error () :caught))) (type-error () :caught)))
t) 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 ;;; Tests of base-string
(deftest base-string.1 (deftest base-string.1
...@@ -56,6 +80,14 @@ ...@@ -56,6 +80,14 @@
(subtypep* 'base-string 'sequence) (subtypep* 'base-string 'sequence)
t t) 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 ;;; Tests of simple-string
(deftest simple-string.1 (deftest simple-string.1
...@@ -78,6 +110,38 @@ ...@@ -78,6 +110,38 @@
(subtypep* 'simple-string 'sequence) (subtypep* 'simple-string 'sequence)
t t) 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 ;;; Tests for simple-base-string
(deftest simple-base-string.1 (deftest simple-base-string.1
...@@ -112,6 +176,18 @@ ...@@ -112,6 +176,18 @@
(subtypep* 'simple-base-string 'simple-vector) (subtypep* 'simple-base-string 'simple-vector)
nil t) 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 ;;; Tests for simple-string-p
(deftest simple-string-p.1 (deftest simple-string-p.1
...@@ -122,7 +198,7 @@ ...@@ -122,7 +198,7 @@
t) t)
(deftest simple-string-p.2 (deftest simple-string-p.2
(notnot (simple-string-p "ancd")) (notnot-mv (simple-string-p "ancd"))
t) t)
(deftest simple-string-p.3 (deftest simple-string-p.3
...@@ -136,15 +212,17 @@ ...@@ -136,15 +212,17 @@
nil) nil)
(deftest simple-string-p.5 (deftest simple-string-p.5
(notnot (simple-string-p (make-array (notnot-mv
4 :element-type 'base-char (simple-string-p (make-array
:initial-contents '(#\a #\a #\a #\b)))) 4 :element-type 'base-char
:initial-contents '(#\a #\a #\a #\b))))
t) t)
(deftest simple-string-p.6 (deftest simple-string-p.6
(notnot (simple-string-p (make-array (notnot-mv
4 :element-type 'standard-char (simple-string-p (make-array
:initial-contents '(#\a #\a #\a #\b)))) 4 :element-type 'standard-char
:initial-contents '(#\a #\a #\a #\b))))
t) t)
(deftest simple-string-p.7 (deftest simple-string-p.7
...@@ -156,6 +234,14 @@ ...@@ -156,6 +234,14 @@
(simple-string-p s2)) (simple-string-p s2))
nil) nil)
(deftest simple-string-p.8