test-suite/tests/srfi-64.test

   1 ;;;; srfi-64.test --- Test suite for SRFI-64.  -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2014 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 3 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (test-srfi-64)
  20   #:use-module ((test-suite lib) #:select (report))
  21   #:use-module (srfi srfi-64))
  22
  23 (define (guile-test-runner)
  24   (let ((runner (test-runner-null)))
  25     (test-runner-on-test-end! runner
  26       (lambda (runner)
  27         (let* ((result-alist (test-result-alist runner))
  28                (result-kind (assq-ref result-alist 'result-kind))
  29                (test-name (list (assq-ref result-alist 'test-name))))
  30           (case result-kind
  31             ((pass)  (report 'pass     test-name))
  32             ((xpass) (report 'upass    test-name))
  33             ((skip)  (report 'untested test-name))
  34             ((fail xfail)
  35              (apply report result-kind test-name result-alist))
  36             (else #t)))))
  37     runner))
  38
  39 (test-with-runner
  40  (guile-test-runner)
  41  (primitive-load-path "tests/srfi-64-test.scm"))
  42
  43 ;;; Local Variables:
  44 ;;; eval: (put 'test-runner-on-test-end! 'scheme-indent-function 1)
  45 ;;; End: