/[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.7 by pfdietz, Mon Jan 13 14:11:49 2003 UTC revision 1.8 by pfdietz, Fri Jan 24 04:22:54 2003 UTC
# Line 9  Line 9 
9    
10  ;; elt on lists  ;; elt on lists
11    
12  (deftest elt-1 (safe-elt nil 0) type-error)  (deftest elt-1
13  (deftest elt-1a (safe-elt nil -10) type-error)    (classify-error (elt nil 0))
14  (deftest elt-2 (safe-elt nil 1000000) type-error)    type-error)
15  (deftest elt-3 (safe-elt '(a b c d e) 0) a)  
16  (deftest elt-4 (safe-elt '(a b c d e) 2) c)  (deftest elt-1a
17  (deftest elt-5 (safe-elt '(a b c d e) 4) e)    (classify-error (elt nil -10))
18  (deftest elt-5a (safe-elt '(a b c d e) -4) type-error)    type-error)
19    
20    (deftest elt-2
21      (classify-error (elt nil 1000000))
22      type-error)
23    
24    (deftest elt-3 (elt '(a b c d e) 0) a)
25    (deftest elt-4 (elt '(a b c d e) 2) c)
26    (deftest elt-5 (elt '(a b c d e) 4) e)
27    (deftest elt-5a
28      (classify-error (elt '(a b c d e) -4))
29      type-error)
30    
31  (deftest elt-6  (deftest elt-6
32    (let ((x (make-int-list 1000)))    (let ((x (make-int-list 1000)))
33      (notnot      (notnot-mv
34       (every       (every
35        #'(lambda (i)        #'(lambda (i) (eql i (elt x i)))
           (eql i (safe-elt x i)))  
36        x)))        x)))
37    t)    t)
38    
# Line 53  Line 64 
64    (let ((x (list 'a 'b 'c 'd 'e)))    (let ((x (list 'a 'b 'c 'd 'e)))
65      (let ((y (loop for c on x collect c)))      (let ((y (loop for c on x collect c)))
66        (setf (elt x 2) 'f)        (setf (elt x 2) 'f)
67        (notnot        (notnot-mv
68         (every #'eq         (every #'eq
69                y                y
70                (loop for c on x collect c)))))                (loop for c on x collect c)))))
# Line 61  Line 72 
72    
73  (deftest elt-12  (deftest elt-12
74    (let ((x (make-int-list 100000)))    (let ((x (make-int-list 100000)))
75      (safe-elt x 90000))      (elt x 90000))
76    90000)    90000)
77    
78  (deftest elt-13  (deftest elt-13
79    (let ((x (make-int-list 100000)))    (let ((x (make-int-list 100000)))
80      (setf (elt x 80000) 'foo)      (setf (elt x 80000) 'foo)
81      (list (safe-elt x 79999)      (list (elt x 79999)
82            (safe-elt x 80000)            (elt x 80000)
83            (safe-elt x 80001)))            (elt x 80001)))
84    (79999 foo 80001))    (79999 foo 80001))
85    
   
 ;; Special case to test error handling as dictated by new  
 ;; CL standard  
86  (deftest elt-14  (deftest elt-14
87    (let ((x (list 'a 'b 'c)))    (classify-error
88      (safe-elt x 10))     (let ((x (list 'a 'b 'c)))
89         (elt x 10)))
90    type-error)    type-error)
91    
92  (deftest elt-15  (deftest elt-15
93    (let ((x (list 'a 'b 'c)))    (classify-error
94      (safe-elt x 'a))     (let ((x (list 'a 'b 'c)))
95         (elt x 'a)))
96    type-error)    type-error)
97    
98  (deftest elt-16  (deftest elt-16
99    (let ((x (list 'a 'b 'c)))    (classify-error
100      (safe-elt x 10.0))     (let ((x (list 'a 'b 'c)))
101         (elt x 10.0)))
102    type-error)    type-error)
103    
104  (deftest elt-17  (deftest elt-17
105    (let ((x (list 'a 'b 'c)))    (classify-error
106      (safe-elt x -1))     (let ((x (list 'a 'b 'c)))
107         (elt x -1)))
108    type-error)    type-error)
109    
110  (deftest elt-18  (deftest elt-18
111    (let ((x (list 'a 'b 'c)))    (classify-error
112      (safe-elt x -100000000000000000))     (let ((x (list 'a 'b 'c)))
113         (elt x -100000000000000000)))
114    type-error)    type-error)
115    
116  (deftest elt-19  (deftest elt-19
117    (let ((x (list 'a 'b 'c)))    (classify-error
118      (safe-elt x #\w))     (let ((x (list 'a 'b 'c)))
119         (elt x #\w)))
120    type-error)    type-error)
121    
122  (deftest elt-v-1  (deftest elt-v-1
# Line 111  Line 125 
125    type-error)    type-error)
126    
127  ;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil)  ;; actually undefined  ;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil)  ;; actually undefined
128  (deftest elt-v-3 (elt (make-array '(5) :initial-contents '(a b c d e)) 0)  (deftest elt-v-3
129      (elt (make-array '(5) :initial-contents '(a b c d e)) 0)
130    a)    a)
131  (deftest elt-v-4 (elt (make-array '(5) :initial-contents '(a b c d e)) 2)  
132    (deftest elt-v-4
133      (elt (make-array '(5) :initial-contents '(a b c d e)) 2)
134    c)    c)
135  (deftest elt-v-5 (elt (make-array '(5) :initial-contents '(a b c d e)) 4)  
136    (deftest elt-v-5
137      (elt (make-array '(5) :initial-contents '(a b c d e)) 4)
138    e)    e)
139    
140  (deftest elt-v-6  (deftest elt-v-6

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

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