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."
")
(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
......
......@@ -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))
......
......@@ -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
......
......@@ -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))
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment