Coverage report: /home/runner/work/geb/geb/test/run-tests.lisp

KindCoveredAll%
expression766 10.6
branch16 16.7
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 (in-package :geb-test)
2
 
3
 (defparameter *all-tests*
4
   (list 'geb 'geb.lambda 'geb.lambda-experimental 'geb.lambda-conversion))
5
 
6
 ;; This just dumps the interactive information doesn't prompt you
7
 (defclass noisy-interactive (plain interactive)
8
   ())
9
 
10
 (defclass noisy-summary (interactive summary)
11
   ())
12
 
13
 (defun run-tests-error ()
14
   (let ((tests (parachute:status (geb-test:run-tests))))
15
     (if (eq :failed tests)
16
         (error "tests failed")
17
         tests)))
18
 
19
 ;; we have summary
20
 (defun run-tests (&key
21
                     (interactive? nil)
22
                     (summary?     nil)
23
                     (plain?       t)
24
                     (designators '(geb-test-suite)))
25
   "Here we run all the tests. We have many flags to determine how the
26
 tests ought to work
27
 
28
 ```lisp
29
 (run-tests :plain? nil :interactive? t) ==> 'interactive
30
 (run-tests :summary? t :interactive? t) ==> 'noisy-summary
31
 (run-tests :interactive? t)             ==> 'noisy-interactive
32
 (run-tests :summary? t)                 ==> 'summary
33
 (run-tests)                             ==> 'plain
34
 
35
 (run-tests :designators '(geb geb.lambda)) ==> run only those packages
36
 ```
37
 "
38
   (test designators
39
     :report (cond ((and summary? interactive?) 'noisy-summary)
40
                   (summary?                    'summary)
41
                   ((and plain? interactive?)   'noisy-interactive)
42
                   (interactive?                'interactive)
43
                   (t                           'plain))))
44
 
45
 #+slynk
46
 (defun profile-all ()
47
   (let* ((packages
48
            (list-all-packages))
49
          (alu-packages
50
            (remove-if-not (lambda (p)
51
                             (let ((search (search "GEB" (package-name p))))
52
                               (and search (= 0 search))))
53
                           packages))
54
          (without-aluser
55
              (remove-if (lambda (p)
56
                           (member (package-name p) '("geb-test")
57
                                   :test #'equalp))
58
                         alu-packages)))
59
     (mapc (lambda (alu)
60
             (slynk-backend:profile-package alu t t))
61
           without-aluser)))
62
 
63
 #+slynk
64
 (defun unprofile-all ()
65
   (slynk-backend:unprofile-all))
66
 
67
 #+slynk
68
 (defun profiler-report ()
69
   (slynk-backend:profile-report))
70
 
71
 #+slynk
72
 (defun profiler-reset ()
73
   (slynk-backend:profile-reset))
74
 
75
 #+ccl
76
 (defun code-coverage (&optional path)
77
   "generates code coverage, for CCL the coverage can be found at
78
 
79
 [CCL test coverage](../docs/tests/report.html)
80
 
81
 [SBCL test coverage](../docs/tests/cover-index.html)
82
 
83
 simply run this function to generate a fresh one
84
 "
85
   (ccl:reset-incremental-coverage)
86
   (ccl:reset-coverage)
87
 
88
   (setq ccl:*compile-code-coverage* t)
89
   (asdf:compile-system :geb :force t)
90
   (asdf:compile-system :geb/test :force t)
91
 
92
   (let ((coverage (make-hash-table)))
93
     ;; we want to note that some code loads before we can even test
94
     ;; it, so mark these under their own section
95
     (setf (gethash 'alucard.startup coverage)
96
           (ccl:get-incremental-coverage))
97
     (mapc (lambda (test)
98
             (run-tests :summary? t :designators test)
99
             (when test
100
               (setf (gethash test coverage)
101
                     (ccl:get-incremental-coverage))))
102
           (parachute:children (find-test 'geb-test-suite)))
103
     (ccl:report-coverage (if path
104
                              ;; this is bad by god fix
105
                              (format nil "~Areport.html" path)
106
                              #p"../docs/tests/report.html")
107
                          :tags coverage))
108
 
109
   (setq ccl:*compile-code-coverage* nil)
110
   (asdf:compile-system :geb :force t)
111
   (asdf:compile-system :geb/test :force t))
112
 
113
 #+sbcl
114
 (eval-when (:compile-toplevel :load-toplevel :execute)
115
   (require :sb-cover))
116
 
117
 #+sbcl
118
 (defun code-coverage (&optional (path nil))
119
   "generates code coverage, for CCL the coverage can be found at
120
 
121
 [CCL test coverage](../docs/tests/report.html)
122
 
123
 [SBCL test coverage](../docs/tests/cover-index.html)
124
 
125
 simply run this function to generate a fresh one
126
 "
127
   nil
128
   (declaim (optimize (sb-cover:store-coverage-data 3)))
129
   (asdf:oos 'asdf:load-op :geb :force t)
130
   (asdf:oos 'asdf:load-op :geb/test :force t)
131
   (run-tests :summary? t)
132
   (sb-cover:report (if path path "../docs/tests/"))
133
 
134
   (declaim (optimize (sb-cover:store-coverage-data 3)))
135
   (asdf:oos 'asdf:load-op :geb :force t)
136
   (asdf:oos 'asdf:load-op :geb/test :force t))
137
 
138
 #-(or sbcl ccl)
139
 (defun code-coverage (&optional path)
140
   "generates code coverage, for CCL the coverage can be found at
141
 
142
 [CCL test coverage](../docs/tests/report.html)
143
 
144
 [SBCL test coverage](../docs/tests/cover-index.html)
145
 
146
 simply run this function to generate a fresh one
147
 "
148
   path)