Mon Jan 25 07:38:54 UTC 2010 pix@kepibu.org
* Moar tests!
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:13.000000000 +0000
+++ new-cl-unification-1/test/unification-tests.lisp 2013-07-21 19:26:13.000000000 +0000
@@ -203,6 +203,8 @@
(otherwise (error "error-inner")))))
(otherwise (error "error-outer"))))
+(define-condition inner-error (unification-failure) ())
+
(with-tests (:name "control flow")
(test-error (nested-match-cases '(:a 42 :b 33)) :announce t)
@@ -210,6 +212,66 @@
(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
+ :known-failure t)
+
+ (test-error (matchf ((x) '(x) :errorp nil)
+ (error 'inner-error))
+ :condition-type 'inner-error
+ :known-failure t)
+
+ (with-tests (:name "final t-or-otherwise")
+ (test :success (matching ()
+ (('x 'y) :fail)
+ (t :success)))
+ (test :success (matching ()
+ (('x 'y) :fail)
+ (otherwise :success)))
+ (test :success (match-case ('x)
+ ('y :fail)
+ (t :success)))
+ (test :success (match-case ('x)
+ ('y :fail)
+ (otherwise :success)))
+ (test :success (matchf-case ('(x))
+ ((y) :fail)
+ (t :success)))
+ (test :success (matchf-case ('(x))
+ ((y) :fail)
+ (otherwise :success))))
+
+ (test-error (matching ()
+ (('x 'y) :fail)
+ (('x 'x) (error 'inner-error))
+ (('?x 'x) x))
+ :condition-type 'inner-error)
+
+ (test-error (match-case ('(x))
+ ('(y) :fail)
+ ('(x) (error 'inner-error))
+ ('(?x) x))
+ :condition-type 'inner-error
+ :known-failure t)
+
+ (test-error (matchf-case ('(x))
+ ((y) :fail)
+ ((x) (error 'inner-error))
+ ((?x) x))
+ :condition-type 'inner-error
+ :known-failure t)
+
+ (test 'sym (match-case ('(sym))
+ ('(a) :fail)
+ ('(b) :fail)
+ ('(?x) x)))
+
+ (test 'sym (matchf-case ('(sym))
+ ((a) :fail)
+ ((b) :fail)
+ ((?x) x)))
)