Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

allow structures in results

  • Loading branch information...
commit dba609388ab6da8e8e3366e340c380e2cb82f21e 1 parent 8ab6280
@lisp authored
Showing with 13 additions and 11 deletions.
  1. +13 −11 test/test-unit.lisp
View
24 test/test-unit.lisp
@@ -169,14 +169,15 @@
(:method ((left cons) (right cons))
(labels ((plist-equal (left right)
;; relax plist order
- (and (= (length left) (length right))
- (loop for (key left-value) on left by #'cddr
- do (let ((right-value (getf right key left)))
- (unless (test-equal left-value right-value)
- (break "test-equal plist failed.")
- (return nil)))
- finally (return t)))))
- (if (and (keywordp (first left)) (keywordp (first right)))
+ (loop for (key left-value) on left by #'cddr
+ do (let ((right-value (getf right key left)))
+ (unless (test-equal left-value right-value)
+ (break "test-equal plist failed.")
+ (return nil)))
+ finally (return t))))
+ (if (ignore-errors (and (keywordp (first left)) (keywordp (first right))
+ (evenp (length left))
+ (= (length left) (length right))))
(plist-equal left right)
(and (test-equal (first left) (first right))
(test-equal (rest left) (rest right))))))
@@ -188,7 +189,8 @@
(:method ((left number) (right number))
(funcall *test-=* left right))
(:method ((left t) (right t))
- (equal left right))
+ ;; equalp to allow structures
+ (equalp left right))
(:method ((left symbol) (right symbol))
(or (eq left right)
;; treat uninterned symbols as wild-cards
@@ -560,7 +562,7 @@
(stream *trace-output*) (debug nil)
&aux results (*test-unit* unit))
(handler-bind ((error (lambda (condition)
- (format stream "~&signaled condition: ~a." condition)
+ (format stream "~&signaled condition: ~a: ~a~% with~%~s" (type-of condition) condition results)
(return-from %execute-test (values :failed condition)))))
(when (eq *test-unit-mode* :verbose)
@@ -572,7 +574,7 @@
(setf results
(block :run-test
(multiple-value-list (handler-bind
- ((error (lambda (condition)
+ ((error (lambda (condition)
(when debug (break "~%test ~s signaled:~%~a"
(test-unit-path unit) condition))
(return-from :run-test (list condition)))))

0 comments on commit dba6093

Please sign in to comment.
Something went wrong with that request. Please try again.