mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 04:40:29 +02:00
Code Activity

Add -Wshadowed-toplevel.

Browse source 
* module/language/tree-il/analyze.scm (shadowed-toplevel-analysis): New
variable.
* module/language/tree-il/compile-cps.scm (%warning-passes): Add it.
* module/system/base/message.scm (%warning-types): Add it.
* test-suite/tests/tree-il.test ("warnings")["shadowed-toplevel"]: New
test prefix.
* module/ice-9/boot-9.scm (%auto-compilation-options): Add it.
* doc/ref/api-evaluation.texi (Compilation): Add 'shadowed-toplevel' and
'macro-use-before-definition'.
This commit is contained in:
Ludovic Courtès 2018-07-24 11:53:02 +02:00
parent 741c45458d
commit bdcd0ba8a7
6 changed files with 131 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

84
test-suite/tests/tree-il.test
View file

@ -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"