test: Add performance test.

* module/mes/test.scm (pass-if-timeout): New macro.
* tests/perform.test: New test.
* build-aux/check-mes.sh (tests): Run it.
This commit is contained in:
Jan Nieuwenhuizen 2018-10-21 12:04:25 +02:00
parent 06bf0fd6a3
commit 5d8e44de2c
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
3 changed files with 82 additions and 0 deletions

View File

@ -36,6 +36,7 @@ tests/boot.test
tests/read.test
tests/srfi-0.test
tests/macro.test
tests/perform.test
tests/base.test
tests/quasiquote.test
tests/let.test

View File

@ -26,11 +26,13 @@
;;; 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
@ -38,6 +40,7 @@
(cond-expand
(mes
(define (inexact->exact x) x)
(define mes? #t)
(define guile? #f)
(define guile-2? #f)
@ -104,6 +107,14 @@
(display "actual: ") (display a) (newline)
#f)))
(define (sless? a expect)
(or (< a expect)
(begin
(display ": fail") (newline)
(display "expected: ") (display expect) (newline)
(display "actual: ") (display a) (newline)
#f)))
(define (sequal2? actual expect)
(or (equal? actual expect)
(begin
@ -132,3 +143,16 @@
'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)))

57
tests/perform.test Executable file
View File

@ -0,0 +1,57 @@
#! /bin/sh
# -*-scheme-*-
if [ "$MES" != guile ]; then
export MES_BOOT=boot-02.scm
MES=${MES-$(dirname $0)/../src/mes}
$MES < $0
exit $?
fi
exec ${MES-mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests perform)' -s "$0" "$@"
!#
;;; -*-scheme-*-
;;; GNU Mes --- Maxwell Equations of Software
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of GNU Mes.
;;;
;;; 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.
;;;
;;; 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 GNU Mes. If not, see <http://www.gnu.org/licenses/>.
(define-module (tests boot)
#:use-module (mes mes-0)
#:use-module (mes test))
(cond-expand
(mes
(define (round x) x)
(primitive-load "module/mes/test.scm"))
(guile-2)
(guile
(use-modules (ice-9 syncase))))
(pass-if "first dummy" #t)
(pass-if-not "second dummy" #f)
(pass-if-timeout "loop 1M"
100
((lambda (loop)
(set! loop
(lambda (i)
(if (> i 0)
(loop (- i 1)))))
(loop 100000))
*unspecified*))
(result 'report 1) ; at least until we have bogomips, to fail