-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathadjustable-array-p.lsp
69 lines (54 loc) · 1.76 KB
/
adjustable-array-p.lsp
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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
;-*- 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)
(deftest adjustable-array-p.6
(macrolet ((%m (z) z))
(let ((a (make-array '(5) :adjustable t)))
(notnot (adjustable-array-p (expand-in-current-env (%m a))))))
t)
(deftest adjustable-array-p.order.1
(let ((i 0) x)
(values
(notnot (adjustable-array-p (progn (setf x (incf i))
(make-array '(5) :adjustable t))))
i x))
t 1 1)
;;; Error tests
(deftest adjustable-array-p.error.1
(signals-error (adjustable-array-p) program-error)
t)
(deftest adjustable-array-p.error.2
(signals-error (adjustable-array-p "aaa" nil) program-error)
t)
(deftest adjustable-array-p.error.3
(signals-type-error x 10 (adjustable-array-p x))
t)
(deftest adjustable-array-p.error.4
(check-type-error #'adjustable-array-p #'arrayp)
nil)
(deftest adjustable-array-p.error.5
(signals-error (locally (adjustable-array-p 10)) type-error)
t)
(deftest adjustable-array-p.error.6
(signals-error (let ((x 10))
(locally (declare (optimize (safety 3)))
(adjustable-array-p x)))
type-error)
t)