summaryrefslogtreecommitdiff
path: root/test-suite/tests/tree-il.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/tree-il.test')
-rw-r--r--test-suite/tests/tree-il.test127
1 files changed, 115 insertions, 12 deletions
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 3fe68652a..a3023f3c2 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -1,7 +1,7 @@
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
;;;;
-;;;; Copyright (C) 2009 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010 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
@@ -69,19 +69,19 @@
(with-test-prefix "application"
(assert-tree-il->glil
(apply (toplevel foo) (const 1))
- (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call goto/args 1)))
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (const 1) (call tail-call 1)))
(assert-tree-il->glil
(begin (apply (toplevel foo) (const 1)) (void))
(program () (std-prelude 0 0 #f) (label _) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
(call drop 1) (branch br ,l2)
- (label ,l3) (mv-bind () #f) (unbind)
+ (label ,l3) (mv-bind 0 #f)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
(assert-tree-il->glil
(apply (toplevel foo) (apply (toplevel bar)))
(program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
- (call goto/args 1))))
+ (call tail-call 1))))
(with-test-prefix "conditional"
(assert-tree-il->glil
@@ -401,8 +401,7 @@
(lexical #f #f ref 0) (call return 1)
(unbind))
(lexical #t #f ref 0)
- (call vector 1)
- (call make-closure 2)
+ (call make-closure 1)
(call return 1)
(unbind))
(call return 1))))
@@ -457,12 +456,12 @@
(with-test-prefix "apply"
(assert-tree-il->glil
(apply (primitive @apply) (toplevel foo) (toplevel bar))
- (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (toplevel ref bar) (call tail-apply 2)))
(assert-tree-il->glil
(begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
(program () (std-prelude 0 0 #f) (label _)
(call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
- (call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
+ (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
@@ -471,17 +470,17 @@
(program () (std-prelude 0 0 #f) (label _)
(toplevel ref foo)
(call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
- (call goto/args 1))))
+ (call tail-call 1))))
(with-test-prefix "call/cc"
(assert-tree-il->glil
(apply (primitive @call-with-current-continuation) (toplevel foo))
- (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call goto/cc 1)))
+ (program () (std-prelude 0 0 #f) (label _) (toplevel ref foo) (call tail-call/cc 1)))
(assert-tree-il->glil
(begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
(program () (std-prelude 0 0 #f) (label _)
(call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
- (call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
+ (call drop 1) (branch br ,l2) (label ,l3) (mv-bind 0 #f)
(label ,l4)
(void) (call return 1))
(and (eq? l1 l3) (eq? l2 l4)))
@@ -491,7 +490,7 @@
(program () (std-prelude 0 0 #f) (label _)
(toplevel ref foo)
(toplevel ref bar) (call call/cc 1)
- (call goto/args 1))))
+ (call tail-call 1))))
(with-test-prefix "tree-il-fold"
@@ -555,6 +554,9 @@
(define %opts-w-unused
'(#:warnings (unused-variable)))
+(define %opts-w-unused-toplevel
+ '(#:warnings (unused-toplevel)))
+
(define %opts-w-unbound
'(#:warnings (unbound-variable)))
@@ -616,6 +618,107 @@
(compile '(lambda (x y z) #t)
#:opts %opts-w-unused))))))
+ (with-test-prefix "unused-toplevel"
+
+ (pass-if "used after definition"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define foo 2) foo")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "used before definition"
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define (bar) foo) (define foo 2) (bar)")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but public"
+ (let ((in (open-input-string
+ "(define-module (test-suite tree-il x) #:export (bar))
+ (define (bar) #t)")))
+ (null? (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but public (more)"
+ (let ((in (open-input-string
+ "(define-module (test-suite tree-il x) #:export (bar))
+ (define (bar) (baz))
+ (define (baz) (foo))
+ (define (foo) #t)")))
+ (null? (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused but define-public"
+ (null? (call-with-warnings
+ (lambda ()
+ (compile '(define-public foo 2)
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+
+ (pass-if "used by macro"
+ ;; FIXME: See comment about macros at `unused-toplevel-analysis'.
+ (throw 'unresolved)
+
+ (null? (call-with-warnings
+ (lambda ()
+ (let ((in (open-input-string
+ "(define (bar) 'foo)
+ (define-syntax baz
+ (syntax-rules () ((_) (bar))))")))
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel))))))
+
+ (pass-if "unused"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(define foo 2)
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo))))))
+
+ (pass-if "unused recursive"
+ (let ((w (call-with-warnings
+ (lambda ()
+ (compile '(define (foo) (foo))
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 1)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo))))))
+
+ (pass-if "unused mutually recursive"
+ (let* ((in (open-input-string
+ "(define (foo) (bar)) (define (bar) (foo))"))
+ (w (call-with-warnings
+ (lambda ()
+ (read-and-compile in
+ #:to 'assembly
+ #:opts %opts-w-unused-toplevel)))))
+ (and (= (length w) 2)
+ (number? (string-contains (car w)
+ (format #f "top-level variable `~A'"
+ 'foo)))
+ (number? (string-contains (cadr w)
+ (format #f "top-level variable `~A'"
+ 'bar)))))))
+
(with-test-prefix "unbound variable"
(pass-if "quiet"