handler-bind.lsp 3.25 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Fri Feb 28 22:07:25 2003
;;;; Contains: Tests of HANDLER-BIND

6

7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28

(deftest handler-bind.1
  (handler-bind ())
  nil)

(deftest handler-bind.2
  (handler-bind () (values)))

(deftest handler-bind.3
  (handler-bind () (values 1 2 3))
  1 2 3)

(deftest handler-bind.4
  (let ((x 0))
    (values
     (handler-bind () (incf x) (+ x 10))
     x))
  11 1)

(deftest handler-bind.5
  (block foo
    (handler-bind ((error #'(lambda (c) (return-from foo 'good))))
sds's avatar
sds committed
29
                  (error "an error")))
30 31 32 33 34 35 36
  good)

(deftest handler-bind.6
  (block foo
    (handler-bind
     ((error #'(lambda (c) (return-from foo 'good))))
     (handler-bind ((error #'(lambda (c) (error c)))
sds's avatar
sds committed
37 38
                    (error #'(lambda (c) (return-from foo 'bad))))
                   (error "an error"))))
39 40 41 42 43 44 45 46 47
  good)

(defun handler-bind.7-handler-fn (c)
  (declare (ignore c))
  (throw 'foo 'good))

(deftest handler-bind.7
  (catch 'foo
    (handler-bind ((simple-error #'handler-bind.7-handler-fn))
sds's avatar
sds committed
48
                  (error "simple error")))
49 50 51 52 53
  good)

(deftest handler-bind.8
  (catch 'foo
    (handler-bind ((simple-error 'handler-bind.7-handler-fn))
sds's avatar
sds committed
54
                  (error "simple error")))
55 56 57 58 59
  good)

(deftest handler-bind.9
  (catch 'foo
    (handler-bind ((simple-error #.(symbol-function
sds's avatar
sds committed
60 61
                                    'handler-bind.7-handler-fn)))
                  (error "simple error")))
62 63 64 65 66
  good)

(deftest handler-bind.10
  (block done
    (flet ((%foo () (signal "A simple condition"))
sds's avatar
sds committed
67 68
           (%succeed (c) (declare (ignore c)) (return-from done 'good))
           (%fail (c) (declare (ignore c)) (return-from done 'bad)))
69 70
      (handler-bind
       ((error #'%fail)
sds's avatar
sds committed
71
        (simple-condition #'%succeed))
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
       (%foo))))
  good)

(deftest handler-bind.11
  (block done
    (handler-bind
     ((error #'(lambda (c) c))
      (error #'(lambda (c) (declare (ignore c)) (return-from done 'good))))
     (error "an error")))
  good)

(deftest handler-bind.12
  (block done
    (handler-bind
     ((error #'(lambda (c) (declare (ignore c)) (return-from done 'good))))
     (handler-bind
      ((error #'(lambda (c) c)))
      (error "an error"))))
  good)

92 93 94
(deftest handler-bind.13
  (handler-bind
   ((error #'(lambda (c) (declare (ignore c))
sds's avatar
sds committed
95
               (throw 'done 'good))))
96 97 98 99 100 101 102 103 104
   (catch 'done
     (error "an error")))
  good)

(deftest handler-bind.14
  (catch 'done
    (handler-bind
     ((symbol #'identity)  ;; can never succeed
      (error #'(lambda (c) (declare (ignore c))
sds's avatar
sds committed
105
                 (throw 'done 'good))))
106 107 108 109 110 111
     (error "an error")))
  good)

(deftest handler-bind.15
  (catch 'done
    (handler-bind
112
     ((nil #'(lambda (c) (declare (ignore c))
sds's avatar
sds committed
113
               (throw 'done 'bad)))
114
      (error #'(lambda (c) (declare (ignore c))
sds's avatar
sds committed
115
                 (throw 'done 'good))))
116 117 118 119 120 121 122 123 124
     (error "an error")))
  good)

(deftest handler-bind.16
  (catch 'done
    (handler-bind
     (((not error) #'identity)
      (error
       #'(lambda (c) (declare (ignore c))
sds's avatar
sds committed
125
           (throw 'done 'good))))
126 127 128 129 130 131 132
     (error "an error")))
  good)

(deftest handler-bind.17
  (catch 'done
    (handler-bind
     ((#.(find-class 'error)
sds's avatar
sds committed
133 134
         #'(lambda (c) (declare (ignore c))
             (throw 'done 'good))))
135 136 137
     (error "an error")))
  good)

138 139 140 141 142
;;; More handler-bind tests elsewhere




sds's avatar
sds committed
143 144 145 146