mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
Clean up `test-suite/vm'.
* test-suite/vm/Makefile.am: Add copyright/license header. * test-suite/vm/the-bug.txt: Remove.
This commit is contained in:
parent
aa592f96b0
commit
cad5d93535
2 changed files with 21 additions and 95 deletions
|
@ -1,3 +1,24 @@
|
|||
## Process this file with automake to produce Makefile.in.
|
||||
##
|
||||
## Copyright 2005, 2006, 2008, 2009, 2010 Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
## GUILE is free software; you can redistribute it and/or modify it
|
||||
## under the terms of the GNU Lesser General Public License as
|
||||
## published by the Free Software Foundation; either version 3, or
|
||||
## (at your option) any later version.
|
||||
##
|
||||
## GUILE 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 Lesser General Public License for more details.
|
||||
##
|
||||
## You should have received a copy of the GNU Lesser General Public
|
||||
## License along with GUILE; see the file COPYING.LESSER. If not,
|
||||
## write to the Free Software Foundation, Inc., 51 Franklin Street,
|
||||
## Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
TESTS_ENVIRONMENT = \
|
||||
$(top_builddir)/meta/guile \
|
||||
-l $(srcdir)/run-vm-tests.scm -e run-vm-tests
|
||||
|
|
|
@ -1,95 +0,0 @@
|
|||
-*- Outline -*-
|
||||
|
||||
Once (system vm assemble) is compiled, things start to fail in
|
||||
unpredictable ways.
|
||||
|
||||
* `compile-file' of non-closure-using programs works
|
||||
|
||||
$ guile-disasm t-records.go > t-records.ref.asm
|
||||
...
|
||||
$ diff -uBb t-macros.*.asm
|
||||
$ diff -uBb t-records.*.asm
|
||||
$ diff -uBb t-global-bindings.*.asm
|
||||
|
||||
* `compile-file' of closure-using programs fails
|
||||
|
||||
ERROR: During compiling t-closure.scm:
|
||||
ERROR: VM: Wrong type to apply: #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) [IP offset: 28]
|
||||
|
||||
guile> (vm-debugger (the-vm))
|
||||
debug> bt
|
||||
#1 #<variable 30b12468 value: (#(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 0) (nexts . 1))) (#(<glil-const> 2) #(<glil-bind> ((x external 0))) #(<glil-external> set 0 0) #(<glil-asm> #(<glil-vars> ((nargs . 0) (nrest . 0) (nlocs . 1) (nexts . 0))) (#(<glil-module> ref #f +) #(<glil-const> 1) #(<glil-external> ref 1 0) #(<glil-call> call 2) #(<glil-source> (2 . 15)) #(<glil-bind> ((x++ local 0))) #(<glil-local> set 0) #(<glil-local> ref 0) #(<glil-external> set 1 0) #(<glil-local> ref 0) #(<glil-call> return 0) #(<glil-unbind>))) #(<glil-call> return 0) #(<glil-unbind>))) #<directory (guile-user) 100742d0> ())>
|
||||
#2 (#<program 30ae74b8> #(<glil-vars> ...) (#(<glil-const> ...) #(<glil-bind> ...) ...))
|
||||
#3 (#<program 30af7090>)
|
||||
#4 (#<program 30af94c0> #(<glil-vars> ...) (#(<glil-module> ...) #(<glil-const> ...) ...))
|
||||
#5 (#<program 30b00108>)
|
||||
#6 (#<program 30b02590> ref ...)
|
||||
#7 (_l 1 #(<venv> ...))
|
||||
guile> (vm-debugger (the-vm))
|
||||
debug> stack
|
||||
(#t closure? #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) #<procedure #f (struct name val)> #<primitive-generic map> #<primitive-generic map> #<program 30998470>)
|
||||
|
||||
* Compiling anything "by hand" fails
|
||||
|
||||
** Example 1: the read/compile/run loop
|
||||
|
||||
guile> (set! %load-path (cons "/home/ludo/src/guile-vm/module" %load-path))
|
||||
guile> (use-modules (system vm assemble)(system vm core)(system repl repl))
|
||||
guile> (start-repl 'scheme)
|
||||
Guile Scheme interpreter 0.5 on Guile 1.7.2
|
||||
Copyright (C) 2001 Free Software Foundation, Inc.
|
||||
|
||||
Enter `,help' for help.
|
||||
scheme@guile-user> (use-modules (ice-9 match)
|
||||
(system base syntax)
|
||||
(system vm assemble))
|
||||
|
||||
(define (%preprocess x e)
|
||||
(match x
|
||||
(($ <glil-asm> vars body)
|
||||
(let* ((venv (<venv> :parent e :nexts (slot vars 'nexts) :closure? #f))
|
||||
(body (map (lambda (x) (preprocess x venv)) body)))
|
||||
(<vm-asm> :venv venv :glil x :body body)))
|
||||
(($ <glil-external> op depth index)
|
||||
(do ((d depth (1- d))
|
||||
(e e (slot e 'parent)))
|
||||
((= d 0))
|
||||
(set! (slot e 'closure?) #t))
|
||||
x)
|
||||
(else x)))
|
||||
|
||||
scheme@guile-user> preprocess
|
||||
#<procedure preprocess (x e)>
|
||||
scheme@guile-user> (getpid)
|
||||
470
|
||||
scheme@guile-user> (set! preprocess %preprocess)
|
||||
scheme@guile-user> preprocess
|
||||
ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
|
||||
scheme@guile-user> getpid
|
||||
ERROR: VM: Unbound variable: #<variable 30a0d5e0 value: #<undefined>>
|
||||
scheme@guile-user>
|
||||
|
||||
|
||||
** Example 2: the test suite (which also reads/compiles/runs)
|
||||
|
||||
All the closure-using tests fail.
|
||||
|
||||
ludo@lully:~/src/guile-vm/testsuite $ make check
|
||||
../src/guile-vm -L ../module \
|
||||
-l run-vm-tests.scm -e run-vm-tests \
|
||||
t-global-bindings.scm t-closure.scm t-closure2.scm t-closure3.scm t-do-loop.scm t-macros.scm t-proc-with-setter.scm t-values.scm t-records.scm t-match.scm
|
||||
|
||||
running `t-global-bindings.scm'... reading... compiling... running... ok
|
||||
running `t-closure.scm'... reading... compiling... [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
|
||||
running `t-closure2.scm'... reading... compiling... [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
|
||||
running `t-closure3.scm'... reading... compiling... [vm-error/(vm-run VM: Wrong ype to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 0) (closure? . #f)))) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
|
||||
running `t-do-loop.scm'... reading... compiling... [vm-error/(vm-run VM: Wrong type to apply: ~S [IP offset: ~a] (#(<venv> ((parent . #(<venv> ((parent . #f) (nexts . 1) (closure? . #f)))) (nexts . 0) (closure? . #f))) 28))] FAILED
|
||||
running `t-macros.scm'... reading... compiling... running... ok
|
||||
running `t-proc-with-setter.scm'... reading... compiling... running... ok
|
||||
running `t-values.scm'... reading... compiling... running... ok
|
||||
running `t-records.scm'... reading... compiling... running... ok
|
||||
running `t-match.scm'... reading... compiling... running... ok
|
||||
|
||||
4 tests failed out of 10
|
||||
make: *** [check] Error 4
|
||||
|
Loading…
Add table
Add a link
Reference in a new issue