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.

24 files changed, 2 insertions, 422 deletions

diff --git a/configure.ac b/configure.ac
index b43731e2e..bb9a9281f 100644
--- a/configure.ac
+++ b/configure.ac
@@ -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
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index e15b92aff..3810197e2 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -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		\
diff --git a/test-suite/vm/Makefile.am b/test-suite/vm/Makefile.am
deleted file mode 100644
index 0e6e974e2..000000000
--- a/test-suite/vm/Makefile.am
+++ /dev/null
@@ -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)
diff --git a/test-suite/vm/run-vm-tests.scm b/test-suite/vm/run-vm-tests.scm
deleted file mode 100644
index 48674df15..000000000
--- a/test-suite/vm/run-vm-tests.scm
+++ /dev/null
@@ -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)))))
-
diff --git a/test-suite/vm/t-basic-contructs.scm b/test-suite/vm/t-basic-contructs.scm
deleted file mode 100644
index 53ee81dcd..000000000
--- a/test-suite/vm/t-basic-contructs.scm
+++ /dev/null
@@ -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))))
-
diff --git a/test-suite/vm/t-call-cc.scm b/test-suite/vm/t-call-cc.scm
deleted file mode 100644
index 097f276ff..000000000
--- a/test-suite/vm/t-call-cc.scm
+++ /dev/null
@@ -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)))))
diff --git a/test-suite/vm/t-catch.scm b/test-suite/vm/t-catch.scm
deleted file mode 100644
index 9cc3e0e14..000000000
--- a/test-suite/vm/t-catch.scm
+++ /dev/null
@@ -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)))))
-       
diff --git a/test-suite/vm/t-closure.scm b/test-suite/vm/t-closure.scm
deleted file mode 100644
index 3d791979e..000000000
--- a/test-suite/vm/t-closure.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(define func
-  (let ((x 2))
-    (lambda ()
-      (let ((x++ (+ 1 x)))
-	(set! x x++)
-	x++))))
-
-(list (func) (func) (func))
diff --git a/test-suite/vm/t-closure2.scm b/test-suite/vm/t-closure2.scm
deleted file mode 100644
index fd1df34fd..000000000
--- a/test-suite/vm/t-closure2.scm
+++ /dev/null
@@ -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))
diff --git a/test-suite/vm/t-closure3.scm b/test-suite/vm/t-closure3.scm
deleted file mode 100644
index 2295a511a..000000000
--- a/test-suite/vm/t-closure3.scm
+++ /dev/null
@@ -1,7 +0,0 @@
-(define (stuff)
-  (let* ((x 2)
-	 (chbouib (lambda (z)
-		    (+ 7 z x))))
-    (chbouib 77)))
-
-(stuff)
diff --git a/test-suite/vm/t-closure4.scm b/test-suite/vm/t-closure4.scm
deleted file mode 100644
index 61258012f..000000000
--- a/test-suite/vm/t-closure4.scm
+++ /dev/null
@@ -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))
diff --git a/test-suite/vm/t-do-loop.scm b/test-suite/vm/t-do-loop.scm
deleted file mode 100644
index 6455bcdb2..000000000
--- a/test-suite/vm/t-do-loop.scm
+++ /dev/null
@@ -1,5 +0,0 @@
-(let ((n+ 0))
-  (do ((n- 5  (1- n-))
-       (n+ n+ (1+ n+)))
-      ((= n- 0))
-    (format #f "n- = ~a~%" n-)))
diff --git a/test-suite/vm/t-global-bindings.scm b/test-suite/vm/t-global-bindings.scm
deleted file mode 100644
index c8ae3692c..000000000
--- a/test-suite/vm/t-global-bindings.scm
+++ /dev/null
@@ -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)))
-
diff --git a/test-suite/vm/t-literal-integers.scm b/test-suite/vm/t-literal-integers.scm
deleted file mode 100644
index bf015a4ff..000000000
--- a/test-suite/vm/t-literal-integers.scm
+++ /dev/null
@@ -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
diff --git a/test-suite/vm/t-macros.scm b/test-suite/vm/t-macros.scm
deleted file mode 100644
index bb44b46b7..000000000
--- a/test-suite/vm/t-macros.scm
+++ /dev/null
@@ -1,4 +0,0 @@
-;; Are built-in macros well-expanded at compilation-time?
-
-(false-if-exception (+ 2 2))
-(read-options)
diff --git a/test-suite/vm/t-macros2.scm b/test-suite/vm/t-macros2.scm
deleted file mode 100644
index 4cc258278..000000000
--- a/test-suite/vm/t-macros2.scm
+++ /dev/null
@@ -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
-
diff --git a/test-suite/vm/t-map.scm b/test-suite/vm/t-map.scm
deleted file mode 100644
index 76bf1730f..000000000
--- a/test-suite/vm/t-map.scm
+++ /dev/null
@@ -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)))
diff --git a/test-suite/vm/t-match.scm b/test-suite/vm/t-match.scm
deleted file mode 100644
index 2032fbe17..000000000
--- a/test-suite/vm/t-match.scm
+++ /dev/null
@@ -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)))
diff --git a/test-suite/vm/t-mutual-toplevel-defines.scm b/test-suite/vm/t-mutual-toplevel-defines.scm
deleted file mode 100644
index 795c74423..000000000
--- a/test-suite/vm/t-mutual-toplevel-defines.scm
+++ /dev/null
@@ -1,8 +0,0 @@
-(define (even? x)
-  (or (zero? x)
-      (not (odd? (1- x)))))
-
-(define (odd? x)
-  (not (even? (1- x))))
-
-(even? 20)
diff --git a/test-suite/vm/t-or.scm b/test-suite/vm/t-or.scm
deleted file mode 100644
index 0c581e9c7..000000000
--- a/test-suite/vm/t-or.scm
+++ /dev/null
@@ -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))))
diff --git a/test-suite/vm/t-proc-with-setter.scm b/test-suite/vm/t-proc-with-setter.scm
deleted file mode 100644
index f6ffe15b0..000000000
--- a/test-suite/vm/t-proc-with-setter.scm
+++ /dev/null
@@ -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))))
diff --git a/test-suite/vm/t-quasiquote.scm b/test-suite/vm/t-quasiquote.scm
deleted file mode 100644
index 08e306c39..000000000
--- a/test-suite/vm/t-quasiquote.scm
+++ /dev/null
@@ -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)))
diff --git a/test-suite/vm/t-records.scm b/test-suite/vm/t-records.scm
deleted file mode 100644
index 9aa4daac6..000000000
--- a/test-suite/vm/t-records.scm
+++ /dev/null
@@ -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)))
diff --git a/test-suite/vm/t-values.scm b/test-suite/vm/t-values.scm
deleted file mode 100644
index f4c0516a3..000000000
--- a/test-suite/vm/t-values.scm
+++ /dev/null
@@ -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))
-