;;; Dezyne --- Dezyne command line tools
;;; Copyright © 2017 Timothy Sample <samplet@ngyro.com>
;;; Copyright © 2019 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Dezyne.
;;;
;;; Dezyne is free software: you can redistribute it and/or modify it
;;; under the terms of the GNU Affero General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; Dezyne 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
;;; Affero General Public License for more details.
;;;
;;; You should have received a copy of the GNU Affero General Public
;;; License along with Dezyne.  If not, see <http://www.gnu.org/licenses/>.
;;;
;;; Commentary:
;;;
;;; This module sets up the SRFI 64 test system so that it plays well
;;; with automake's test system.
;;;
;;; Code:

(define-module (test dzn automake)
  #:use-module (srfi srfi-64))

(test-runner-factory
 (lambda ()
   (let ((runner (test-runner-simple)))
     (test-runner-aux-value! runner (current-output-port))
     (test-runner-on-group-begin! runner
       (lambda (runner suite-name count)
         (let ((log (test-runner-aux-value runner)))
           (when (output-port? log)
             (when (null? (test-runner-group-stack runner))
               (display "%%%% Starting test " log)
               (display suite-name log)
               (newline log))
             (display "Group begin: " log)
             (display suite-name log)
             (newline log)))))
     (test-runner-on-final! runner
       (lambda (runner)
         (let ((log (test-runner-aux-value runner)))
           (when (output-port? log)
             (for-each (lambda (value-label-pair)
                         (when (> (car value-label-pair) 0)
                           (display (cdr value-label-pair) log)
                           (display (car value-label-pair) log)
                           (newline log)))
                       `((,(test-runner-pass-count runner)
                          . "# of expected passes      ")
                         (,(test-runner-xfail-count runner)
                          . "# of expected failures    ")
                         (,(test-runner-xpass-count runner)
                          . "# of unexpected successes ")
                         (,(test-runner-fail-count runner)
                          . "# of unexpected failures  ")
                         (,(test-runner-skip-count runner)
                          . "# of skipped tests        "))))
           (when (or (> (test-runner-fail-count runner) 0)
                     (> (test-runner-xpass-count runner) 0))
             (exit EXIT_FAILURE)))))
     runner)))
