mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +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
|
||||
test-suite/Makefile
|
||||
test-suite/standalone/Makefile
|
||||
test-suite/vm/Makefile
|
||||
meta/Makefile
|
||||
bootstrap/Makefile
|
||||
module/Makefile
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
## Process this file with automake to produce Makefile.in.
|
||||
##
|
||||
## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
|
||||
## 2010, 2011, 2012, 2013, 2014 Software Foundation, Inc.
|
||||
## Copyright 2001-2019 Software Foundation, Inc.
|
||||
##
|
||||
## This file is part of GUILE.
|
||||
##
|
||||
|
|
@ -20,7 +19,7 @@
|
|||
## write to the Free Software Foundation, Inc., 51 Franklin Street,
|
||||
## Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
SUBDIRS = standalone vm
|
||||
SUBDIRS = standalone
|
||||
|
||||
SCM_TESTS = tests/00-initial-env.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