113 lines
3.2 KiB
Common Lisp
113 lines
3.2 KiB
Common Lisp
(in-package :cl-user)
|
|
(defpackage prove.report
|
|
(:use :cl)
|
|
(:export :report
|
|
:test-report
|
|
:normal-test-report
|
|
:passed-test-report
|
|
:failed-test-report
|
|
:error-test-report
|
|
:skipped-test-report
|
|
:comment-report
|
|
:composed-test-report
|
|
|
|
:test-report-p
|
|
:passed-report-p
|
|
:failed-report-p
|
|
:error-report-p
|
|
:skipped-report-p
|
|
|
|
:plan
|
|
:children
|
|
:description
|
|
:notp
|
|
:got
|
|
:got-form
|
|
:expected
|
|
:report-expected-label
|
|
:duration
|
|
:slow-threshold
|
|
:print-error-detail))
|
|
(in-package :prove.report)
|
|
|
|
(defclass report ()
|
|
((description :type (or null string)
|
|
:initarg :description
|
|
:initform nil)))
|
|
|
|
(defclass comment-report (report) ())
|
|
|
|
(defclass test-report (report)
|
|
((duration :initarg :duration
|
|
:initform nil)
|
|
(slow-threshold :initarg :slow-threshold)
|
|
(print-error-detail :type boolean
|
|
:initarg :print-error-detail
|
|
:initform t)))
|
|
|
|
(defclass normal-test-report (test-report)
|
|
((test-function :type (or function symbol)
|
|
:initarg :test-function)
|
|
(notp :type boolean
|
|
:initarg :notp
|
|
:initform nil)
|
|
(got :initarg :got
|
|
:initform (error ":got is required"))
|
|
(got-form :initarg :got-form
|
|
:initform '#:unbound)
|
|
(expected :initarg :expected
|
|
:initform (error ":expected is required"))
|
|
(report-expected-label :type (or null string)
|
|
:initarg :report-expected-label
|
|
:initform nil)))
|
|
|
|
(defclass composed-test-report (test-report)
|
|
((plan :initarg :plan
|
|
:initform nil)
|
|
(children :initarg :children
|
|
:initform (make-array 0 :adjustable t :fill-pointer 0))))
|
|
|
|
(defclass passed-test-report (normal-test-report) ())
|
|
(defclass failed-test-report (normal-test-report) ())
|
|
(defclass error-test-report (failed-test-report) ())
|
|
(defclass skipped-test-report (normal-test-report) ())
|
|
|
|
(defun test-report-p (report)
|
|
(typep report 'test-report))
|
|
|
|
(defun passed-report-p (report)
|
|
(typecase report
|
|
(skipped-test-report nil)
|
|
(passed-test-report t)
|
|
(composed-test-report
|
|
(every #'passed-report-p (slot-value report 'children)))
|
|
(otherwise nil)))
|
|
|
|
(defun failed-report-p (report)
|
|
(typecase report
|
|
(skipped-test-report nil)
|
|
(failed-test-report t)
|
|
(composed-test-report
|
|
(some #'failed-report-p (slot-value report 'children)))
|
|
(otherwise nil)))
|
|
|
|
(defun error-report-p (report)
|
|
(typep report 'error-test-report))
|
|
|
|
(defun skipped-report-p (report)
|
|
(typecase report
|
|
(skipped-test-report t)
|
|
(composed-test-report
|
|
(some #'skipped-report-p (slot-value report 'children)))
|
|
(otherwise nil)))
|
|
|
|
(defmethod print-object ((report normal-test-report) stream)
|
|
(with-slots (got notp expected description) report
|
|
(format stream
|
|
"#<~A RESULT: ~S, GOT: ~S, ~:[~;NOT ~]EXPECTED: ~S~:[~;~:*, DESCRIPTION: ~A~]>"
|
|
(type-of report)
|
|
(passed-report-p report)
|
|
got
|
|
notp
|
|
expected
|
|
description)))
|