result.scm
1 | ;;;; Copyright (C) 2020 Julien Lepiller <julien@lepiller.eu> |
2 | ;;;; |
3 | ;;;; This library is free software; you can redistribute it and/or |
4 | ;;;; modify it under the terms of the GNU Lesser General Public |
5 | ;;;; License as published by the Free Software Foundation; either |
6 | ;;;; version 3 of the License, or (at your option) any later version. |
7 | ;;;; |
8 | ;;;; This library is distributed in the hope that it will be useful, |
9 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
10 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | ;;;; Lesser General Public License for more details. |
12 | ;;;; |
13 | ;;;; You should have received a copy of the GNU Lesser General Public |
14 | ;;;; License along with this library; if not, write to the Free Software |
15 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
16 | ;;;; |
17 | |
18 | (define-module (test-modules result) |
19 | #:use-module (srfi srfi-9) |
20 | #:use-module (srfi srfi-19) |
21 | #:use-module (ice-9 match) |
22 | #:export (make-test-case |
23 | test-case? |
24 | test-case-id |
25 | test-case-num |
26 | test-case-name |
27 | test-case-document |
28 | test-case-result |
29 | test-case-reason |
30 | update-test-case |
31 | |
32 | make-test-driver |
33 | test-driver? |
34 | test-driver-init |
35 | test-driver-print |
36 | test-driver-finalize |
37 | |
38 | tap-driver |
39 | earl-driver)) |
40 | |
41 | ;; A test case is the result of running a test. It has an identifier, a name |
42 | ;; and a description. Its result is a symbol, which can be 'skiped, 'pass, |
43 | ;; 'fail, 'xpass, or 'xfail. The reason is a string or #f that explains the |
44 | ;; result |
45 | (define-record-type test-case |
46 | (make-test-case id num name description document result reason) |
47 | test-case? |
48 | (id test-case-id) |
49 | (num test-case-num) |
50 | (name test-case-name) |
51 | (description test-case-description) |
52 | (document test-case-document) |
53 | (result test-case-result) |
54 | (reason test-case-reason)) |
55 | |
56 | (define* (update-test-case test-case #:key |
57 | (id (test-case-id test-case)) |
58 | (num (test-case-num test-case)) |
59 | (name (test-case-name test-case)) |
60 | (description (test-case-description test-case)) |
61 | (document (test-case-document test-case)) |
62 | (result (test-case-result test-case)) |
63 | (reason (test-case-reason test-case))) |
64 | (make-test-case id num name description document result reason)) |
65 | |
66 | ;; A test driver is called at the beginning, on each test result and at the |
67 | ;; end of the tests. |
68 | (define-record-type test-driver |
69 | (make-test-driver init print finalize) |
70 | test-driver? |
71 | (init test-driver-init) ; list test-case -> () |
72 | (print test-driver-print) ; test-case -> () |
73 | (finalize test-driver-finalize)) ; list test-case -> () |
74 | |
75 | (define tap-driver |
76 | (make-test-driver |
77 | (lambda (cases) |
78 | (format #t "1..~a~%" (length cases))) |
79 | (match-lambda |
80 | (($ test-case id num name description document result reason) |
81 | (match result |
82 | ('skip |
83 | (format #t "ok ~a ~a # SKIP ~a~%" num name reason)) |
84 | ('pass |
85 | (format #t "ok ~a ~a~%" num name)) |
86 | ('fail |
87 | (format #t "not ok ~a ~a: ~a~%" num name reason)) |
88 | ('xfail |
89 | (format #t "not ok ~a ~a # TODO ~a~%" num name reason)) |
90 | ('xpass |
91 | (format #t "ok ~a ~a # TODO ~a~%" num name reason))) |
92 | (force-output))) |
93 | (const #t))) |
94 | |
95 | (define (earl-driver port) |
96 | "A driver that creates a turtle file report using the earl vocabulary. It |
97 | doesn't use any internal representation for RDF or Turtle, it only manipulates |
98 | strings." |
99 | (make-test-driver |
100 | (lambda (cases) |
101 | (format port "@prefix dc: <http://purl.org/dc/terms/> .~%") |
102 | (format port "@prefix earl: <http://www.w3.org/ns/earl#> .~%") |
103 | (format port "@prefix doap: <http://usefulinc.com/ns/doap#> .~%") |
104 | (format port "@prefix foaf: <http://xmlns.com/foaf/0.1/> .~%") |
105 | (format port "@prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#> .~%") |
106 | (format port "@prefix rdfs: <http://www.w3.org/2000/01/rdf-schema#> .~%") |
107 | (format port "@prefix xsd: <http://www.w3.org/2001/XMLSchema#> .~%") |
108 | (format port "~%") |
109 | (format port "<https://framagit.org/tyreunom/guile-jsonld> a doap:Project;~%") |
110 | (format port " dc:creator <https://lepiller.eu/#me>;~%") |
111 | (format port " doap:bug-database <https://framait.org/tyreunom/guile-jsonld/issues>;~%") |
112 | (format port " doap:created \"2020-03-29\"^^xsd:date;~%") |
113 | (format port " doap:description \"Guile implementation of the JsonLD API defined by the W3C.\"@en;~%") |
114 | (format port " doap:developer <https://lepiller.eu/#me>;~%") |
115 | (format port " doap:documenter <https://lepiller.eu/#me>;~%") |
116 | (format port " doap:homepage <https://framagit.org/tyreunom/guile-jsonld/>;~%") |
117 | (format port " doap:implements <https://www.w3.org/TR/json-ld11/>,~%") |
118 | (format port " <https://www.w3.org/TR/json-ld11-api/>;~%") |
119 | (format port " doap:license <https://www.gnu.org/licenses/gpl-3.0.html>;~%") |
120 | (format port " doap:maintainer <https://lepiller.eu/#me>;~%") |
121 | (format port " doap:name \"guile-jsonld\"^^xsd:string;~%") |
122 | (format port " doap:platform \"Guile\"^^xsd:string;~%") |
123 | (format port " doap:shortdesc \"JSON-LD support for GNU Guile.\"@en;~%") |
124 | (format port " foaf:maker <https://lepiller.eu/#me> .~%") |
125 | (format port "~%") |
126 | (format port "<https://lepiller.eu/#me> a foaf:Person;~%") |
127 | (format port " rdfs:isDefinedBy <https://lepiller.eu/>;~%") |
128 | (format port " foaf:made <https://framagit.org/tyreunom/guile-jsonld>;~%") |
129 | (format port " foaf:mbox <mailto:julien@lepiller.eu>;~%") |
130 | (format port " foaf:name \"Julien Lepiller\"^^xsd:string .~%") |
131 | (format port "~%") |
132 | (format port "<https://framagit.org/tyreunom/guile-jsonld> doap:release [~%") |
133 | (format port " doap:name \"guile-jsonld-1.0\";~%") |
134 | (format port " doap:revision \"1.0\";~%") |
135 | (format port " doap:created \"2020-03-29\"^^xsd:date;~%") |
136 | (format port "] .~%") |
137 | (format port "<> foaf:primaryTopic <https://framagit.org/tyreunom/guile-jsonld>;~%") |
138 | (format port " dc:issued \"~a\"^^xsd:dateTime;~%" |
139 | (date->string (current-date) "~4")) |
140 | (format port " foaf:maker <https://lepiller.eu/#me> .~%") |
141 | (format port "~%") |
142 | (format port "<https://lepiller.eu/#me> a earl:Assertor;~%") |
143 | (format port " foaf:title \"Implementor\" .~%") |
144 | (format port "~%") |
145 | (format #t "~a test cases for report~%" (length cases))) |
146 | (lambda (test-case) |
147 | (format port "[ a earl:Assertion;~%") |
148 | (format port " earl:assertedBy <https://lepiller.eu/#me>;~%") |
149 | (format port " earl:subject <https://framagit.org/tyreunom/guile-jsonld>;~%") |
150 | (format port " earl:test <~a>;~%" (test-case-id test-case)) |
151 | (format port " earl:result [~%") |
152 | (format port " a earl:TestResult;~%") |
153 | (format port " earl:outcome earl:~a;~%" |
154 | (match (test-case-result test-case) |
155 | ('skip "inapplicable") |
156 | ('pass "passed") |
157 | ('fail "failed") |
158 | ('xpass "cantTell") |
159 | ('xfail "untested"))) |
160 | (format port " dc:date \"~a\"^^xsd:dateTime~%" |
161 | (date->string (current-date) "~4")) |
162 | (format port " earl:mode earl:automatic ] .~%") |
163 | (format port "~%") |
164 | (format #t "Tested ~a: ~a~%" |
165 | (test-case-num test-case) (test-case-result test-case))) |
166 | (lambda _ |
167 | (close-port port)))) |
168 |