mes/lib/test.mes
2016-07-25 14:39:56 +02:00

72 lines
2.1 KiB
Scheme

;;; -*-scheme-*-
;;; Mes --- Maxwell Equations of Software
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
;;;
;;; test.mes: This file is part of Mes.
;;;
;;; Mes is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; Mes 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 General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define guile? (not (pair? (current-module))))
(define result
(let ((pass 0)
(fail 0))
(lambda (. t)
(cond ((or (null? t) (eq? (car t) result)) (list pass fail))
((eq? (car t) 'report)
(newline)
(display "passed: ") (display pass) (newline)
(display "failed: ") (display fail) (newline)
(display "total: ") (display (+ pass fail)) (newline)
(exit fail))
((car t) (display ": pass") (newline) (set! pass (+ pass 1)))
(#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
(define (seq? a b)
(or (eq? a b)
(begin
(display ": fail")
(newline)
(display "expected: ")
(display b) (newline)
(display "actual: ")
(display a)
(newline)
#f)))
(define (sequal? a b)
(or (equal? a b)
(begin
(display ": fail")
(newline)
(display "expected: ")
(display b) (newline)
(display "actual: ")
(display a)
(newline)
#f)))
(define-macro (pass-if name t)
(list
'begin
(list display "test: ") (list display name)
(list result t)))
(define-macro (pass-if-not name f)
(list
'begin
(list display "test: ") (list display name)
(list result (list not f))))