From 58458ec7ff2bf2d6679bfa1a5b682c99e1d45db6 Mon Sep 17 00:00:00 2001 From: pfdietz Date: Wed, 18 Jun 2003 11:55:24 +0000 Subject: [PATCH] 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. --- ansi-tests/ansi-aux.lsp | 10 +- ansi-tests/compile-and-load.lsp | 2 +- ansi-tests/concatenate.lsp | 8 ++ ansi-tests/copy-seq.lsp | 4 + ansi-tests/equal.lsp | 12 +++ ansi-tests/equalp.lsp | 8 ++ ansi-tests/make-symbol.lsp | 4 + ansi-tests/nstring-capitalize.lsp | 8 ++ ansi-tests/nstring-downcase.lsp | 4 + ansi-tests/nstring-upcase.lsp | 4 + ansi-tests/string-capitalize.lsp | 4 + ansi-tests/string-comparisons.lsp | 148 ++++++++++++++++++++++++++++++ ansi-tests/string-downcase.lsp | 5 + ansi-tests/string-left-trim.lsp | 8 ++ ansi-tests/string-right-trim.lsp | 8 ++ ansi-tests/string-trim.lsp | 8 ++ ansi-tests/string-upcase.lsp | 4 + ansi-tests/string.lsp | 108 ++++++++++++++++++++-- 18 files changed, 347 insertions(+), 10 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index ba80893..2479b7e 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 435f2f6..a1a3e50 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 6fdb214..fd40f3a 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 bb2cd1e..4cba413 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 a2a5244..e2ab6d7 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 5248fc7..81468ca 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 f2aa193..522e198 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 9c9eb17..98a454b 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 409bc3c..e3b7ef2 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 5f6baf1..e9c80f4 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 82be8ce..6c8509e 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 617390e..66c5e90 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 a1c4dd2..7377c71 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 c620670..19fb44e 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 883348e..33b562d 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 a722268..ec432f5 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 4999f5c..8777bee 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 6752ddb..b2039ca 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) -- GitLab