adjustable-array-p.lsp 1.76 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
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Jan 20 21:25:22 2003
;;;; Contains: Tests for ADJUSTABLE-ARRAY-P

(in-package :cl-test)

(deftest adjustable-array-p.1
  (notnot (adjustable-array-p (make-array '(5) :adjustable t)))
  t)

(deftest adjustable-array-p.2
  (notnot (adjustable-array-p (make-array nil :adjustable t)))
  t)

(deftest adjustable-array-p.3
  (notnot (adjustable-array-p (make-array '(2 3) :adjustable t)))
  t)

(deftest adjustable-array-p.4
  (notnot (adjustable-array-p (make-array '(2 2 2) :adjustable t)))
  t)

(deftest adjustable-array-p.5
  (notnot (adjustable-array-p (make-array '(2 2 2 2) :adjustable t)))
  t)

28 29
(deftest adjustable-array-p.6
  (macrolet ((%m (z) z))
sds's avatar
sds committed
30 31
            (let ((a (make-array '(5) :adjustable t)))
              (notnot (adjustable-array-p (expand-in-current-env (%m a))))))
32 33
  t)

34 35 36 37
(deftest adjustable-array-p.order.1
  (let ((i 0) x)
    (values
     (notnot (adjustable-array-p (progn (setf x (incf i))
sds's avatar
sds committed
38
                                        (make-array '(5) :adjustable t))))
39 40 41
     i x))
  t 1 1)

pfdietz's avatar
pfdietz committed
42 43 44
;;; Error tests

(deftest adjustable-array-p.error.1
45 46
  (signals-error (adjustable-array-p) program-error)
  t)
pfdietz's avatar
pfdietz committed
47 48

(deftest adjustable-array-p.error.2
49 50
  (signals-error (adjustable-array-p "aaa" nil) program-error)
  t)
pfdietz's avatar
pfdietz committed
51 52

(deftest adjustable-array-p.error.3
53
  (signals-type-error x 10 (adjustable-array-p x))
54
  t)
pfdietz's avatar
pfdietz committed
55 56

(deftest adjustable-array-p.error.4
57
  (check-type-error #'adjustable-array-p #'arrayp)
pfdietz's avatar
pfdietz committed
58
  nil)
59 60

(deftest adjustable-array-p.error.5
61 62
  (signals-error (locally (adjustable-array-p 10)) type-error)
  t)
63 64

(deftest adjustable-array-p.error.6
65
  (signals-error (let ((x 10))
sds's avatar
sds committed
66 67 68
                    (locally (declare (optimize (safety 3)))
                           (adjustable-array-p x)))
                 type-error)
69
  t)