summaryrefslogtreecommitdiff
path: root/testsuite/run-vm-tests.scm
diff options
context:
space:
mode:
authorLudovic Courtes <ludovic.courtes@laas.fr>2005-11-01 21:29:04 +0000
committerLudovic Courtès <ludo@gnu.org>2008-04-25 19:09:30 +0200
commitb6368dbbb9af59e6c2df6b8cccc2651a2da8b725 (patch)
tree6b9a374a3a920d6cbe7ddfe863f00a74258a6120 /testsuite/run-vm-tests.scm
parent49edef60dc34fcdb40ba1df3b5136e88796870c0 (diff)
downloadguile-b6368dbbb9af59e6c2df6b8cccc2651a2da8b725.tar.gz
Fixed a Scheme translation bug; cleaned compilation with GCC 4.
* module/language/scheme/translate.scm (trans-pair): In the `set!' case, when a procedure-with-setter is passed, call `trans:pair' with an actual pair. This fixes a long-lasting bug which prevented compilation of `set!' statements with procedures-with-setter (this showed up when compiling `(system vm assemble)'). * module/system/base/compile.scm: Added `objcode->u8vector' to the `#:select' clause. * module/system/base/syntax.scm: Cosmetic changes. * module/system/vm/assemble.scm (preprocess): Removed debugging statements. * src/frames.c: Cosmetic changes. * src/frames.h (SCM_FRAME_SET_DYNAMIC_LINK): New. * src/objcodes.c: Use `scm_t_uint8' instead of `char' when relevant. * src/vm.c (vm_heapify_frames_1): Use `SCM_FRAME_SET_DYNAMIC_LINK ()'. * src/vm_loader.c: Added casts to mute GCC 4 warnings. * testsuite/run-vm-tests.scm (*scheme*): Renamed to `%scheme'. (run-test-from-file): Renamed to `compile/run-test-from-file'. (run-vm-tests): Run each test using both the VM and the interpreter; compare the results. * testsuite/t-proc-with-setter.scm: Try out `get/set'. * doc/Makefile.am (info_TEXINFOS): New. * doc/guile-vm.texi: Added index entries and indices. * doc/texinfo.tex: New file. git-archimport-id: lcourtes@laas.fr--2005-mobile/guile-vm--mobile--0.6--patch-5
Diffstat (limited to 'testsuite/run-vm-tests.scm')
-rw-r--r--testsuite/run-vm-tests.scm36
1 files changed, 30 insertions, 6 deletions
diff --git a/testsuite/run-vm-tests.scm b/testsuite/run-vm-tests.scm
index 24da98690..64568b171 100644
--- a/testsuite/run-vm-tests.scm
+++ b/testsuite/run-vm-tests.scm
@@ -1,14 +1,33 @@
-;;; A simple test-running script.
+;;; run-vm-tests.scm -- Run Guile-VM's test suite.
+;;;
+;;; Copyright 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;;
+;;;
+;;; This program 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 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program 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 this program; if not, write to the Free Software
+;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
(use-modules (system vm core)
(system vm disasm)
(system base compile)
(system base language)
- (srfi srfi-1))
+ (srfi srfi-1)
+ (ice-9 r5rs))
-(define *scheme* (lookup-language 'scheme))
+(define %scheme (lookup-language 'scheme))
(define (fetch-sexp-from-file file)
(with-input-from-file file
@@ -21,13 +40,13 @@
(define (compile-to-objcode sexp)
"Compile the expression @var{sexp} into a VM program and return it."
- (compile-in sexp (current-module) *scheme*))
+ (compile-in sexp (current-module) %scheme))
(define (run-vm-program objcode)
"Run VM program contained into @var{objcode}."
(vm-load (the-vm) objcode))
-(define (run-test-from-file file)
+(define (compile/run-test-from-file file)
"Run test from source file @var{file} and return a value indicating whether
it succeeded."
(run-vm-program (compile-to-objcode (fetch-sexp-from-file file))))
@@ -48,11 +67,16 @@ it succeeded."
;; The program.
(define (run-vm-tests files)
+ "For each file listed in @var{files}, load it and run it through both the
+interpreter and the VM (after having it compiled). Both results must be
+equal in the sense of @var{equal?}."
(let* ((res (map (lambda (file)
(format #t "running `~a'... " file)
(if (catch #t
(lambda ()
- (run-test-from-file file))
+ (equal? (compile/run-test-from-file file)
+ (eval (fetch-sexp-from-file file)
+ (interaction-environment))))
(lambda (key . args)
(format #t "[~a/~a] " key args)
#f))