mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-02 21:10:27 +02:00
Remove "vm" tests
These tests are no longer useful. * configure.ac: * test-suite/Makefile.am: Remove mentions. * test-suite/vm/Makefile.am: * test-suite/vm/run-vm-tests.scm: * test-suite/vm/t-basic-contructs.scm: * test-suite/vm/t-call-cc.scm: * test-suite/vm/t-catch.scm: * test-suite/vm/t-closure.scm: * test-suite/vm/t-closure2.scm: * test-suite/vm/t-closure3.scm: * test-suite/vm/t-closure4.scm: * test-suite/vm/t-do-loop.scm: * test-suite/vm/t-global-bindings.scm: * test-suite/vm/t-literal-integers.scm: * test-suite/vm/t-macros.scm: * test-suite/vm/t-macros2.scm: * test-suite/vm/t-map.scm: * test-suite/vm/t-match.scm: * test-suite/vm/t-mutual-toplevel-defines.scm: * test-suite/vm/t-or.scm: * test-suite/vm/t-proc-with-setter.scm: * test-suite/vm/t-quasiquote.scm: * test-suite/vm/t-records.scm: * test-suite/vm/t-values.scm: Remove.
This commit is contained in:
Andy Wingo
parent
1c88d51c22
commit
28318cba9c
24 changed files with 2 additions and 422 deletions
|
|
@ -1436,7 +1436,6 @@ AC_CONFIG_FILES([
|
||||||
guile-readline/Makefile
|
guile-readline/Makefile
|
||||||
test-suite/Makefile
|
test-suite/Makefile
|
||||||
test-suite/standalone/Makefile
|
test-suite/standalone/Makefile
|
||||||
test-suite/vm/Makefile
|
|
||||||
meta/Makefile
|
meta/Makefile
|
||||||
bootstrap/Makefile
|
bootstrap/Makefile
|
||||||
module/Makefile
|
module/Makefile
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,6 @@
|
||||||
## Process this file with automake to produce Makefile.in.
|
## Process this file with automake to produce Makefile.in.
|
||||||
##
|
##
|
||||||
## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
|
## Copyright 2001-2019 Software Foundation, Inc.
|
||||||
## 2010, 2011, 2012, 2013, 2014 Software Foundation, Inc.
|
|
||||||
##
|
##
|
||||||
## This file is part of GUILE.
|
## This file is part of GUILE.
|
||||||
##
|
##
|
||||||
|
|
@ -20,7 +19,7 @@
|
||||||
## write to the Free Software Foundation, Inc., 51 Franklin Street,
|
## write to the Free Software Foundation, Inc., 51 Franklin Street,
|
||||||
## Fifth Floor, Boston, MA 02110-1301 USA
|
## Fifth Floor, Boston, MA 02110-1301 USA
|
||||||
|
|
||||||
SUBDIRS = standalone vm
|
SUBDIRS = standalone
|
||||||
|
|
||||||
SCM_TESTS = tests/00-initial-env.test \
|
SCM_TESTS = tests/00-initial-env.test \
|
||||||
tests/00-repl-server.test \
|
tests/00-repl-server.test \
|
||||||
|
|
|
||||||
|
|
@ -1,48 +0,0 @@
|
||||||
## 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
|
|
||||||
|
|
||||||
TESTS = \
|
|
||||||
t-basic-contructs.scm \
|
|
||||||
t-global-bindings.scm \
|
|
||||||
t-catch.scm \
|
|
||||||
t-call-cc.scm \
|
|
||||||
t-closure.scm \
|
|
||||||
t-closure2.scm \
|
|
||||||
t-closure3.scm \
|
|
||||||
t-closure4.scm \
|
|
||||||
t-do-loop.scm \
|
|
||||||
t-literal-integers.scm \
|
|
||||||
t-macros.scm \
|
|
||||||
t-macros2.scm \
|
|
||||||
t-map.scm \
|
|
||||||
t-or.scm \
|
|
||||||
t-proc-with-setter.scm \
|
|
||||||
t-quasiquote.scm \
|
|
||||||
t-values.scm \
|
|
||||||
t-records.scm \
|
|
||||||
t-match.scm \
|
|
||||||
t-mutual-toplevel-defines.scm
|
|
||||||
|
|
||||||
EXTRA_DIST = run-vm-tests.scm $(TESTS)
|
|
||||||
|
|
@ -1,91 +0,0 @@
|
||||||
;;; run-vm-tests.scm -- Run Guile-VM's test suite.
|
|
||||||
;;;
|
|
||||||
;;; Copyright 2005, 2009, 2010, 2013 Free Software Foundation, Inc.
|
|
||||||
;;;
|
|
||||||
;;; This program 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 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 Lesser General Public License for more details.
|
|
||||||
;;;
|
|
||||||
;;; You should have received a copy of the GNU Lesser 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 vm)
|
|
||||||
(system vm loader)
|
|
||||||
(system vm program)
|
|
||||||
(system base compile)
|
|
||||||
(system base language)
|
|
||||||
(srfi srfi-1)
|
|
||||||
(ice-9 r5rs))
|
|
||||||
|
|
||||||
|
|
||||||
(define (fetch-sexp-from-file file)
|
|
||||||
(with-input-from-file file
|
|
||||||
(lambda ()
|
|
||||||
(let loop ((sexp (read))
|
|
||||||
(result '()))
|
|
||||||
(if (eof-object? sexp)
|
|
||||||
(cons 'begin (reverse result))
|
|
||||||
(loop (read) (cons sexp result)))))))
|
|
||||||
|
|
||||||
(define (compile-to-objcode sexp)
|
|
||||||
"Compile the expression @var{sexp} into a VM program and return it."
|
|
||||||
(compile sexp #:from 'scheme #:to 'bytecode))
|
|
||||||
|
|
||||||
(define (run-vm-program bv)
|
|
||||||
"Run VM program contained into @var{bv}."
|
|
||||||
((load-thunk-from-memory bv)))
|
|
||||||
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
|
|
||||||
(define-macro (watch-proc proc-name str)
|
|
||||||
`(let ((orig-proc ,proc-name))
|
|
||||||
(set! ,proc-name
|
|
||||||
(lambda args
|
|
||||||
(format #t (string-append ,str "... "))
|
|
||||||
(apply orig-proc args)))))
|
|
||||||
|
|
||||||
(watch-proc fetch-sexp-from-file "reading")
|
|
||||||
(watch-proc compile-to-objcode "compiling")
|
|
||||||
(watch-proc run-vm-program "running")
|
|
||||||
|
|
||||||
|
|
||||||
;; 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 @code{equal?}."
|
|
||||||
(let* ((res (map (lambda (file)
|
|
||||||
(format #t "running `~a'... " file)
|
|
||||||
(if (catch #t
|
|
||||||
(lambda ()
|
|
||||||
(equal? (compile/run-test-from-file file)
|
|
||||||
(primitive-eval (fetch-sexp-from-file file))))
|
|
||||||
(lambda (key . args)
|
|
||||||
(format #t "[~a/~a] " key args)
|
|
||||||
#f))
|
|
||||||
(format #t "ok~%")
|
|
||||||
(begin (format #t "FAILED~%") #f)))
|
|
||||||
files))
|
|
||||||
(total (length files))
|
|
||||||
(failed (length (filter not res))))
|
|
||||||
|
|
||||||
(if (= 0 failed)
|
|
||||||
(exit 0)
|
|
||||||
(begin
|
|
||||||
(format #t "~%~a tests failed out of ~a~%"
|
|
||||||
failed total)
|
|
||||||
(exit failed)))))
|
|
||||||
|
|
||||||
|
|
@ -1,16 +0,0 @@
|
||||||
;;; Basic RnRS constructs.
|
|
||||||
|
|
||||||
(and (eq? 2 (begin (+ 2 4) 5 2))
|
|
||||||
((lambda (x y)
|
|
||||||
(and (eq? x 1) (eq? y 2)
|
|
||||||
(begin
|
|
||||||
(set! x 11) (set! y 22)
|
|
||||||
(and (eq? x 11) (eq? y 22)))))
|
|
||||||
1 2)
|
|
||||||
(let ((x 1) (y 3))
|
|
||||||
(and (eq? x 1) (eq? y 3)))
|
|
||||||
(let loop ((x #t))
|
|
||||||
(if (not x)
|
|
||||||
#t
|
|
||||||
(loop #f))))
|
|
||||||
|
|
||||||
|
|
@ -1,30 +0,0 @@
|
||||||
(let ((set-counter2 #f))
|
|
||||||
(define (get-counter2)
|
|
||||||
(call/cc
|
|
||||||
(lambda (k)
|
|
||||||
(set! set-counter2 k)
|
|
||||||
1)))
|
|
||||||
(define (loop counter1)
|
|
||||||
(let ((counter2 (get-counter2)))
|
|
||||||
(set! counter1 (1+ counter1))
|
|
||||||
(cond ((not (= counter1 counter2))
|
|
||||||
(error "bad call/cc behaviour" counter1 counter2))
|
|
||||||
((> counter1 10)
|
|
||||||
#t)
|
|
||||||
(else
|
|
||||||
(set-counter2 (1+ counter2))))))
|
|
||||||
(loop 0))
|
|
||||||
|
|
||||||
(let* ((next #f)
|
|
||||||
(counter 0)
|
|
||||||
(result (call/cc
|
|
||||||
(lambda (k)
|
|
||||||
(set! next k)
|
|
||||||
1))))
|
|
||||||
(set! counter (+ 1 counter))
|
|
||||||
(cond ((not (= counter result))
|
|
||||||
(error "bad call/cc behaviour" counter result))
|
|
||||||
((> counter 10)
|
|
||||||
#t)
|
|
||||||
(else
|
|
||||||
(next (+ 1 counter)))))
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
;; Test that nonlocal exits of the VM work.
|
|
||||||
|
|
||||||
(begin
|
|
||||||
(define (foo thunk)
|
|
||||||
(catch #t thunk (lambda args args)))
|
|
||||||
(foo
|
|
||||||
(lambda ()
|
|
||||||
(let ((a 'one))
|
|
||||||
(1+ a)))))
|
|
||||||
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
(define func
|
|
||||||
(let ((x 2))
|
|
||||||
(lambda ()
|
|
||||||
(let ((x++ (+ 1 x)))
|
|
||||||
(set! x x++)
|
|
||||||
x++))))
|
|
||||||
|
|
||||||
(list (func) (func) (func))
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
|
|
||||||
(define (uid)
|
|
||||||
(let* ((x 2)
|
|
||||||
(do-uid (lambda ()
|
|
||||||
(let ((x++ (+ 1 x)))
|
|
||||||
(set! x x++)
|
|
||||||
x++))))
|
|
||||||
(do-uid)))
|
|
||||||
|
|
||||||
(list (uid) (uid) (uid))
|
|
||||||
|
|
@ -1,7 +0,0 @@
|
||||||
(define (stuff)
|
|
||||||
(let* ((x 2)
|
|
||||||
(chbouib (lambda (z)
|
|
||||||
(+ 7 z x))))
|
|
||||||
(chbouib 77)))
|
|
||||||
|
|
||||||
(stuff)
|
|
||||||
|
|
@ -1,22 +0,0 @@
|
||||||
(define (extract-symbols exp)
|
|
||||||
(define (process x out cont)
|
|
||||||
(cond ((pair? x)
|
|
||||||
(process (car x)
|
|
||||||
out
|
|
||||||
(lambda (car-x out)
|
|
||||||
;; used to have a bug here whereby `x' was
|
|
||||||
;; modified in the self-tail-recursion to (process
|
|
||||||
;; (cdr x) ...), because we didn't allocate fresh
|
|
||||||
;; externals when doing self-tail-recursion.
|
|
||||||
(process (cdr x)
|
|
||||||
out
|
|
||||||
(lambda (cdr-x out)
|
|
||||||
(cont (cons car-x cdr-x)
|
|
||||||
out))))))
|
|
||||||
((symbol? x)
|
|
||||||
(cont x (cons x out)))
|
|
||||||
(else
|
|
||||||
(cont x out))))
|
|
||||||
(process exp '() (lambda (x out) out)))
|
|
||||||
|
|
||||||
(extract-symbols '(a b . c))
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
(let ((n+ 0))
|
|
||||||
(do ((n- 5 (1- n-))
|
|
||||||
(n+ n+ (1+ n+)))
|
|
||||||
((= n- 0))
|
|
||||||
(format #f "n- = ~a~%" n-)))
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
;; Are global bindings reachable at run-time? This relies on the
|
|
||||||
;; `object-ref' and `object-set' instructions.
|
|
||||||
|
|
||||||
(begin
|
|
||||||
|
|
||||||
(define the-binding "hello")
|
|
||||||
|
|
||||||
((lambda () the-binding))
|
|
||||||
|
|
||||||
((lambda () (set! the-binding "world")))
|
|
||||||
|
|
||||||
((lambda () the-binding)))
|
|
||||||
|
|
||||||
|
|
@ -1,5 +0,0 @@
|
||||||
;; Check whether literal integers are correctly signed.
|
|
||||||
|
|
||||||
(and (= 4294967295 (- (expt 2 32) 1)) ;; unsigned
|
|
||||||
(= -2147483648 (- (expt 2 31))) ;; signed
|
|
||||||
(= 2147483648 (expt 2 31))) ;; unsigned
|
|
||||||
|
|
@ -1,4 +0,0 @@
|
||||||
;; Are built-in macros well-expanded at compilation-time?
|
|
||||||
|
|
||||||
(false-if-exception (+ 2 2))
|
|
||||||
(read-options)
|
|
||||||
|
|
@ -1,17 +0,0 @@
|
||||||
;; Are macros well-expanded at compilation-time?
|
|
||||||
|
|
||||||
(defmacro minus-binary (a b)
|
|
||||||
`(- ,a ,b))
|
|
||||||
|
|
||||||
(define-macro (plus . args)
|
|
||||||
`(let ((res (+ ,@args)))
|
|
||||||
;;(format #t "plus -> ~a~%" res)
|
|
||||||
res))
|
|
||||||
|
|
||||||
|
|
||||||
(plus (let* ((x (minus-binary 12 7)) ;; 5
|
|
||||||
(y (minus-binary x 1))) ;; 4
|
|
||||||
(plus x y 5)) ;; 14
|
|
||||||
12 ;; 26
|
|
||||||
(expt 2 3)) ;; => 34
|
|
||||||
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
; Currently, map is a C function, so this is a way of testing that the
|
|
||||||
; VM is reentrant.
|
|
||||||
|
|
||||||
(begin
|
|
||||||
|
|
||||||
(define (square x)
|
|
||||||
(* x x))
|
|
||||||
|
|
||||||
(map (lambda (x) (square x))
|
|
||||||
'(1 2 3)))
|
|
||||||
|
|
@ -1,26 +0,0 @@
|
||||||
;;; Pattern matching with `(ice-9 match)'.
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(use-modules (ice-9 match)
|
|
||||||
(srfi srfi-9)) ;; record type (FIXME: See `t-records.scm')
|
|
||||||
|
|
||||||
(define-record-type <stuff>
|
|
||||||
(%make-stuff chbouib)
|
|
||||||
stuff?
|
|
||||||
(chbouib stuff:chbouib stuff:set-chbouib!))
|
|
||||||
|
|
||||||
(define (matches? obj)
|
|
||||||
; (format #t "matches? ~a~%" obj)
|
|
||||||
(match obj
|
|
||||||
(($ <stuff>) #t)
|
|
||||||
; (blurps #t)
|
|
||||||
("hello" #t)
|
|
||||||
(else #f)))
|
|
||||||
|
|
||||||
|
|
||||||
;(format #t "go!~%")
|
|
||||||
(and (matches? (%make-stuff 12))
|
|
||||||
(matches? (%make-stuff 7))
|
|
||||||
(matches? "hello")
|
|
||||||
; (matches? 'blurps)
|
|
||||||
(not (matches? 66)))
|
|
||||||
|
|
@ -1,8 +0,0 @@
|
||||||
(define (even? x)
|
|
||||||
(or (zero? x)
|
|
||||||
(not (odd? (1- x)))))
|
|
||||||
|
|
||||||
(define (odd? x)
|
|
||||||
(not (even? (1- x))))
|
|
||||||
|
|
||||||
(even? 20)
|
|
||||||
|
|
@ -1,29 +0,0 @@
|
||||||
;; all the different permutations of or
|
|
||||||
(list
|
|
||||||
;; not in tail position, no args
|
|
||||||
(or)
|
|
||||||
;; not in tail position, one arg
|
|
||||||
(or 'what)
|
|
||||||
(or #f)
|
|
||||||
;; not in tail position, two arg
|
|
||||||
(or 'what 'where)
|
|
||||||
(or #f 'where)
|
|
||||||
(or #f #f)
|
|
||||||
(or 'what #f)
|
|
||||||
;; not in tail position, value discarded
|
|
||||||
(begin (or 'what (error "two")) 'two)
|
|
||||||
;; in tail position (within the lambdas)
|
|
||||||
((lambda ()
|
|
||||||
(or)))
|
|
||||||
((lambda ()
|
|
||||||
(or 'what)))
|
|
||||||
((lambda ()
|
|
||||||
(or #f)))
|
|
||||||
((lambda ()
|
|
||||||
(or 'what 'where)))
|
|
||||||
((lambda ()
|
|
||||||
(or #f 'where)))
|
|
||||||
((lambda ()
|
|
||||||
(or #f #f)))
|
|
||||||
((lambda ()
|
|
||||||
(or 'what #f))))
|
|
||||||
|
|
@ -1,20 +0,0 @@
|
||||||
(define the-struct (vector 1 2))
|
|
||||||
|
|
||||||
(define get/set
|
|
||||||
(make-procedure-with-setter
|
|
||||||
(lambda (struct name)
|
|
||||||
(case name
|
|
||||||
((first) (vector-ref struct 0))
|
|
||||||
((second) (vector-ref struct 1))
|
|
||||||
(else #f)))
|
|
||||||
(lambda (struct name val)
|
|
||||||
(case name
|
|
||||||
((first) (vector-set! struct 0 val))
|
|
||||||
((second) (vector-set! struct 1 val))
|
|
||||||
(else #f)))))
|
|
||||||
|
|
||||||
(and (eq? (vector-ref the-struct 0) (get/set the-struct 'first))
|
|
||||||
(eq? (vector-ref the-struct 1) (get/set the-struct 'second))
|
|
||||||
(begin
|
|
||||||
(set! (get/set the-struct 'second) 77)
|
|
||||||
(eq? (vector-ref the-struct 1) (get/set the-struct 'second))))
|
|
||||||
|
|
@ -1,12 +0,0 @@
|
||||||
(list
|
|
||||||
`()
|
|
||||||
`foo
|
|
||||||
`(foo)
|
|
||||||
`(foo bar)
|
|
||||||
`(1 2)
|
|
||||||
(let ((x 1)) `,x)
|
|
||||||
(let ((x 1)) `(,x))
|
|
||||||
(let ((x 1)) ``(,x))
|
|
||||||
(let ((head '(a b))
|
|
||||||
(tail 'c))
|
|
||||||
`(,@head . ,tail)))
|
|
||||||
|
|
@ -1,14 +0,0 @@
|
||||||
;;; SRFI-9 Records.
|
|
||||||
;;;
|
|
||||||
|
|
||||||
(use-modules (srfi srfi-9))
|
|
||||||
|
|
||||||
(define-record-type <stuff>
|
|
||||||
(%make-stuff chbouib)
|
|
||||||
stuff?
|
|
||||||
(chbouib stuff:chbouib stuff:set-chbouib!))
|
|
||||||
|
|
||||||
|
|
||||||
(and (stuff? (%make-stuff 12))
|
|
||||||
(= 7 (stuff:chbouib (%make-stuff 7)))
|
|
||||||
(not (stuff? 12)))
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
(list (call-with-values
|
|
||||||
(lambda () (values 1 2))
|
|
||||||
(lambda (x y) (cons x y)))
|
|
||||||
|
|
||||||
;; the start-stack forces a bounce through the interpreter
|
|
||||||
(call-with-values
|
|
||||||
(lambda () (start-stack 'foo (values 1 2)))
|
|
||||||
list)
|
|
||||||
|
|
||||||
(call-with-values
|
|
||||||
(lambda () (apply values '(1)))
|
|
||||||
list))
|
|
||||||
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue