diff options
Diffstat (limited to 'test-suite')
| -rw-r--r-- | test-suite/tests/tree-il.test | 84 |
1 files changed, 83 insertions, 1 deletions
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test index d52a642aa..bba2f6fe7 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-2014 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2014, 2018 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 @@ -24,6 +24,8 @@ #:use-module (system base message) #:use-module (language tree-il) #:use-module (language tree-il primitives) + #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (srfi srfi-13)) (define-syntax-rule (pass-if-primitives-resolved in expected) @@ -218,6 +220,9 @@ (define %opts-w-unused-toplevel '(#:warnings (unused-toplevel))) +(define %opts-w-shadowed-toplevel + '(#:warnings (shadowed-toplevel))) + (define %opts-w-unbound '(#:warnings (unbound-variable))) @@ -406,6 +411,83 @@ #:to 'cps #:opts %opts-w-unused-toplevel)))))) + (with-test-prefix "shadowed-toplevel" + + (pass-if "quiet" + (null? (call-with-warnings + (lambda () + (let ((in (open-input-string + "(define foo 2) (define bar 3)"))) + (read-and-compile in + #:to 'cps + #:opts + %opts-w-shadowed-toplevel)))))) + + (pass-if "internal define" + (null? (call-with-warnings + (lambda () + (let ((in (open-input-string + "(define foo 2) + (define (bar x) (define foo (+ x 2)) (* foo x))"))) + (read-and-compile in + #:to 'cps + #:opts + %opts-w-shadowed-toplevel)))))) + + (pass-if "one shadowing definition" + (match (call-with-warnings + (lambda () + (let ((in (open-input-string + "(define foo 2)\n (define foo 3)"))) + (read-and-compile in + #:to 'cps + #:opts + %opts-w-shadowed-toplevel)))) + ((message) + (->bool (string-match ":2:2:.*previous.*foo.*:1:0" message))))) + + (pass-if "two shadowing definitions" + (match (call-with-warnings + (lambda () + (let ((in (open-input-string + "(define-public foo 2)\n(define foo 3) + (define (foo x) x)"))) + (read-and-compile in + #:to 'cps + #:opts + %opts-w-shadowed-toplevel)))) + ((message1 message2) + (->bool + (and (string-match ":2:0:.*previous.*foo.*:1:0" message1) + (string-match ":3:2:.*previous.*foo.*:1:0" message2)))))) + + (pass-if "define-public" + (match (call-with-warnings + (lambda () + (let ((in (open-input-string + "(define foo 2)\n(define-public foo 3)"))) + (read-and-compile in + #:to 'cps + #:opts + %opts-w-shadowed-toplevel)))) + ((message) + (->bool (string-match ":2:0:.*previous.*foo.*:1:0" message))))) + + (pass-if "macro" + (match (call-with-warnings + (lambda () + (let ((in (open-input-string + "(define foo 42) + (define-syntax-rule (defun proc (args ...) body ...) + (define (proc args ...) body ...)) + (defun foo (a b c) (+ a b c))"))) + (read-and-compile in + #:to 'cps + #:opts + %opts-w-shadowed-toplevel)))) + ((message) + (->bool (string-match ":4:2:.*previous.*foo.*:1:0" message)))))) + (with-test-prefix "unbound variable" (pass-if "quiet" |