diff options
Diffstat (limited to 'test-suite/tests/tree-il.test')
-rw-r--r-- | test-suite/tests/tree-il.test | 127 |
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" |