dev/class-defs.lisp

   1 ;;;-*- Mode: Lisp; Package: lift -*-
   2
   3 (in-package #:lift)
   4
   5 ;;; ---------------------------------------------------------------------------
   6 ;;; classes
   7 ;;; ---------------------------------------------------------------------------
   8
   9 (defclass test-mixin ()
  10   ((name :initform nil :initarg :name :accessor name :reader testsuite-name)
  11    (run-setup :reader run-setup :initarg :run-setup)
  12    (done-setup? :initform nil :reader done-setup?)
  13    (done-dynamics? :initform nil :reader done-dynamics?)
  14    (current-method :initform nil :accessor current-method)
  15    (log-file :initform nil :initarg :log-file :reader log-file)
  16    (test-data :initform nil :accessor test-data)
  17    (test-source-file :initform nil :accessor test-source-file
  18                      :initarg :test-source-file)
  19    (profile
  20     :initform *profile-style*
  21     :initarg :profile
  22     :accessor profile))
  23   (:documentation "A test suite")
  24   (:default-initargs
  25     :run-setup :once-per-test-case))
  26
  27 (defclass process-test-mixin (test-mixin)
  28   ((maximum-time :initform *test-maximum-time*
  29                  :accessor maximum-time
  30                  :initarg :maximum-time)))
  31
  32 (defclass log-results-mixin (test-mixin)
  33   ())
  34
  35 (defclass test-result ()
  36   ((results-for :initform nil
  37                 :initarg :results-for
  38                 :accessor results-for)
  39    (tests-run :initform nil :accessor tests-run)
  40    (suites-run :initform nil :accessor suites-run)
  41    (failures :initform nil :accessor failures)
  42    (expected-failures :initform nil :accessor expected-failures)
  43    (errors :initform nil :accessor errors)
  44    (expected-errors :initform nil :accessor expected-errors)
  45    (skipped-test-cases :initform nil :accessor skipped-test-cases)
  46    (skipped-testsuites :initform nil :accessor skipped-testsuites)
  47    (test-mode :initform :single :initarg :test-mode :accessor test-mode)
  48    (test-interactive? :initform nil
  49                       :initarg :test-interactive? :accessor test-interactive?)
  50    (real-start-time :initarg :real-start-time :reader real-start-time)
  51    (start-time :accessor start-time :initform nil)
  52    (end-time :accessor end-time)
  53    (real-end-time :accessor real-end-time)
  54    (real-start-time-universal
  55     :initarg :real-start-time-universal :reader real-start-time-universal)
  56    (start-time-universal :accessor start-time-universal :initform nil)
  57    (end-time-universal :accessor end-time-universal)
  58    (real-end-time-universal :accessor real-end-time-universal)
  59    (properties :initform nil :accessor test-result-properties)
  60    (current-step :initform :created :accessor current-step)
  61    (testsuite-initargs
  62     :initform nil
  63     :initarg :testsuite-initargs
  64     :accessor testsuite-initargs)
  65    (uuid
  66     :initform nil
  67     :initarg :uuid
  68     :accessor result-uuid))
  69   (:documentation
  70 "A `test-result` instance contains all of the information collectd by
  71 LIFT during a test run.")
  72   (:default-initargs
  73     :test-interactive? *test-is-being-defined?*
  74     :real-start-time (get-test-real-time)
  75     :real-start-time-universal (get-universal-time)))
  76
  77 (defclass test-problem-mixin ()
  78   ((test-problem-kind
  79     :reader test-problem-kind
  80     :allocation :class
  81     :initarg :test-problem-kind)))
  82
  83 (defclass test-error-mixin ()
  84   ((backtrace :initform nil :initarg :backtrace :reader backtrace)))
  85
  86 (defclass test-failure-mixin ()
  87   ())
  88
  89 (defclass expected-problem-mixin ()
  90   ((documentation :initform nil
  91                   :initarg :documentation
  92                   :accessor failure-documentation)))
  93
  94 (defmethod print-object ((problem test-problem-mixin) stream)
  95   (print-unreadable-object (problem stream)
  96     (format stream "~a" (test-problem-kind problem))))
  97
  98 (defclass testsuite-problem-mixin (test-problem-mixin)
  99   ((testsuite :initform nil :initarg :testsuite :reader testsuite)
 100    (test-method :initform nil :initarg :test-method :reader test-method)
 101    (test-condition :initform nil
 102                    :initarg :test-condition
 103                    :reader test-condition)
 104    (test-step :initform nil :initarg :test-step :reader test-step)
 105    (testsuite-initargs
 106     :initform nil :initarg :testsuite-initargs
 107     :reader testsuite-initargs)))
 108
 109 (defmethod print-object ((problem testsuite-problem-mixin) stream)
 110   (print-unreadable-object (problem stream)
 111     (format stream "TEST-~@:(~A~): ~A in ~A"
 112             (test-problem-kind problem)
 113             (testsuite problem)
 114             (test-method problem))))
 115
 116 (defclass test-expected-failure (expected-problem-mixin
 117                                  test-failure-mixin testsuite-problem-mixin)
 118   ())
 119
 120 (defmethod test-problem-kind ((problem test-expected-failure))
 121   "Expected failure")
 122
 123 (defclass test-failure (test-failure-mixin testsuite-problem-mixin)
 124   ()
 125   (:default-initargs
 126    :test-problem-kind "failure"))
 127
 128 (defclass test-expected-error (expected-problem-mixin test-error-mixin testsuite-problem-mixin)
 129   ()
 130   (:default-initargs
 131    :test-problem-kind "Expected error"))
 132
 133 (defclass test-error (test-error-mixin testsuite-problem-mixin)
 134   ()
 135   (:default-initargs
 136    :test-problem-kind "Error"))
 137
 138 (defclass test-serious-condition (test-error)
 139   ()
 140   (:default-initargs
 141    :test-problem-kind "Serious condition"))
 142
 143 (defclass testsuite-error (test-error-mixin testsuite-problem-mixin)
 144   ()
 145   (:default-initargs
 146    :test-problem-kind "Testsuite error"))
 147
 148 (defclass testsuite-serious-condition (testsuite-error)
 149   ()
 150   (:default-initargs
 151    :test-problem-kind "Testsuite serious condition"))
 152
 153 (defclass testsuite-failure (test-failure-mixin testsuite-problem-mixin)
 154   ()
 155   (:default-initargs
 156    :test-problem-kind "Testsuite failure"))
 157
 158 (defclass testcase-skipped (testsuite-problem-mixin)
 159   ()
 160   (:default-initargs
 161    :test-problem-kind "Test case skipped"))
 162
 163 (defclass testsuite-skipped (testsuite-problem-mixin)
 164   ()
 165   (:default-initargs
 166    :test-problem-kind "Testsuite skipped"))
 167
 168 (defclass test-timeout-failure (test-failure)
 169   ((test-problem-kind :initform "Timeout" :allocation :class)))
 170
 171 (defclass test-configuration-problem-mixin (test-problem-mixin)
 172   ((message :initarg :message :reader test-problem-message)))
 173
 174 (defmethod print-object ((problem test-configuration-problem-mixin) stream)
 175   (print-unreadable-object (problem stream)
 176     (format stream "~a: ~a"
 177             (test-problem-kind problem) (test-problem-message problem))))
 178
 179 (defclass test-configuration-failure (test-configuration-problem-mixin test-failure-mixin)
 180   ())
 181
 182 (defclass test-configuration-error (test-configuration-problem-mixin test-error-mixin)
 183   ())
 184
 185 (defmethod test-problem-kind ((problem test-configuration-problem-mixin))
 186   "Configuration problem")
 187
 188 (defmethod test-problem-kind ((problem test-configuration-error))
 189   "Configuration error")
 190
 191 ;;;;
 192
 193 (defun testsuite-failures (result)
 194   (remove-if-not (lambda (p) (typep p 'testsuite-problem-mixin)) (failures result)))
 195
 196 (defun configuration-failures (result)
 197   (remove-if-not (lambda (p) (typep p 'test-configuration-problem-mixin)) (failures result)))