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/test/unification-tests.lisp new-cl-unification/test/unification-tests.lisp --- old-cl-unification/test/unification-tests.lisp 2016-01-01 21:16:35.000000000 +0000 +++ new-cl-unification/test/unification-tests.lisp 2016-01-01 21:16:35.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)