(deftest unwind-protect-case.1
(let (result)
(unwind-protect-case ()
- (random 10)
- (:normal (push :normal result))
- (:abort (push :abort result))
- (:always (push :always result)))
+ (random 10)
+ (:normal (push :normal result))
+ (:abort (push :abort result))
+ (:always (push :always result)))
result)
(:always :normal))
(deftest unwind-protect-case.2
(let (result)
(unwind-protect-case ()
- (random 10)
- (:always (push :always result))
- (:normal (push :normal result))
- (:abort (push :abort result)))
+ (random 10)
+ (:always (push :always result))
+ (:normal (push :normal result))
+ (:abort (push :abort result)))
result)
(:normal :always))
(deftest unwind-protect-case.3
(let (result1 result2 result3)
(ignore-errors
- (unwind-protect-case ()
- (error "FOOF!")
- (:normal (push :normal result1))
- (:abort (push :abort result1))
- (:always (push :always result1))))
+ (unwind-protect-case ()
+ (error "FOOF!")
+ (:normal (push :normal result1))
+ (:abort (push :abort result1))
+ (:always (push :always result1))))
(catch 'foof
- (unwind-protect-case ()
- (throw 'foof 42)
- (:normal (push :normal result2))
- (:abort (push :abort result2))
- (:always (push :always result2))))
+ (unwind-protect-case ()
+ (throw 'foof 42)
+ (:normal (push :normal result2))
+ (:abort (push :abort result2))
+ (:always (push :always result2))))
(block foof
- (unwind-protect-case ()
- (return-from foof 42)
- (:normal (push :normal result3))
- (:abort (push :abort result3))
- (:always (push :always result3))))
+ (unwind-protect-case ()
+ (return-from foof 42)
+ (:normal (push :normal result3))
+ (:abort (push :abort result3))
+ (:always (push :always result3))))
(values result1 result2 result3))
(:always :abort)
(:always :abort)
(deftest unwind-protect-case.4
(let (result)
(unwind-protect-case (aborted-p)
- (random 42)
- (:always (setq result aborted-p)))
+ (random 42)
+ (:always (setq result aborted-p)))
result)
nil)
(deftest unwind-protect-case.5
(let (result)
(block foof
- (unwind-protect-case (aborted-p)
- (return-from foof)
- (:always (setq result aborted-p))))
+ (unwind-protect-case (aborted-p)
+ (return-from foof)
+ (:always (setq result aborted-p))))
result)
t)
(list (list :list (vector :A :B :C))))
(setf (gethash 'list ht) list)
(let* ((shallow-copy (copy-hash-table ht))
- (deep1-copy (copy-hash-table ht :key 'copy-list))
- (list (gethash 'list ht))
- (shallow-list (gethash 'list shallow-copy))
- (deep1-list (gethash 'list deep1-copy)))
+ (deep1-copy (copy-hash-table ht :key 'copy-list))
+ (list (gethash 'list ht))
+ (shallow-list (gethash 'list shallow-copy))
+ (deep1-list (gethash 'list deep1-copy)))
(list (eq ht shallow-copy)
- (eq ht deep1-copy)
- (eq list shallow-list)
- (eq list deep1-list) ; outer list was copied.
- (eq (second list) (second shallow-list))
- (eq (second list) (second deep1-list)) ; inner vector wasn't copied.
- )))
+ (eq ht deep1-copy)
+ (eq list shallow-list)
+ (eq list deep1-list) ; outer list was copied.
+ (eq (second list) (second shallow-list))
+ (eq (second list) (second deep1-list)) ; inner vector wasn't copied.
+ )))
(nil nil t nil t t))
(deftest maphash-keys.1
(deftest sequences.passing-improper-lists
(macrolet ((signals-error-p (form)
- `(handler-case
+ `(handler-case
(progn ,form nil)
- (type-error (e)
+ (type-error (e)
t)))
(cut (fn &rest args)
(with-gensyms (arg)
(print`(lambda (,arg)
(apply ,fn (list ,@(substitute arg '_ args))))))))
(let ((circular-list (make-circular-list 5 :initial-element :foo))
- (dotted-list (list* 'a 'b 'c 'd)))
- (loop for nth from 0
- for fn in (list
- (cut #'lastcar _)
- (cut #'rotate _ 3)
- (cut #'rotate _ -3)
- (cut #'shuffle _)
- (cut #'random-elt _)
- (cut #'last-elt _)
- (cut #'ends-with :foo _))
- nconcing
+ (dotted-list (list* 'a 'b 'c 'd)))
+ (loop for nth from 0
+ for fn in (list
+ (cut #'lastcar _)
+ (cut #'rotate _ 3)
+ (cut #'rotate _ -3)
+ (cut #'shuffle _)
+ (cut #'random-elt _)
+ (cut #'last-elt _)
+ (cut #'ends-with :foo _))
+ nconcing
(let ((on-circular-p (signals-error-p (funcall fn circular-list)))
(on-dotted-p (signals-error-p (funcall fn dotted-list))))
(when (or (not on-circular-p) (not on-dotted-p))
(macrolet
((test (type numbers)
`(deftest ,(format-symbol t '#:cdr5.~a (string type))
- (let ((numbers ,numbers))
- (values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers)
- (mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers)
- (mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers)
- (mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers)))
- (t t t nil nil nil nil)
- (t t t t nil nil nil)
- (nil nil nil t t t t)
- (nil nil nil nil t t t))))
+ (let ((numbers ,numbers))
+ (values (mapcar (of-type ',(format-symbol t '#:negative-~a (string type))) numbers)
+ (mapcar (of-type ',(format-symbol t '#:non-positive-~a (string type))) numbers)
+ (mapcar (of-type ',(format-symbol t '#:non-negative-~a (string type))) numbers)
+ (mapcar (of-type ',(format-symbol t '#:positive-~a (string type))) numbers)))
+ (t t t nil nil nil nil)
+ (t t t t nil nil nil)
+ (nil nil nil t t t t)
+ (nil nil nil nil t t t))))
(test fixnum (list most-negative-fixnum -42 -1 0 1 42 most-positive-fixnum))
(test integer (list (1- most-negative-fixnum) -42 -1 0 1 42 (1+ most-positive-fixnum)))
(test rational (list (1- most-negative-fixnum) -42/13 -1 0 1 42/13 (1+ most-positive-fixnum)))