diff options
author | Ludovic Courtes <ludovic.courtes@laas.fr> | 2005-11-01 21:29:04 +0000 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2008-04-25 19:09:30 +0200 |
commit | b6368dbbb9af59e6c2df6b8cccc2651a2da8b725 (patch) | |
tree | 6b9a374a3a920d6cbe7ddfe863f00a74258a6120 /testsuite/run-vm-tests.scm | |
parent | 49edef60dc34fcdb40ba1df3b5136e88796870c0 (diff) | |
download | guile-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.scm | 36 |
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)) |