From 687686fd693b444c0db76518916befceb3b453aa Mon Sep 17 00:00:00 2001 From: pfdietz <pfdietz@localhost> Date: Sun, 19 Jan 2003 15:23:19 +0000 Subject: [PATCH] More make-array tests (displaced arrays, fill pointers, keyword and error tests.) Changes to .system and .cvsignore files suggested by Sam Steingold. Added warning comment to cltest.system. Made deftest work with multidimensional arrays now that ROW-MAJOR-AREF is working in gcl. --- ansi-tests/ansi-aux.lsp | 2 +- ansi-tests/cltest.system | 8 ++- ansi-tests/make-array.lsp | 125 ++++++++++++++++++++++++++++++++++++++ ansi-tests/rt/rt.lsp | 11 +++- ansi-tests/rt/rt.system | 3 + 5 files changed, 145 insertions(+), 4 deletions(-) diff --git a/ansi-tests/ansi-aux.lsp b/ansi-tests/ansi-aux.lsp index bbc8a772..f3df359b 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 1a193751..f62d5dfc 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 c7225978..ef130bc1 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 195c0b9c..64ed0bd8 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 6d290e26..e0cce972 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" -- GitLab