Skip to content
Snippets Groups Projects
Commit 549208d5 authored by pfdietz's avatar pfdietz
Browse files

Added yet more array tests.

parent b147b330
No related branches found
No related tags found
No related merge requests found
......@@ -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
......
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