94 lines
2.7 KiB
Scheme
94 lines
2.7 KiB
Scheme
;;; -*-scheme-*-
|
|
|
|
;;; Mes --- Maxwell Equations of Software
|
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
|
;;;
|
|
;;; 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/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;;; test.mes can be loaded after base.mes. It provides a minimalistic
|
|
;;; test framework: pass-if, pass-if-not, seq?, sequal? and result.
|
|
|
|
;;; Code:
|
|
|
|
(mes-use-module (mes base))
|
|
(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 (sequal2? expect actual)
|
|
(or (equal? expect actual)
|
|
(begin
|
|
(display ": fail") (newline)
|
|
(display "expected: ") (display expect) (newline)
|
|
(display "actual: ") (display actual) (newline)
|
|
#f)))
|
|
|
|
(define-macro (pass-if name t)
|
|
(list
|
|
'begin
|
|
(list display "test: ") (list display name)
|
|
(list result t)))
|
|
|
|
(define-macro (pass-if-equal name expect . body)
|
|
`(pass-if ,name (sequal2? ,expect (begin ,@body))))
|
|
|
|
(define-macro (expect-fail name expect . body)
|
|
`(pass-if ,name (not (sequal2? ,expect (begin ,@body)))))
|
|
|
|
(define-macro (pass-if-not name f)
|
|
(list
|
|
'begin
|
|
(list display "test: ") (list display name)
|
|
(list result (list not f))))
|