Thu Feb 4 07:20:04 UTC 2010 pix@kepibu.org
* Make "inner-error" and "outer-error" proper conditions.
diff -rN -u old-cl-unification-1/test/unification-tests.lisp new-cl-unification-1/test/unification-tests.lisp
--- old-cl-unification-1/test/unification-tests.lisp 2013-07-21 19:26:19.000000000 +0000
+++ new-cl-unification-1/test/unification-tests.lisp 2013-07-21 19:26:19.000000000 +0000
@@ -192,6 +192,12 @@
)
+(define-condition inner-unification-failure (unification-failure) ()
+ (:default-initargs :format-control "Inner unification-failure."))
+(define-condition inner-error (simple-error) ()
+ (:default-initargs :format-control "Inner error."))
+(define-condition outer-error (simple-error) ()
+ (:default-initargs :format-control "Outer error."))
(defun nested-match-cases (input)
(match-case (input)
@@ -200,27 +206,24 @@
collect (match-case (b)
('(:c ?c) ?c)
('(:d ?d) ?d)
- (otherwise (error "error-inner")))))
- (otherwise (error "error-outer"))))
-
-(define-condition inner-error (unification-failure) ()
- (:default-initargs :format-control "Inner error."))
+ (otherwise (error 'inner-error)))))
+ (otherwise (error 'outer-error))))
(with-tests (:name "control flow")
- (test-error (nested-match-cases '(:a 42 :b 33)) :announce t)
+ (test-error (nested-match-cases '(:a 42 :b 33)) :condition-type 'outer-error)
- (test-error (nested-match-cases '(:a 42 :b (33 42))) :announce t)
+ (test-error (nested-match-cases '(:a 42 :b (33 42))) :condition-type 'inner-error)
(test '(42 43 44) (nested-match-cases '(:a 42 :b ((:d 42) (:c 43) (:c 44))))
:test #'equal)
(test-error (match ('(x) '(x) :errorp nil)
- (error 'inner-error))
- :condition-type 'inner-error)
+ (error 'inner-unification-failure))
+ :condition-type 'inner-unification-failure)
(test-error (matchf ((x) '(x) :errorp nil)
- (error 'inner-error))
- :condition-type 'inner-error)
+ (error 'inner-unification-failure))
+ :condition-type 'inner-unification-failure)
(with-tests (:name "final t-or-otherwise")
(test :success (matching ()
@@ -244,21 +247,21 @@
(test-error (matching ()
(('x 'y) :fail)
- (('x 'x) (error 'inner-error))
+ (('x 'x) (error 'inner-unification-failure))
(('?x 'x) x))
- :condition-type 'inner-error)
+ :condition-type 'inner-unification-failure)
(test-error (match-case ('(x))
('(y) :fail)
- ('(x) (error 'inner-error))
+ ('(x) (error 'inner-unification-failure))
('(?x) x))
- :condition-type 'inner-error)
+ :condition-type 'inner-unification-failure)
(test-error (matchf-case ('(x))
((y) :fail)
- ((x) (error 'inner-error))
+ ((x) (error 'inner-unification-failure))
((?x) x))
- :condition-type 'inner-error)
+ :condition-type 'inner-unification-failure)
(test 'sym (match-case ('(sym))
('(a) :fail)