aref.lsp 3.5 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Feb 11 17:33:24 2003
;;;; Contains: Tests for AREF

(in-package :cl-test)

;;; AREF is also tested in many other places

(deftest aref.1
  (aref #0aT)
  T)

(deftest aref.2
  (aref #(1 2 3 4) 2)
  3)

(deftest aref.3
  (aref #2a((a b c d)(e f g h))  1 2)
  g)

(deftest aref.4
  (loop for i from 0 below 6 collect (aref "abcdef" i))
  (#\a #\b #\c #\d #\e #\f))

(deftest aref.5
  (let ((a (make-array '(2 3) :element-type 'base-char
sds's avatar
sds committed
28
                       :initial-contents '("abc" "def"))))
29
    (loop for i below 2
sds's avatar
sds committed
30 31
          collect (loop for j below 3
                        collect (aref a i j))))
32 33 34 35 36 37 38 39 40
  ((#\a #\b #\c)
   (#\d #\e #\f)))

(deftest aref.6
  (loop for i below 10 collect (aref #*1101100010 i))
  (1 1 0 1 1 0 0 0 1 0))

(deftest aref.7
  (let ((a (make-array '(2 5) :element-type 'bit
sds's avatar
sds committed
41 42
                       :initial-contents '((1 1 0 0 1)
                                           (0 1 0 1 0)))))
43
    (loop for i below 2
sds's avatar
sds committed
44 45
          collect (loop for j below 5
                        collect (aref a i j))))
46 47 48 49 50
  ((1 1 0 0 1)
   (0 1 0 1 0)))

;;; Order of argument evaluation

51
(deftest aref.order.1
52 53 54
  (let ((i 0) x y (a #(a b c d)))
    (values
     (aref (progn (setf x (incf i)) a)
sds's avatar
sds committed
55
           (progn (setf y (incf i)) 2))
56 57 58
     i x y))
  c 2 1 2)

59
(deftest aref.order.2
60 61 62
  (let ((i 0) x y z (a #2a((a b c)(d e f))))
    (values
     (aref (progn (setf x (incf i)) a)
sds's avatar
sds committed
63 64
           (progn (setf y (incf i)) 1)
           (progn (setf z (incf i)) 2))
65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125
     i x y z))
  f 3 1 2 3)


;;; Setf of aref

(deftest setf-aref.1
  (let ((a (copy-seq #(1 2 3 4))))
    (values
     (setf (aref a 2) 'z)
     a))
  z
  #(1 2 z 4))

(deftest setf-aref.2
  (let ((a (make-array nil :initial-element 1)))
    (values
     (setf (aref a) 'z)
     a))
  z #0az)

(deftest setf-aref.3
  (let ((a (make-array '(2 3) :initial-element 'a)))
    (values
     (setf (aref a 0 1) 'z)
     a))
  z
  #2a((a z a)(a a a)))

(deftest setf-aref.4
  (let ((a (copy-seq "abcd")))
    (values
     (setf (aref a 0) #\z)
     a))
  #\z
  "zbcd")

(deftest setf-aref.5
  (let ((a (copy-seq #*0011)))
    (values
     (setf (aref a 0) 1)
     a))
  1
  #*1011)

(deftest setf-aref.6
  (let ((a (make-array '(2 3) :initial-element #\a :element-type 'base-char)))
    (values
     (setf (aref a 0 1) #\z)
     a))
  #\z
  #2a((#\a #\z #\a)(#\a #\a #\a)))

(deftest setf-aref.7
  (let ((a (make-array '(2 3) :initial-element 1 :element-type 'bit)))
    (values
     (setf (aref a 0 1) 0)
     a))
  0
  #2a((1 0 1)(1 1 1)))

126
(deftest setf-aref.order.1
127 128 129
  (let ((i 0) x y z (a (copy-seq #(a b c d))))
    (values
     (setf (aref (progn (setf x (incf i)) a)
sds's avatar
sds committed
130 131
                 (progn (setf y (incf i)) 2))
           (progn (setf z (incf i)) 'z))
132 133 134 135 136 137
     a
     i x y z))
  z #(a b z d) 3 1 2 3)

;;; To add: aref on displaced arrays, arrays with fill pointers, etc.

138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
(deftest aref.special-integer.1
  (do-special-integer-vectors
   (v #(1 1 0 1 0 1) nil)
   (assert (= (aref v 0) 1))
   (assert (= (aref v 1) 1))
   (assert (= (aref v 2) 0))
   (assert (= (aref v 3) 1))
   (assert (= (aref v 4) 0))
   (assert (= (aref v 5) 1)))
  nil)

(deftest aref.special-strings.1
  (do-special-strings
   (s "ABCDE" nil)
   (assert (eql (aref s 0) #\A))
   (assert (eql (aref s 1) #\B))
   (assert (eql (aref s 2) #\C))
   (assert (eql (aref s 3) #\D))
   (assert (eql (aref s 4) #\E)))
  nil)

;;; Error tests

161
(deftest aref.error.1
162 163
  (signals-error (aref) program-error)
  t)
164 165

(deftest aref.error.2
166 167 168
  (signals-error (funcall #'aref) program-error)
  t)