mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
Remove tests for old Tree-IL CSE module
* test-suite/tests/cse.test: Remove. * test-suite/Makefile.am:
This commit is contained in:
Andy Wingo
parent
c0c93581c4
commit
1e91d95704
2 changed files with 1 additions and 307 deletions
|
|
@ -1,7 +1,7 @@
|
||||||
## 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, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
|
||||||
## 2010, 2011, 2012, 2013 Software Foundation, Inc.
|
## 2010, 2011, 2012, 2013, 2014 Software Foundation, Inc.
|
||||||
##
|
##
|
||||||
## This file is part of GUILE.
|
## This file is part of GUILE.
|
||||||
##
|
##
|
||||||
|
|
@ -40,7 +40,6 @@ SCM_TESTS = tests/00-initial-env.test \
|
||||||
tests/continuations.test \
|
tests/continuations.test \
|
||||||
tests/coverage.test \
|
tests/coverage.test \
|
||||||
tests/cross-compilation.test \
|
tests/cross-compilation.test \
|
||||||
tests/cse.test \
|
|
||||||
tests/curried-definitions.test \
|
tests/curried-definitions.test \
|
||||||
tests/dwarf.test \
|
tests/dwarf.test \
|
||||||
tests/ecmascript.test \
|
tests/ecmascript.test \
|
||||||
|
|
|
||||||
|
|
@ -1,305 +0,0 @@
|
||||||
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
|
|
||||||
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
|
|
||||||
;;;;
|
|
||||||
;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
|
|
||||||
;;;;
|
|
||||||
;;;; This library 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 library 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 library; if not, write to the Free Software
|
|
||||||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
|
||||||
|
|
||||||
(define-module (test-suite tree-il)
|
|
||||||
#:use-module (test-suite lib)
|
|
||||||
#:use-module (system base compile)
|
|
||||||
#:use-module (system base pmatch)
|
|
||||||
#:use-module (system base message)
|
|
||||||
#:use-module (language tree-il)
|
|
||||||
#:use-module (language tree-il canonicalize)
|
|
||||||
#:use-module (language tree-il primitives)
|
|
||||||
#:use-module (language tree-il fix-letrec)
|
|
||||||
#:use-module (language tree-il cse)
|
|
||||||
#:use-module (language tree-il peval)
|
|
||||||
#:use-module (srfi srfi-13))
|
|
||||||
|
|
||||||
(define-syntax pass-if-cse
|
|
||||||
(syntax-rules ()
|
|
||||||
((_ in pat)
|
|
||||||
(pass-if 'in
|
|
||||||
(let ((evaled (unparse-tree-il
|
|
||||||
(canonicalize
|
|
||||||
(fix-letrec
|
|
||||||
(cse
|
|
||||||
(peval
|
|
||||||
(expand-primitives
|
|
||||||
(resolve-primitives
|
|
||||||
(compile 'in #:from 'scheme #:to 'tree-il)
|
|
||||||
(current-module))))))))))
|
|
||||||
(pmatch evaled
|
|
||||||
(pat #t)
|
|
||||||
(_ (pk 'cse-mismatch)
|
|
||||||
((@ (ice-9 pretty-print) pretty-print)
|
|
||||||
'in)
|
|
||||||
(newline)
|
|
||||||
((@ (ice-9 pretty-print) pretty-print)
|
|
||||||
evaled)
|
|
||||||
(newline)
|
|
||||||
((@ (ice-9 pretty-print) pretty-print)
|
|
||||||
'pat)
|
|
||||||
(newline)
|
|
||||||
#f)))))))
|
|
||||||
|
|
||||||
|
|
||||||
(with-test-prefix "cse"
|
|
||||||
|
|
||||||
;; The eq? propagates, and (if TEST #t #f) folds to TEST if TEST is
|
|
||||||
;; boolean-valued.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(and (eq? x y)
|
|
||||||
(eq? x y)))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(primcall eq? (lexical x _) (lexical y _))))))
|
|
||||||
|
|
||||||
;; The eq? propagates, and (if TEST #f #t) folds to (not TEST).
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(if (eq? x y) #f #t))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(primcall not
|
|
||||||
(primcall eq? (lexical x _) (lexical y _)))))))
|
|
||||||
|
|
||||||
;; (if TEST (not TEST) #f)
|
|
||||||
;; => (if TEST #f #f)
|
|
||||||
;; => (begin TEST #f)
|
|
||||||
;; => #f
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(and (eq? x y) (not (eq? x y))))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(const #f)))))
|
|
||||||
|
|
||||||
;; (if TEST #f TEST) => (if TEST #f #f) => ...
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(if (eq? x y) #f (eq? x y)))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(const #f)))))
|
|
||||||
|
|
||||||
;; The same, but side-effecting primitives do not propagate.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(and (set-car! x y) (not (set-car! x y))))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(if (primcall set-car!
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _))
|
|
||||||
(primcall not
|
|
||||||
(primcall set-car!
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _)))
|
|
||||||
(const #f))))))
|
|
||||||
|
|
||||||
;; Primitives that access mutable memory can propagate, as long as
|
|
||||||
;; there is no intervening mutation.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(and (string-ref x y)
|
|
||||||
(begin
|
|
||||||
(string-ref x y)
|
|
||||||
(not (string-ref x y)))))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(seq (primcall string-ref
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _))
|
|
||||||
(const #f))))))
|
|
||||||
|
|
||||||
;; However, expressions with dependencies on effects do not propagate
|
|
||||||
;; through a lambda.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(and (string-ref x y)
|
|
||||||
(lambda ()
|
|
||||||
(and (string-ref x y) #t))))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(if (primcall string-ref
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
((() #f #f #f () ())
|
|
||||||
(if (primcall string-ref
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _))
|
|
||||||
(const #t)
|
|
||||||
(const #f)))))
|
|
||||||
(const #f))))))
|
|
||||||
|
|
||||||
;; A mutation stops the propagation.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(and (string-ref x y)
|
|
||||||
(begin
|
|
||||||
(string-set! x #\!)
|
|
||||||
(not (string-ref x y)))))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(if (primcall string-ref
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _))
|
|
||||||
(seq (primcall string-set!
|
|
||||||
(lexical x _)
|
|
||||||
(const #\!))
|
|
||||||
(primcall not
|
|
||||||
(primcall string-ref
|
|
||||||
(lexical x _)
|
|
||||||
(lexical y _))))
|
|
||||||
(const #f))))))
|
|
||||||
|
|
||||||
;; Predicates are only added to the database if they are in a
|
|
||||||
;; predicate context.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(begin (eq? x y) (eq? x y)))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(primcall eq? (lexical x _) (lexical y _))))))
|
|
||||||
|
|
||||||
;; Conditional bailouts do cause primitives to be added to the DB.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(begin (unless (eq? x y) (throw 'foo)) (eq? x y)))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(seq (if (primcall eq?
|
|
||||||
(lexical x _) (lexical y _))
|
|
||||||
(void)
|
|
||||||
(primcall throw (const foo)))
|
|
||||||
(const #t))))))
|
|
||||||
|
|
||||||
;; A chain of tests in a conditional bailout add data to the DB
|
|
||||||
;; correctly.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x y)
|
|
||||||
(begin
|
|
||||||
(unless (and (struct? x) (eq? (struct-vtable x) x-vtable))
|
|
||||||
(throw 'foo))
|
|
||||||
(if (and (struct? x) (eq? (struct-vtable x) x-vtable))
|
|
||||||
(struct-ref x y)
|
|
||||||
(throw 'bar))))
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x y) #f #f #f () (_ _))
|
|
||||||
(seq
|
|
||||||
(fix (failure) (_)
|
|
||||||
((lambda _
|
|
||||||
(lambda-case
|
|
||||||
((() #f #f #f () ())
|
|
||||||
(primcall throw (const foo))))))
|
|
||||||
(if (primcall struct? (lexical x _))
|
|
||||||
(if (primcall eq?
|
|
||||||
(primcall struct-vtable (lexical x _))
|
|
||||||
(toplevel x-vtable))
|
|
||||||
(void)
|
|
||||||
(call (lexical failure _)))
|
|
||||||
(call (lexical failure _))))
|
|
||||||
(primcall struct-ref (lexical x _) (lexical y _)))))))
|
|
||||||
|
|
||||||
;; Strict argument evaluation also adds info to the DB.
|
|
||||||
(pass-if-cse
|
|
||||||
(lambda (x)
|
|
||||||
((lambda (z)
|
|
||||||
(+ z (if (and (struct? x) (eq? (struct-vtable x) x-vtable))
|
|
||||||
(struct-ref x 2)
|
|
||||||
(throw 'bar))))
|
|
||||||
(if (and (struct? x) (eq? (struct-vtable x) x-vtable))
|
|
||||||
(struct-ref x 1)
|
|
||||||
(throw 'foo))))
|
|
||||||
|
|
||||||
(lambda _
|
|
||||||
(lambda-case
|
|
||||||
(((x) #f #f #f () (_))
|
|
||||||
(let (z) (_)
|
|
||||||
((fix (failure) (_)
|
|
||||||
((lambda _
|
|
||||||
(lambda-case
|
|
||||||
((() #f #f #f () ())
|
|
||||||
(primcall throw (const foo))))))
|
|
||||||
(if (primcall struct? (lexical x _))
|
|
||||||
(if (primcall eq?
|
|
||||||
(primcall struct-vtable (lexical x _))
|
|
||||||
(toplevel x-vtable))
|
|
||||||
(primcall struct-ref (lexical x _) (const 1))
|
|
||||||
(call (lexical failure _)))
|
|
||||||
(call (lexical failure _)))))
|
|
||||||
(primcall + (lexical z _)
|
|
||||||
(primcall struct-ref (lexical x _) (const 2))))))))
|
|
||||||
|
|
||||||
;; Replacing named expressions with lexicals.
|
|
||||||
(pass-if-cse
|
|
||||||
(let ((x (car y)))
|
|
||||||
(cons x (car y)))
|
|
||||||
(let (x) (_) ((primcall car (toplevel y)))
|
|
||||||
(primcall cons (lexical x _) (lexical x _))))
|
|
||||||
|
|
||||||
;; Dominating expressions only provide predicates when evaluated in
|
|
||||||
;; test context.
|
|
||||||
(pass-if-cse
|
|
||||||
(let ((t (car x)))
|
|
||||||
(if (car x)
|
|
||||||
'one
|
|
||||||
'two))
|
|
||||||
;; Actually this one should reduce in other ways, but this is the
|
|
||||||
;; current reduction:
|
|
||||||
(seq
|
|
||||||
(primcall car (toplevel x))
|
|
||||||
(if (primcall car (toplevel x))
|
|
||||||
(const one)
|
|
||||||
(const two))))
|
|
||||||
|
|
||||||
(pass-if-cse
|
|
||||||
(begin (cons 1 2 3) 4)
|
|
||||||
(seq
|
|
||||||
(primcall cons (const 1) (const 2) (const 3))
|
|
||||||
(const 4)))
|
|
||||||
|
|
||||||
(pass-if "http://bugs.gnu.org/12883"
|
|
||||||
;; In 2.0.6, compiling this code would trigger an out-of-bounds
|
|
||||||
;; vlist access in CSE's traversal of its "database".
|
|
||||||
(procedure?
|
|
||||||
(compile '(lambda (v)
|
|
||||||
(let ((failure (lambda () (bail-out 'match))))
|
|
||||||
(if (and (pair? v)
|
|
||||||
(null? (cdr v)))
|
|
||||||
(let ((w foo)
|
|
||||||
(x (cdr w)))
|
|
||||||
(if (and (pair? x) (null? w))
|
|
||||||
#t
|
|
||||||
(failure)))
|
|
||||||
(failure))))
|
|
||||||
#:from 'scheme))))
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue