[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/09: Remove "vm" tests
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] 03/09: Remove "vm" tests |
|
Date: |
Fri, 27 Sep 2019 17:15:54 -0400 (EDT) |
wingo pushed a commit to branch master
in repository guile.
commit 28318cba9c24aaeb22b12a0bcd7050496cd1a3c0
Author: Andy Wingo <address@hidden>
Date: Fri Sep 27 22:45:30 2019 +0200
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.
---
configure.ac | 1 -
test-suite/Makefile.am | 5 +-
test-suite/vm/Makefile.am | 48 ---------------
test-suite/vm/run-vm-tests.scm | 91 -----------------------------
test-suite/vm/t-basic-contructs.scm | 16 -----
test-suite/vm/t-call-cc.scm | 30 ----------
test-suite/vm/t-catch.scm | 10 ----
test-suite/vm/t-closure.scm | 8 ---
test-suite/vm/t-closure2.scm | 10 ----
test-suite/vm/t-closure3.scm | 7 ---
test-suite/vm/t-closure4.scm | 22 -------
test-suite/vm/t-do-loop.scm | 5 --
test-suite/vm/t-global-bindings.scm | 13 -----
test-suite/vm/t-literal-integers.scm | 5 --
test-suite/vm/t-macros.scm | 4 --
test-suite/vm/t-macros2.scm | 17 ------
test-suite/vm/t-map.scm | 10 ----
test-suite/vm/t-match.scm | 26 ---------
test-suite/vm/t-mutual-toplevel-defines.scm | 8 ---
test-suite/vm/t-or.scm | 29 ---------
test-suite/vm/t-proc-with-setter.scm | 20 -------
test-suite/vm/t-quasiquote.scm | 12 ----
test-suite/vm/t-records.scm | 14 -----
test-suite/vm/t-values.scm | 13 -----
24 files changed, 2 insertions(+), 422 deletions(-)
diff --git a/configure.ac b/configure.ac
index b43731e..bb9a928 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 e15b92a..3810197 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 0e6e974..0000000
--- 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 48674df..0000000
--- 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 53ee81d..0000000
--- 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 097f276..0000000
--- 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 9cc3e0e..0000000
--- 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 3d79197..0000000
--- 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 fd1df34..0000000
--- 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 2295a51..0000000
--- 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 6125801..0000000
--- 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 6455bcd..0000000
--- 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 c8ae369..0000000
--- 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 bf015a4..0000000
--- 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 bb44b46..0000000
--- 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 4cc2582..0000000
--- 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 76bf173..0000000
--- 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 2032fbe..0000000
--- 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 795c744..0000000
--- 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 0c581e9..0000000
--- 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 f6ffe15..0000000
--- 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 08e306c..0000000
--- 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 9aa4daa..0000000
--- 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 f4c0516..0000000
--- 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))
-
- [Guile-commits] branch master updated (714d0b9 -> 2cca091), Andy Wingo, 2019/09/27
- [Guile-commits] 01/09: Fix doc syntax error, Andy Wingo, 2019/09/27
- [Guile-commits] 05/09: (ice-9 null) also re-exports core aux syntax, Andy Wingo, 2019/09/27
- [Guile-commits] 04/09: Avoid mutating arguments to resolve-interface, Andy Wingo, 2019/09/27
- [Guile-commits] 09/09: Extend `import' to allow R7RS-style srfi references, Andy Wingo, 2019/09/27
- [Guile-commits] 08/09: (ice-9 safe-r5rs) fixes for bound aux syntax, Andy Wingo, 2019/09/27
- [Guile-commits] 02/09: Adapt ftw.test for pending test-suite changes, Andy Wingo, 2019/09/27
- [Guile-commits] 07/09: (ice-9 null) also exports aux syntax, syntax-rules, Andy Wingo, 2019/09/27
- [Guile-commits] 06/09: Deprecate passing a non-zero size to make-module, Andy Wingo, 2019/09/27
- [Guile-commits] 03/09: Remove "vm" tests,
Andy Wingo <=