diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index bbc8a772335cec6cc332b5eb7013836799a6d17e..f3df359b488406b2d8f7ef12b1ad54c797492a51 100644 --- a/ansi-tests/ansi-aux.lsp +++ b/ansi-tests/ansi-aux.lsp @@ -150,7 +150,7 @@ the condition to go uncaught if it cannot be classified." (classify-error* (eval form))) (defmacro classify-error (form) - `(classify-error** ',form))) + `(classify-error** ',form)) ;;; ;;; A scaffold is a structure that is used to remember the object diff --git a/ansi-tests/cltest.system b/ansi-tests/cltest.system index 1a1937517218d868d1b76b39eb47c29c4ec6639d..f62d5dfc426511a87f46ea5e2b53e9cd09e0a07d 100644 --- a/ansi-tests/cltest.system +++ b/ansi-tests/cltest.system @@ -3,6 +3,9 @@ ;;;; Created: Fri Mar 27 09:57:28 1998 ;;;; Contains: MK portable system file for CL test suite +;;; NOTE!! This file is not being maintained right now. +;;; To run the test suite, load "gclload.lsp" + (mk::defsystem "cltest" :source-pathname #.(directory-namestring *LOAD-TRUENAME*) :source-extension "lsp" @@ -13,6 +16,9 @@ #+CMU #.(C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) #+ALLEGRO "fasl" #+(OR AKCL GCL) "o" + #+CLISP "fas" + #-(OR CMU ALLEGRO AKCL GCL CLISP) + #.(pathname-type (compile-file-pathname "foo.lisp")) :initially-do (progn (load "rt/rt.system") (mk::compile-system "rt")) :components @@ -23,7 +29,7 @@ :depends-on ("cl-test-package") :components ( - "aux" + "ansi-aux" "universe" "cons-test-01" "cons-test-02" diff --git a/ansi-tests/make-array.lsp b/ansi-tests/make-array.lsp index c7225978a95008536b4c0027c4aac2d580310e01..ef130bc1eddfcaa119eeb2aefe103d77b0aa0633 100644 --- a/ansi-tests/make-array.lsp +++ b/ansi-tests/make-array.lsp @@ -276,6 +276,12 @@ :allow-other-keys nil) #(x x x x)) +(deftest make-array.27 + (make-array '(4) :initial-element 'x + :allow-other-keys t + :allow-other-keys nil + :nonsense-argument t) + #(x x x x)) ;;; Adjustable arrays @@ -496,4 +502,123 @@ :displaced-index-offset 4)) #2a((5 6 7 8) (9 10 11 12))) +(deftest make-array.displaced.20 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(24) :displaced-to a)) + #(a b c d e f g h i j k l m n o p q r s t u v w x)) + +(deftest make-array.displaced.21 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(3 8) :displaced-to a)) + #2a((a b c d e f g h) (i j k l m n o p) (q r s t u v w x))) + +(deftest make-array.displaced.22 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5)) + #(f g h i j k l m n o)) + +(deftest make-array.displaced.23 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :fill-pointer t)) + #(f g h i j k l m n o)) + +(deftest make-array.displaced.24 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :fill-pointer 5)) + #(f g h i j)) + +(deftest make-array.displaced.25 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :adjustable t)) + #(f g h i j k l m n o)) + +(deftest make-array.displaced.26 + (let ((a (make-array '(2 3 4) + :initial-contents '(((a b c d) (e f g h) (i j k l)) + ((m n o p) (q r s t) (u v w x)))))) + (make-array-with-checks '(10) :displaced-to a + :displaced-index-offset 5 + :fill-pointer 8 + :adjustable t)) + #(f g h i j k l m)) + +;;; Keywords tests + +(deftest make-array.allow-other-keys.1 + (make-array '(5) :initial-element 'a :allow-other-keys t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.2 + (make-array '(5) :initial-element 'a :allow-other-keys nil) + #(a a a a a)) + +(deftest make-array.allow-other-keys.3 + (make-array '(5) :initial-element 'a :allow-other-keys t '#:bad t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.4 + (make-array '(5) :initial-element 'a :bad t :allow-other-keys t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.5 + (make-array '(5) :bad t :initial-element 'a :allow-other-keys t) + #(a a a a a)) + +(deftest make-array.allow-other-keys.6 + (make-array '(5) :bad t :initial-element 'a :allow-other-keys t + :allow-other-keys nil :also-bad nil) + #(a a a a a)) + +(deftest make-array.allow-other-keys.7 + (make-array '(5) :allow-other-keys t :initial-element 'a) + #(a a a a a)) + +(deftest make-array.keywords.8. + (make-array '(5) :initial-element 'x :initial-element 'a) + #(x x x x x)) + +;;; Error tests + +(deftest make-array.error.1 + (classify-error (make-array)) + program-error) + +(deftest make-array.error.2 + (classify-error (make-array '(10) :bad t)) + program-error) + +(deftest make-array.error.3 + (classify-error (make-array '(10) :allow-other-keys nil :bad t)) + program-error) + +(deftest make-array.error.4 + (classify-error (make-array '(10) :allow-other-keys nil + :allow-other-keys t :bad t)) + program-error) + +(deftest make-array.error.5 + (classify-error (make-array '(10) :bad)) + program-error) +(deftest make-array.error.6 + (classify-error (make-array '(10) 1 2)) + program-error) diff --git a/ansi-tests/rt/rt.lsp b/ansi-tests/rt/rt.lsp index 195c0b9cf4a7c9244724771c278ac7adafe1261c..64ed0bd8582b0b067c567f9c251a71b7c991adc6 100644 --- a/ansi-tests/rt/rt.lsp +++ b/ansi-tests/rt/rt.lsp @@ -128,8 +128,7 @@ (not (equal (array-dimensions x) (array-dimensions y)))) nil) - ;; I should use ROW-MAJOR-AREF to do this, but that's broken - ;; in GCL right now. + #| ((and (typep x 'array) (= (array-rank x) 2)) (let ((dim (array-dimensions x))) @@ -137,6 +136,14 @@ always (loop for j from 0 below (second dim) always (equalp-with-case (aref x i j) (aref y i j)))))) + |# + + ((typep x 'array) + (let ((size (array-total-size x))) + (loop for i from 0 below size + always (equalp-with-case (row-major-aref x i) + (row-major-aref y i))))) + (t (eql x y)))) (defun do-entry (entry &optional diff --git a/ansi-tests/rt/rt.system b/ansi-tests/rt/rt.system index 6d290e269cdc44e3e2deb0eff24d60460fe6e7a9..e0cce9729656be181efcc60e7672aae07d5cf2db 100644 --- a/ansi-tests/rt/rt.system +++ b/ansi-tests/rt/rt.system @@ -13,6 +13,9 @@ #+CMU #.(C::BACKEND-FASL-FILE-TYPE C::*TARGET-BACKEND*) #+ALLEGRO "fasl" #+(OR AKCL GCL) "o" + #+CLISP "fas" + #-(OR CMU ALLEGRO AKCL GCL CLISP) + #.(pathname-type (compile-file-pathname "foo.lisp")) :components ( "rt-package"