8 |
(declaim (optimize (safety 3))) |
(declaim (optimize (safety 3))) |
9 |
|
|
10 |
(defun safe-elt (x n) |
(defun safe-elt (x n) |
11 |
(handler-case |
(classify-error (elt x n))) |
|
(elt x n) |
|
|
(type-error () 'type-error) |
|
|
(error (c) c))) |
|
12 |
|
|
13 |
;; elt on lists |
;; elt on lists |
14 |
|
|
47 |
((a b c e) e)) |
((a b c e) e)) |
48 |
|
|
49 |
(deftest elt-10 |
(deftest elt-10 |
50 |
(handler-case |
(classify-error |
51 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
52 |
(setf (elt x 4) 'd)) |
(setf (elt x 4) 'd))) |
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
53 |
type-error) |
type-error) |
54 |
|
|
55 |
(deftest elt-11 |
(deftest elt-11 |
109 |
type-error) |
type-error) |
110 |
|
|
111 |
(deftest elt-v-1 |
(deftest elt-v-1 |
112 |
(handler-case |
(classify-error |
113 |
(elt (make-array '(0)) 0) |
(elt (make-array '(0)) 0)) |
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
114 |
type-error) |
type-error) |
115 |
|
|
116 |
;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined |
;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined |
152 |
(a b c e e)) |
(a b c e e)) |
153 |
|
|
154 |
(deftest elt-v-10 |
(deftest elt-v-10 |
155 |
(handler-case |
(classify-error |
156 |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
157 |
(setf (elt x 4) 'd)) |
(setf (elt x 4) 'd))) |
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
158 |
type-error) |
type-error) |
159 |
|
|
160 |
(deftest elt-v-11 |
(deftest elt-v-11 |
161 |
(handler-case |
(classify-error |
162 |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
163 |
(setf (elt x -100) 'd)) |
(setf (elt x -100) 'd))) |
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
164 |
type-error) |
type-error) |
165 |
|
|
166 |
(deftest elt-v-12 |
(deftest elt-v-12 |
184 |
(make-array n :adjustable t))) |
(make-array n :adjustable t))) |
185 |
|
|
186 |
(deftest elt-adj-array-1 |
(deftest elt-adj-array-1 |
187 |
(handler-case |
(classify-error (elt (make-adj-array '(0)) 0)) |
|
(elt (make-adj-array '(0)) 0) |
|
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
188 |
type-error) |
type-error) |
189 |
|
|
190 |
;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined |
;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined |
232 |
(a b c e e)) |
(a b c e e)) |
233 |
|
|
234 |
(deftest elt-adj-array-10 |
(deftest elt-adj-array-10 |
235 |
(handler-case |
(classify-error |
236 |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
237 |
(setf (elt x 4) 'd)) |
(setf (elt x 4) 'd))) |
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
238 |
type-error) |
type-error) |
239 |
|
|
240 |
(deftest elt-adj-array-11 |
(deftest elt-adj-array-11 |
241 |
(handler-case |
(classify-error |
242 |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
243 |
(setf (elt x -100) 'd)) |
(setf (elt x -100) 'd))) |
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
244 |
type-error) |
type-error) |
245 |
|
|
246 |
(deftest elt-adj-array-12 |
(deftest elt-adj-array-12 |
266 |
:displaced-index-offset displacement)) |
:displaced-index-offset displacement)) |
267 |
|
|
268 |
(deftest elt-displaced-array-1 |
(deftest elt-displaced-array-1 |
269 |
(handler-case |
(classify-error (elt (make-displaced-array '(0) 100) 0)) |
|
(elt (make-displaced-array '(0) 100) 0) |
|
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
270 |
type-error) |
type-error) |
271 |
|
|
272 |
(deftest elt-displaced-array-2 |
(deftest elt-displaced-array-2 |
276 |
(deftest elt-displaced-array-3 |
(deftest elt-displaced-array-3 |
277 |
(elt (make-displaced-array '(5) 100) 4) |
(elt (make-displaced-array '(5) 100) 4) |
278 |
104) |
104) |
|
|
|
|
#| |
|
|
(deftest elt-displaced-array-4 |
|
|
(handler-case |
|
|
(make-displaced-array '(100) 100000) |
|
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
|
type-error) |
|
|
|# |
|
|
|
|
|
#| |
|
|
(deftest elt-displaced-array-5 |
|
|
(handler-case |
|
|
(make-displaced-array '(100) (- 100000 50)) |
|
|
(type-error () 'type-error) |
|
|
(error (c) c)) |
|
|
type-error) |
|
|
|# |
|