row-major-aref.lsp 2.75 KB
Newer Older
pfdietz's avatar
pfdietz committed
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 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
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Wed Jan 22 20:16:38 2003
;;;; Contains: Tests of ROW-MAJOR-AREF

(in-package :cl-test)

;;; ROW-MAJOR-AREF is also used by equalp-with-case (see rt/rt.lsp)

(deftest row-major-aref.1
  (loop for i from 0 to 5 collect (row-major-aref #(a b c d e f) i))
  (a b c d e f))

(deftest row-major-aref.2
  (loop for i from 0 to 5 collect (row-major-aref #2a((a b c d)(e f g h)) i))
  (a b c d e f))

(deftest row-major-aref.3
  (row-major-aref #0a100 0)
  100)

(deftest row-major-aref.4
  (loop for i from 0 to 5 collect (row-major-aref #*011100 i))
  (0 1 1 1 0 0))

(deftest row-major-aref.5
  (loop for i from 0 to 5 collect (row-major-aref "abcdef" i))
  (#\a #\b #\c #\d #\e #\f))

(deftest row-major-aref.6
  (let ((a (make-array nil :initial-element 'x)))
    (values
     (aref a)
     (setf (row-major-aref a 0) 'y)
     (aref a)
     a))
  x y y #0ay)

(deftest row-major-aref.7
  (let ((a (make-array '(4) :initial-element 'x)))
    (values
     (aref a 0)
     (aref a 1)
     (aref a 2)
     (aref a 3)
     (setf (row-major-aref a 0) 'a)
     (setf (row-major-aref a 1) 'b)
     (setf (row-major-aref a 2) 'c)
     a))
  x x x x a b c #(a b c x))

(deftest row-major-aref.8
  (let ((a (make-array '(4) :element-type 'base-char
sds's avatar
sds committed
54
                       :initial-element #\x)))
pfdietz's avatar
pfdietz committed
55 56 57 58 59 60 61 62 63 64 65 66 67
    (values
     (aref a 0)
     (aref a 1)
     (aref a 2)
     (aref a 3)
     (setf (row-major-aref a 0) #\a)
     (setf (row-major-aref a 1) #\b)
     (setf (row-major-aref a 2) #\c)
     a))
  #\x #\x #\x #\x #\a #\b #\c "abcx")

(deftest row-major-aref.9
  (let ((a (make-array '(4) :initial-element 0
sds's avatar
sds committed
68
                       :element-type 'bit)))
pfdietz's avatar
pfdietz committed
69 70 71 72 73 74 75 76 77 78 79 80 81
    (values
     (aref a 0)
     (aref a 1)
     (aref a 2)
     (aref a 3)
     (setf (row-major-aref a 0) 1)
     (setf (row-major-aref a 1) 1)
     (setf (row-major-aref a 3) 1)
     a))
  0 0 0 0 1 1 1 #*1101)

(deftest row-major-aref.10
  (let ((a (make-array '(2 3 4)
sds's avatar
sds committed
82 83
                       :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))))))
pfdietz's avatar
pfdietz committed
84 85 86
    (loop for i from 0 to 23 collect (row-major-aref a i)))
  (a b c d e f g h i j k l m n o p q r s t u v w x))

87 88 89 90 91 92 93 94 95 96 97
(deftest row-major-aref.order.1
  (let ((i 0) x y)
    (values
     (row-major-aref
      (progn (setf x (incf i)) #(a b c d e f))
      (progn (setf y (incf i)) 2))
     i x y))
  c 2 1 2)

(deftest row-major-aref.order.2
  (let ((i 0) x y z
sds's avatar
sds committed
98
        (a (copy-seq #(a b c d e f))))
99 100 101 102 103 104 105 106
    (values
     (setf
      (row-major-aref
       (progn (setf x (incf i)) a)
       (progn (setf y (incf i)) 2))
      (progn (setf z (incf i)) 'w))
     a i x y z))
  w #(a b w d e f) 3 1 2 3)
pfdietz's avatar
pfdietz committed
107 108 109 110

;;; Error tests

(deftest row-major-aref.error.1
111 112
  (signals-error (row-major-aref) program-error)
  t)