array-in-bounds-p.lsp 4.43 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jan 21 19:57:29 2003
;;;; Contains: Tests for ARRAY-IN-BOUNDS-P

6

pfdietz's avatar
pfdietz committed
7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76

(deftest array-in-bounds-p.1
  (array-in-bounds-p #() 0)
  nil)

(deftest array-in-bounds-p.2
  (array-in-bounds-p #() -1)
  nil)

(deftest array-in-bounds-p.3
  (let ((a #(a b c d)))
    (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i))))
  (t t t t nil))

(deftest array-in-bounds-p.4
  (notnot (array-in-bounds-p #0aNIL))
  t)

(deftest array-in-bounds-p.5
  (array-in-bounds-p "" 0)
  nil)

(deftest array-in-bounds-p.6
  (array-in-bounds-p "" -1)
  nil)

(deftest array-in-bounds-p.7
  (let ((a "abcd"))
    (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i))))
  (t t t t nil))

(deftest array-in-bounds-p.8
  (array-in-bounds-p #* 0)
  nil)

(deftest array-in-bounds-p.9
  (array-in-bounds-p #* -1)
  nil)

(deftest array-in-bounds-p.10
  (let ((a #*0110))
    (loop for i from 0 to 4 collect (notnot (array-in-bounds-p a i))))
  (t t t t nil))

;; Fill pointer tests

(deftest array-in-bounds-p.11
  (let ((a (make-array '(10) :fill-pointer 5)))
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
  (nil t t t t t t t t t t nil))

(deftest array-in-bounds-p.12
  (let ((a (make-array '(10) :fill-pointer 5 :element-type 'bit :initial-element 0)))
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
  (nil t t t t t t t t t t nil))

(deftest array-in-bounds-p.13
  (let ((a (make-array '(10) :fill-pointer 5 :element-type 'base-char :initial-element #\x)))
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
  (nil t t t t t t t t t t nil))

(deftest array-in-bounds-p.14
  (let ((a (make-array '(10) :fill-pointer 5 :element-type 'character :initial-element #\x)))
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a i))))
  (nil t t t t t t t t t t nil))

;;; Displaced arrays

(deftest array-in-bounds-p.15
  (let* ((a1 (make-array '(20)))
sds's avatar
sds committed
77
         (a2 (make-array '(10) :displaced-to a1)))
pfdietz's avatar
pfdietz committed
78 79 80 81 82
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i))))
  (nil t t t t t t t t t t nil))

(deftest array-in-bounds-p.16
  (let* ((a1 (make-array '(20) :element-type 'bit :initial-element 0))
sds's avatar
sds committed
83
         (a2 (make-array '(10) :displaced-to a1 :element-type 'bit)))
pfdietz's avatar
pfdietz committed
84 85 86 87 88
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i))))
  (nil t t t t t t t t t t nil))

(deftest array-in-bounds-p.17
  (let* ((a1 (make-array '(20) :element-type 'character :initial-element #\x))
sds's avatar
sds committed
89
         (a2 (make-array '(10) :displaced-to a1 :element-type 'character)))
pfdietz's avatar
pfdietz committed
90 91 92 93 94 95 96 97
    (loop for i from -1 to 10 collect (notnot (array-in-bounds-p a2 i))))
  (nil t t t t t t t t t t nil))

;;; Multidimensional arrays

(deftest array-in-bounds-p.18
  (let ((a (make-array '(3 4))))
    (loop for i from -1 to 3 collect
sds's avatar
sds committed
98 99
          (loop for j from -1 to 4 collect
                (notnot (array-in-bounds-p a i j)))))
pfdietz's avatar
pfdietz committed
100 101 102 103 104 105 106 107 108
  ((nil nil nil nil nil nil)
   (nil t   t   t   t   nil)
   (nil t   t   t   t   nil)
   (nil t   t   t   t   nil)
   (nil nil nil nil nil nil)))

(deftest array-in-bounds-p.19
  (let ((a (make-array '(1 3 4) :adjustable t)))
    (loop for i from -1 to 3 collect
sds's avatar
sds committed
109 110
          (loop for j from -1 to 4 collect
                (notnot (array-in-bounds-p a 0 i j)))))
pfdietz's avatar
pfdietz committed
111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
  ((nil nil nil nil nil nil)
   (nil t   t   t   t   nil)
   (nil t   t   t   t   nil)
   (nil t   t   t   t   nil)
   (nil nil nil nil nil nil)))

;;; Very large indices

(deftest array-in-bounds-p.20
  (array-in-bounds-p #(a b c) (1+ most-positive-fixnum))
  nil)

(deftest array-in-bounds-p.21
  (array-in-bounds-p #(a b c) (1- most-negative-fixnum))
  nil)

(deftest array-in-bounds-p.22
  (array-in-bounds-p #(a b c) 1000000000000000000)
  nil)

(deftest array-in-bounds-p.23
  (array-in-bounds-p #(a b c) -1000000000000000000)
  nil)

135 136 137 138 139 140 141 142
;;; Macro expansion

(deftest array-in-bounds-p.24
  (macrolet ((%m (z) z)) (array-in-bounds-p (expand-in-current-env (%m #(a b))) 3))
  nil)

(deftest array-in-bounds-p.25
  (macrolet ((%m (z) z))
sds's avatar
sds committed
143
            (array-in-bounds-p #(a b) (expand-in-current-env (%m 2))))
144 145
  nil)

146 147
;;; Order of evaluation tests

148
(deftest array-in-bounds-p.order.1
149 150 151
  (let ((x 0) y z)
    (values
     (array-in-bounds-p (progn (setf y (incf x))
sds's avatar
sds committed
152 153 154
                               #())
                        (progn (setf z (incf x))
                               10))
155 156 157
     x y z))
  nil 2 1 2)

pfdietz's avatar
pfdietz committed
158 159 160
;;; Error tests

(deftest array-in-bounds-p.error.1
161 162
  (signals-error (array-in-bounds-p) program-error)
  t)