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)