Skip to content
Snippets Groups Projects
Commit 687686fd authored by pfdietz's avatar pfdietz
Browse files

More make-array tests (displaced arrays, fill pointers, keyword and error...

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.
parent d6b8e7bd
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
......@@ -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"
......
......@@ -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)
......@@ -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
......
......@@ -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"
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment