;;;; Copyright (C) 2020 Julien Lepiller ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; (define-module (test-modules result) #:use-module ((config) #:prefix config:) #:use-module (srfi srfi-9) #:use-module (srfi srfi-19) #:use-module (ice-9 match) #:export (make-test-case test-case? test-case-id test-case-num test-case-name test-case-document test-case-result test-case-reason update-test-case make-test-driver test-driver? test-driver-init test-driver-print test-driver-finalize tap-driver earl-driver)) ;; A test case is the result of running a test. It has an identifier, a name ;; and a description. Its result is a symbol, which can be 'skiped, 'pass, ;; 'fail, 'xpass, or 'xfail. The reason is a string or #f that explains the ;; result (define-record-type test-case (make-test-case id num name description document result reason) test-case? (id test-case-id) (num test-case-num) (name test-case-name) (description test-case-description) (document test-case-document) (result test-case-result) (reason test-case-reason)) (define* (update-test-case test-case #:key (id (test-case-id test-case)) (num (test-case-num test-case)) (name (test-case-name test-case)) (description (test-case-description test-case)) (document (test-case-document test-case)) (result (test-case-result test-case)) (reason (test-case-reason test-case))) (make-test-case id num name description document result reason)) ;; A test driver is called at the beginning, on each test result and at the ;; end of the tests. (define-record-type test-driver (make-test-driver init print finalize) test-driver? (init test-driver-init) ; list test-case -> () (print test-driver-print) ; test-case -> () (finalize test-driver-finalize)) ; list test-case -> () (define tap-driver (make-test-driver (lambda (cases) (format #t "1..~a~%" (length cases))) (match-lambda (($ test-case id num name description document result reason) (match result ('skip (format #t "ok ~a ~a # SKIP ~a~%" num name reason)) ('pass (format #t "ok ~a ~a~%" num name)) ('fail (format #t "not ok ~a ~a: ~a~%" num name reason)) ('xfail (format #t "not ok ~a ~a # TODO ~a~%" num name reason)) ('xpass (format #t "ok ~a ~a # TODO ~a~%" num name reason))) (force-output))) (const #t))) (define (get-date) (let* ((date (date->string (current-date) "~4")) (len (string-length date))) (string-append (substring date 0 (- len 2)) ":" (substring date (- len 2))))) (define (earl-driver port) "A driver that creates a turtle file report using the earl vocabulary. It doesn't use any internal representation for RDF or Turtle, it only manipulates strings." (make-test-driver (lambda (cases) (format port "@prefix dc: .~%") (format port "@prefix earl: .~%") (format port "@prefix doap: .~%") (format port "@prefix foaf: .~%") (format port "@prefix xsd: .~%") (format port "~%") (format port " a doap:Project;~%") (format port " dc:creator ;~%") (format port " doap:bug-database ;~%") (format port " doap:description \"Guile implementation of the JsonLD API defined by the W3C.\"@en;~%") (format port " doap:developer ;~%") (format port " doap:homepage ;~%") (format port " doap:implements ,~%") (format port " ;~%") (format port " doap:license ;~%") (format port " doap:name \"guile-jsonld\"^^xsd:string;~%") (format port " doap:programming-language \"GNU Guile\"^^xsd:string;~%") (format port " doap:shortdesc \"JSON-LD support for GNU Guile.\"@en;~%") (format port " doap:release [~%") (format port " doap:name \"guile-jsonld-~a\";~%" config:version) (format port " doap:revision \"~a\";~%" config:version) (format port " doap:created \"2020-03-29\"^^xsd:date;~%") (format port " ] .~%") (format port "~%") (format port " a earl:Assertor, foaf:Person;~%") (format port " foaf:homepage ;~%") (format port " foaf:mbox ;~%") (format port " foaf:name \"Julien Lepiller\"^^xsd:string .~%") (format port "~%") (format port "<> foaf:primaryTopic ;~%") (format port " dc:issued \"~a\"^^xsd:dateTime;~%" (get-date)) (format port " foaf:maker .~%") (format port "~%") (format #t "~a test cases for report~%" (length cases))) (lambda (test-case) (format port "[ a earl:Assertion;~%") (format port " earl:assertedBy ;~%") (format port " earl:subject ;~%") (format port " earl:test <~a>;~%" (test-case-id test-case)) (format port " earl:result [~%") (format port " a earl:TestResult;~%") (format port " earl:outcome earl:~a;~%" (match (test-case-result test-case) ('skip "inapplicable") ('pass "passed") ('fail "failed") ('xpass "cantTell") ('xfail "untested"))) (format port " dc:date \"~a\"^^xsd:dateTime ] ;~%" (get-date)) (format port " earl:mode earl:automatic ] .~%") (format port "~%") (format #t "Tested ~a: ~a~%" (test-case-num test-case) (test-case-result test-case))) (lambda _ (close-port port))))