+ (let ((failure (make-instance ,@failure-init-args)))
+ (restartable-check-failure :reason (reason failure) :test-expr ',test)
+ (add-result failure)))))))
+
+(defclass is-failure-mixin ()
+ ((predicate :initarg :predicate :accessor predicate)
+ (actual-form :initarg :actual-form :accessor actual-form)
+ (actual-value :initarg :actual-value :accessor actual-value)))
+
+(defclass is-binary-failure-mixin (is-failure-mixin)
+ ((expected-value :initarg :expected-value :accessor expected-value)
+ (expected-form :initarg :expected-form :accessor expected-form)))
+
+(defclass is-failure (test-failure)
+ ((reason :initform nil :initarg :reason)))
+
+(defmethod reason :around ((result is-failure))
+ (or (slot-value result 'reason)
+ (call-next-method)))
+
+(defclass is-binary-failure (is-failure is-binary-failure-mixin)
+ ())
+
+(defmethod reason ((result is-binary-failure))
+ (format nil
+ "~2&~S~2% evaluated to ~2&~S~2% which is ~2&~S~2%to ~2&~S~2% (it should not be)"
+ (actual-form result)
+ (actual-value result)
+ (predicate result)
+ (expected-value result)))
+
+(defclass is-negated-binary-failure (is-failure is-binary-failure-mixin)
+ ())
+
+(defmethod reason ((result is-binary-failure))
+ (format nil
+ "~2&~S~2% evaluated to ~2&~S~2% which is not ~2&~S~2%to ~2&~S~2% (it should be)"
+ (actual-form result)
+ (actual-value result)
+ (predicate result)
+ (expected-value result)))
+
+(defclass is-unary-failure (is-failure is-failure-mixin)
+ ())
+
+(defmethod reason ((result is-unary-failure))
+ (format nil
+ "~2&~S~2% evaluated to ~2&~S~2% which satisfies ~2&~S~2% (it should not)"
+ (actual-form result)
+ (actual-value result)
+ (predicate result)))
+
+(defclass is-negated-unary-failure (is-failure is-failure-mixin)
+ ())
+
+(defmethod reason ((result is-negated-unary-failure))
+ (format nil
+ "~2&~S~2% evaluated to ~2&~S~2% which does not satisfy ~2&~S~2%"
+ (actual-form result)
+ (actual-value result)
+ (predicate result)))