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

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

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

revision 1.16 by pfdietz, Sat Sep 25 21:47:32 2004 UTC revision 1.17 by pfdietz, Sun Sep 26 05:33:22 2004 UTC
# Line 207  Line 207 
207    (map '(simple-base-string 3) #'identity '(#\a #\b #\c))    (map '(simple-base-string 3) #'identity '(#\a #\b #\c))
208    "abc")    "abc")
209    
210    (deftest map.48
211      (let ((type '(or (vector t 10) (vector t 5))))
212        (if (subtypep type 'vector)
213            (equalpt (map type #'identity '(1 2 3 4 5)) #(1 2 3 4 5))
214          t))
215      t)
216    
217  ;;; Error tests  ;;; Error tests
218    
219  (deftest map.error.1  (deftest map.error.1
220    (handler-case (progn (proclaim '(optimize (safety 3)))    (signals-error-always (map 'symbol #'identity '(a b c)) type-error)
221                         (eval '(map 'symbol #'identity '(a b c))))    t t)
                 (error () :caught))  
   :caught)  
222    
223  (deftest map.error.2  (deftest map.error.2
224    (signals-error (map '(vector * 8) #'identity '(a b c)) type-error)    (signals-error (map '(vector * 8) #'identity '(a b c)) type-error)
# Line 248  Line 253 
253    (signals-error (map 'list #'car '(a b c d)) type-error)    (signals-error (map 'list #'car '(a b c d)) type-error)
254    t)    t)
255    
256    (deftest map.error.10
257      (let ((type '(or (vector bit) (vector t))))
258        (if (subtypep type 'vector)
259            (eval `(signals-error-always (map ',type #'identity '(1 0 1)) error))
260          (values t t)))
261      t t)
262    
263    (deftest map.error.11
264      (let ((type '(or (vector t 5) (vector t 10))))
265        (if (subtypep type 'vector)
266            (eval `(signals-error (map ',type #'identity '(1 2 3 4 5 6)) type-error))
267          t))
268      t)
269    
270  ;;; Test mapping on arrays with fill pointers  ;;; Test mapping on arrays with fill pointers
271    

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

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