/usr/share/common-lisp/source/xlunit/result.lisp is in cl-xlunit 0.6.3-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 | ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; ID: $Id$
;;;; Purpose: Result functions for XLUnit
;;;;
;;;; *************************************************************************
(in-package #:xlunit)
(defclass test-results ()
((test :initarg :test :reader result-test)
(count :initform 0 :accessor run-tests)
(failures :initarg :failures :accessor failures :initform nil)
(errors :initarg :errors :accessor errors :initform nil)
(listeners :initform nil :accessor listeners)
(stop :initform nil :accessor stop))
(:documentation "Results of running test(s)"))
(defmethod failure-count ((res test-results))
(length (failures res)))
(defmethod error-count ((res test-results))
(length (errors res)))
(defun make-test-results ()
(make-instance 'test-results))
(defmethod start-test ((tcase test) (res test-results))
(incf (run-tests res))
(mapc (lambda (listener)
(start-test listener tcase))
(listeners res))
res)
(defmethod end-test ((tcase test) (res test-results))
(mapc (lambda (listener) (end-test listener tcase)) (listeners res))
res)
(defmethod add-listener ((res test-results) (listener test-listener))
(push listener (listeners res)))
;; Test Failures
(defclass test-failure ()
((failed-test :initarg :failed-test :reader failed-test)
(thrown-condition :initarg :thrown-condition
:reader thrown-condition))
(:documentation "Stored failures/errors in test-results slots"))
(defun make-test-failure (test condition)
(make-instance 'test-failure :failed-test test
:thrown-condition condition))
(defmethod is-failure ((failure test-failure))
"Returns T if a failure was a test-failure condition"
(typep (thrown-condition failure) 'assertion-failed))
(defmethod print-object ((obj test-failure) stream)
(print-unreadable-object (obj stream :type t :identity nil)
(format stream "~A: " (failed-test obj))
(apply #'format stream
(simple-condition-format-control (thrown-condition obj))
(simple-condition-format-arguments (thrown-condition obj)))))
(defmethod was-successful ((result test-results))
"Returns T if a result has no failures or errors"
(and (null (failures result)) (null (errors result))))
;----------------------------------------------------------------------
; methods add-error, add-failure
;----------------------------------------------------------------------
(defmethod add-error ((ob test-results) (tcase test-case) condition)
(push (make-test-failure tcase condition) (errors ob))
(mapc #'(lambda (single-listener)
(add-error single-listener tcase condition))
(listeners ob)))
(defmethod add-failure ((ob test-results) (tcase test-case) condition)
(push (make-test-failure tcase condition) (failures ob))
(mapc #'(lambda (single-listener)
(add-failure single-listener tcase condition))
(listeners ob)))
|