test: Use write instead of display.
[mes.git] / module / mes / test.scm
index 508e4098c7dfe54ff90f4ec5f8e9b78805ad6fbc..a066095b6bd4dd8aae9ddade4dd66de101233653 100644 (file)
@@ -1,22 +1,22 @@
 ;;; -*-scheme-*-
 
-;;; Mes --- Maxwell Equations of Software
+;;; GNU Mes --- Maxwell Equations of Software
 ;;; Copyright © 2016,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;;
-;;; This file is part of Mes.
+;;; This file is part of GNU Mes.
 ;;;
-;;; Mes is free software; you can redistribute it and/or modify it
+;;; GNU 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
+;;; GNU 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/>.
+;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 
 ;;; Code:
 
+(define-module (mes test)
+  #:use-module (ice-9 rdelim)
+  #:export (
+            pass-if
+            pass-if-equal
+            pass-if-not
+            pass-if-eq
+            pass-if-timeout
+            result
+            seq? ; deprecated
+            sequal? ; deprecated
+            ))
+
 (cond-expand
  (mes
+  (define (inexact->exact x) x)
   (define mes? #t)
   (define guile? #f)
   (define guile-2? #f)
@@ -67,9 +81,9 @@
         (display ": fail")
         (newline)
         (display "expected: ")
-        (display expect) (newline)
+        (write expect) (newline)
         (display "actual: ")
-        (display a)
+        (write a)
         (newline)
         #f)))
 
@@ -79,9 +93,9 @@
         (display ": fail")
         (newline)
         (display "expected: ")
-        (display expect) (newline)
+        (write expect) (newline)
         (display "actual: ")
-        (display a)
+        (write a)
         (newline)
         #f)))
 
   (or (eq? a expect)
       (begin
         (display ": fail") (newline)
-        (display "expected: ") (display expect) (newline)
-        (display "actual: ") (display a) (newline)
+        (display "expected: ") (write expect) (newline)
+        (display "actual: ") (write a) (newline)
+        #f)))
+
+(define (sless? a expect)
+  (or (< a expect)
+      (begin
+        (display ": fail") (newline)
+        (display "expected: ") (write expect) (newline)
+        (display "actual: ") (write a) (newline)
         #f)))
 
 (define (sequal2? actual expect)
   (or (equal? actual expect)
       (begin
         (display ": fail") (newline)
-        (display "expected: ") (display expect) (newline)
-        (display "actual: ") (display actual) (newline)
+        (display "expected: ") (write expect) (newline)
+        (display "actual: ") (write actual) (newline)
         #f)))
 
 (define-macro (pass-if name t)
    'begin
    (list display "test: ") (list display name)
    (list 'result (list not f)))) ;; FIXME
+
+(define internal-time-units-per-milli-second
+  (/ internal-time-units-per-second 1000))
+(define (test-time thunk)
+  ((lambda (start)
+     (begin
+       (thunk)
+       (inexact->exact (/ (- (get-internal-run-time) start)
+                          internal-time-units-per-milli-second))))
+   (get-internal-run-time)))
+
+(define-macro (pass-if-timeout name limit . body)
+  (list 'pass-if name (list sless? (list test-time (cons* 'lambda '_ body)) limit)))