/[gcl]/gcl/ansi-tests/elt.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/elt.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by pfdietz, Fri Oct 18 11:58:46 2002 UTC revision 1.3 by pfdietz, Wed Oct 23 03:10:23 2002 UTC
# Line 8  Line 8 
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    
# Line 50  Line 47 
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
# Line 114  Line 109 
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
# Line 159  Line 152 
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
# Line 195  Line 184 
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
# Line 246  Line 232 
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
# Line 284  Line 266 
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
# Line 297  Line 276 
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)  
 |#  

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26