Commit 549208d5 authored by pfdietz's avatar pfdietz

Added yet more array tests.

parent b147b330
......@@ -29,10 +29,11 @@
(list dimensions))))
"Call MAKE-ARRAY and do sanity tests on the output."
(declare (ignore element-type-p initial-contents initial-contents-p
initial-element initial-element-p))
initial-element initial-element-p dio-p))
(let ((a (apply #'make-array dimensions options)))
(cond
((not (typep a 'array)) :fail-not-array)
((not (arrayp a)) :fail-not-arrayp)
((and (eq t element-type)
(not adjustable)
......@@ -122,5 +123,24 @@
((not (eql actual-dio displaced-index-offset))
:fail-displaced-index-offset)))))
;; Test of array-total-size
((not (eql (array-total-size a)
(reduce #'* dimensions-list :initial-value 1)))
:fail-array-total-size)
;; Test array-row-major-index on all zeros
((and (> (array-total-size a) 0)
(not (eql (apply #'array-row-major-index
a (make-list (array-rank a) :initial-element 0))
0)))
:fail-array-row-major-index-0)
;; For the last entry
((and (> (array-total-size a) 0)
(not (eql (apply #'array-row-major-index
a (mapcar #'1- dimensions-list))
(1- (reduce #'* dimensions-list :initial-value 1)))))
:fail-array-row-major-index-last)
;; No problems -- return the array
(t a))))
\ No newline at end of file
(t a))))
......@@ -49,7 +49,7 @@
(classify-error (array-dimensions #(a b c) nil))
program-error)
(deftest array-dimension.error.3
(deftest array-dimensions.error.3
(loop for e in *mini-universe*
unless (or (typep e 'array)
(eq 'type-error
......
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Jan 21 21:37:03 2003
;;;; Contains: Tests of ARRAY-ROW-MAJOR-INDEX
(in-package :cl-test)
;;; More array-row-major-index tests are in make-array.lsp
(deftest array-row-major-index.1
(array-row-major-index #0aNIL)
0)
(deftest array-row-major-index.2
(loop for i from 0 to 4
collect (array-row-major-index #(a b c d e) i))
(0 1 2 3 4))
(deftest array-row-major-index.3
(let ((a (make-array '(5) :fill-pointer 1)))
(loop for i from 0 to 4
collect (array-row-major-index a i)))
(0 1 2 3 4))
;;; Error tests
(deftest array-row-major-index.error.1
(classify-error (array-row-major-index))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Jan 21 22:01:09 2003
;;;; Contains: Tests of ARRAY-TOTAL-SIZE
(in-package :cl-test)
;;; More tests of ARRAY-TOTAL-SIZE are in make-array.lsp
(deftest array-total-size.1
(array-total-size #0aNIL)
1)
(deftest array-total-size.2
(array-total-size "abcdef")
6)
(deftest array-total-size.3
(array-total-size #(a b c))
3)
(deftest array-total-size.4
(array-total-size #*0011010)
7)
(deftest array-total-size.5
(array-total-size #2a((1 2 3)(4 5 6)(7 8 9)(a b c)))
12)
;;; Error tests
(deftest array-total-size.error.1
(classify-error (array-total-size))
program-error)
(deftest array-total-size.error.2
(classify-error (array-total-size #(a b c) nil))
program-error)
(deftest array-total-size.error.3
(loop for e in *mini-universe*
when (and (not (typep e 'array))
(not (eql (classify-error** `(array-total-size ',e))
'type-error)))
collect e)
nil)
(deftest array-total-size.error.4
(classify-error (array-total-size 0))
type-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Jan 21 22:08:21 2003
;;;; Contains: Tests of ARRAYP
(in-package :cl-test)
;;; Also tested by make-array.lsp
(deftest arrayp.1
(notnot (arrayp #(a b c)))
t)
(deftest arrayp.2
(notnot (arrayp "abcd"))
t)
(deftest arrayp.3
(notnot (arrayp #*001110101))
t)
(deftest arrayp.4
(notnot (arrayp #0aNIL))
t)
(deftest arrayp.5
(notnot (arrayp #2a((1 2 3)(4 5 6))))
t)
(deftest arrayp.6
(loop for e in *universe*
for a = (arrayp e)
for b = (typep e 'array)
when (or (and a (not b))
(and b (not a)))
collect e)
nil)
;;; Error tests
(deftest arrayp.error.1
(classify-error (arrayp))
program-error)
(deftest arrayp.error.2
(classify-error (arrayp #(a b c) nil))
program-error)
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Tue Jan 21 22:14:23 2003
;;;; Contains: Tests of FILL-POINTER
(in-package :cl-test)
;;; More tests are in make-array.lsp
(deftest fill-pointer.1
(fill-pointer (make-array '(10) :fill-pointer 5))
5)
(deftest fill-pointer.2
(fill-pointer (make-array '(10) :fill-pointer t))
10)
(deftest fill-pointer.3
(let ((a (make-array '(10) :fill-pointer 5
:initial-contents '(1 2 3 4 5 6 7 8 9 10))))
(values
(fill-pointer a)
(setf (fill-pointer a) 6)
a))
5 6 #(1 2 3 4 5 6))
......@@ -137,11 +137,14 @@
(load "make-array.lsp")
(load "adjustable-array-p.lsp")
(load "array-displacement.lsp")
(load "adjustable-array-p.lsp")
(load "array-dimension.lsp")
(load "array-dimensions.lsp")
(load "array-in-bounds-p.lsp")
(load "array-rank.lsp")
(load "array-row-major-index.lsp")
(load "array-total-size.lsp")
(load "arrayp.lsp")
(load "fill-pointer.lsp")
;;; Tests of packages
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment