diff --git a/ansi-tests/assoc-if-not.lsp b/ansi-tests/assoc-if-not.lsp index abc545fdc20e5ce3c0d85fff776a5fbb4efcd7fc..e2b70e7730d142ea591ceb611dc08944daf64fbb 100644 --- a/ansi-tests/assoc-if-not.lsp +++ b/ansi-tests/assoc-if-not.lsp @@ -140,3 +140,10 @@ (classify-error (assoc-if-not #'identity '((a . b) . c))) type-error) +(deftest assoc-if-not.error.12 + (classify-error (assoc-if-not #'identity ((a . b) :bad (c . d)))) + type-error) + +(deftest assoc-if-not.error.13 + (classify-error (assoc-if-not #'identity 'y)) + type-error) diff --git a/ansi-tests/assoc-if.lsp b/ansi-tests/assoc-if.lsp index c148283b66afd58baa98b02758a360137beafc9c..be40c679e94e755b9dfbb49bf241e38e58a5b927 100644 --- a/ansi-tests/assoc-if.lsp +++ b/ansi-tests/assoc-if.lsp @@ -138,3 +138,11 @@ (deftest assoc-if.error.11 (classify-error (assoc-if #'null '((a . b) . c))) type-error) + +(deftest assoc-if.error.12 + (classify-error (assoc-if #'null ((a . b) :bad (c . d)))) + type-error) + +(deftest assoc-if.error.13 + (classify-error (assoc-if #'null 'y)) + type-error) diff --git a/ansi-tests/assoc.lsp b/ansi-tests/assoc.lsp index 8d87b7b7fb9238791de08bd78441124de7b68e2b..9c28003a516974fe96d926495bb32816055c6a05 100644 --- a/ansi-tests/assoc.lsp +++ b/ansi-tests/assoc.lsp @@ -268,3 +268,10 @@ (classify-error (assoc 'z '((a . b) . c))) type-error) +(deftest assoc.error.11 + (classify-error (assoc 'z '((a . b) :bad (c . d)))) + type-error) + +(deftest assoc.error.12 + (classify-error (assoc 'x 'y)) + type-error) diff --git a/ansi-tests/cl-symbol-names.lsp b/ansi-tests/cl-symbol-names.lsp index 1bfa0d64966b67b4f9241480587d4ff83b6a9917..9d7c06df0b1ce9674094ba7c9382bc53a096c6f8 100644 --- a/ansi-tests/cl-symbol-names.lsp +++ b/ansi-tests/cl-symbol-names.lsp @@ -1174,7 +1174,9 @@ file-length file-namestring file-position + file-string-length file-write-date + fill find find-all-symbols find-if @@ -1387,6 +1389,7 @@ probe-file proclaim provide + random random-state-p rassoc rassoc-if diff --git a/ansi-tests/cl-symbols.lsp b/ansi-tests/cl-symbols.lsp index a60cba8fdfddecde2ad1e33fe7d4cd7a120e0fa8..dacc5e0045ac2c7caca8fea6300c476e93c91998 100644 --- a/ansi-tests/cl-symbols.lsp +++ b/ansi-tests/cl-symbols.lsp @@ -994,14 +994,17 @@ ;;; Standardized packages have the right names, nicknames (deftest keyword-package-nicknames + :notes :standardized-package-nicknames (package-nicknames (find-package "KEYWORD")) nil) (deftest common-lisp-package-nicknames + :notes :standardized-package-nicknames (package-nicknames (find-package "COMMON-LISP")) ("CL")) (deftest common-lisp-user-package-nicknames + :notes :standardized-package-nicknames (package-nicknames (find-package "COMMON-LISP-USER")) ("CL-USER")) diff --git a/ansi-tests/defgeneric.lsp b/ansi-tests/defgeneric.lsp index 3e5bf42147403e5cb1338c96bbc7bad1509ca019..5d03fb3f16c1c910eab6ba103cdcf74e57580827 100644 --- a/ansi-tests/defgeneric.lsp +++ b/ansi-tests/defgeneric.lsp @@ -763,9 +763,12 @@ nil a nil a a) ;;; I'm not sure this one is proper +;;; Added :metaclass at prompting of Martin Simmons (when (subtypep (class-of (find-class 'standard-generic-function)) 'standard-class) - (defclass substandard-generic-function (standard-generic-function) ()) + (defclass substandard-generic-function (standard-generic-function) () + (:metaclass #.(class-name (class-of + (find-class 'standard-generic-function))))) (deftest defgeneric.30 (let ((fn (eval '(defgeneric defgeneric.fun.29 (x) diff --git a/ansi-tests/loop10.lsp b/ansi-tests/loop10.lsp index c34ea3006c2510c4f785a2669bdac49c6fcd699a..3198e8586dc9818c2f586c84b1ff0d157a3d3352 100644 --- a/ansi-tests/loop10.lsp +++ b/ansi-tests/loop10.lsp @@ -448,3 +448,47 @@ (deftest loop.10.93 (loop for i from 1 to 4 summing (return 100)) 100) + +(deftest loop.10.94 + (loop for i in nil sum i of-type integer) + 0) + +(deftest loop.10.95 + (loop for i in nil sum i of-type fixnum) + 0) + +(deftest loop.10.96 + (loop for i in nil sum i of-type bit) + 0) + +(deftest loop.10.97 + (loop for i in nil sum i of-type (integer 0 100)) + 0) + +(deftest loop.10.98 + (loop for i in nil sum i of-type (integer -100 0)) + 0) + +(deftest loop.10.99 + (loop for i in nil sum i of-type (integer -100 100)) + 0) + +(deftest loop.10.100 + (loop for i in nil sum i of-type (and integer (real -100.0 100.0))) + 0) + +(deftest loop.10.101 + (loop for i in nil sum i of-type short-float) + 0.0s0) + +(deftest loop.10.102 + (loop for i in nil sum i of-type single-float) + 0.0f0) + +(deftest loop.10.103 + (loop for i in nil sum i of-type double-float) + 0.0d0) + +(deftest loop.10.104 + (loop for i in nil sum i of-type long-float) + 0.0l0) diff --git a/ansi-tests/loop11.lsp b/ansi-tests/loop11.lsp index 3ff8f312859924d48c7bba20da77f6f1fc9ec561..4f614fd2b0e72f45d34a25aaf1ee9dfd9677f5ac 100644 --- a/ansi-tests/loop11.lsp +++ b/ansi-tests/loop11.lsp @@ -53,9 +53,13 @@ (loop repeat 3 for i in '(a b c d e) collect i) (a b c)) -(deftest loop.11.9 - (loop for i in '(a b c d e) collect i repeat 3) - (a b c)) +;;; Enough implementors have complained about this test that +;;; I'm removing it. The standard is self-contradictory +;;; on whether REPEAT can occur later in a LOOP form. + +;;; (deftest loop.11.9 +;;; (loop for i in '(a b c d e) collect i repeat 3) +;;; (a b c)) ;;; Tests of WHILE diff --git a/ansi-tests/notes.lsp b/ansi-tests/notes.lsp index f366343af5648356f76c1624d7dbd52c9fcf148e..08abd3e6f467b3936ccf1291edcaab547de0c61f 100644 --- a/ansi-tests/notes.lsp +++ b/ansi-tests/notes.lsp @@ -14,4 +14,5 @@ (defnote :nil-vectors-are-strings "Assume that (VECTOR NIL) objects are strings.") - +(defnote :standardized-package-nicknames + "The standardized package nicknames specified in section 11 of ANSI CL are exclusive (disputed).") diff --git a/ansi-tests/packages-03.lsp b/ansi-tests/packages-03.lsp index 79488a5c87e2ee2e0f17c1bab82ec51622ed4b25..86d3972b3d28a9a13a18b1f0ca7efbac3ee670b1 100644 --- a/ansi-tests/packages-03.lsp +++ b/ansi-tests/packages-03.lsp @@ -21,7 +21,7 @@ (find-package "CL-USER") (find-package "KEYWORD") (find-package "A") - (find-package "RT") + (find-package "REGRESSION-TEST") (find-package "CL-TEST") (find-package "B")) (list-all-packages)) diff --git a/ansi-tests/remove-aux.lsp b/ansi-tests/remove-aux.lsp index 634e776969c702776c6165f03470277b35e84ec3..a3c5e38fd5a4026cb945a7563f564f7525381705 100644 --- a/ansi-tests/remove-aux.lsp +++ b/ansi-tests/remove-aux.lsp @@ -216,7 +216,7 @@ (seq2 (copy-seq seq)) (seq1r (apply (the function tested-fn) element seq1 arg-list)) (seq2r (apply (the function check-fn) element seq2 arg-list))) - (setq *remove-fail-args* (list* element seq1 arg-list)) + (setq *remove-fail-args* (list* element seq arg-list)) (cond ((and pure (not (equalp seq seq1))) :fail1) ((and pure (not (equalp seq seq2))) :fail2)