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

Add -Wunused-module.

Browse source 
* module/language/tree-il/analyze.scm (<module-info>): New record type.
(unused-module-analysis): New variable.
(make-unused-module-analysis): New analysis.
(make-analyzer): Add it.
* module/system/base/message.scm (%warning-types): Add 'unused-module'.
* test-suite/tests/tree-il.test (%opts-w-unused-module): New variable.
("warnings")["unused-module"]: New test prefix.
* NEWS: Update.
This commit is contained in:
Ludovic Courtès 2023-02-11 23:33:37 +01:00
parent 821e0f9cd5
commit 89c3bae3cf
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
4 changed files with 336 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

17
NEWS
View file

@ -4,6 +4,23 @@ See the end for copying conditions.
Please send Guile bug reports to bug-guile@gnu.org.
Changes in 3.0.10 (since 3.0.9)
* New interfaces and functionality
** New warning: unused-module
This analysis, enabled at `-W2', issues warnings for modules that appear
in a `use-modules' form or as a #:use-module clause of `define-module',
and whose bindings are unused. This is useful to trim the list of
imports of a module.
In some cases, the compiler cannot conclude whether a module is
definitely unused---this is notably the case for modules that are only
used at macro-expansion time, such as (srfi srfi-26). In those cases,
the compiler reports it as "possibly unused".
Changes in 3.0.9 (since 3.0.8)

154
module/language/tree-il/analyze.scm
View file

@ -1,6 +1,6 @@
;;; Diagnostic warnings for Tree-IL
;; Copyright (C) 2001,2008-2014,2016,2018-2022 Free Software Foundation, Inc.
;; Copyright (C) 2001,2008-2014,2016,2018-2023 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
@ -334,6 +334,155 @@ given `tree-il' element."
(make-reference-graph vlist-null vlist-null #f))))
;;;
;;; Unused module analysis.
;;;
;; Module uses and references to bindings of imported modules.
(define-record-type <module-info>
(module-info location qualified-references
toplevel-references toplevel-definitions)
module-info?
(location module-info-location) ;location vector | #f
(qualified-references module-info-qualified-references) ;module name vhash
(toplevel-references module-info-toplevel-references) ;list of symbols
(toplevel-definitions module-info-toplevel-definitions)) ;symbol vhash
(define unused-module-analysis
;; Report unused modules in the given tree.
(make-tree-analysis
(lambda (x info env locs)
;; Going down into X: extend INFO accordingly.
(match x
((or ($ <module-ref> loc module name)
($ <module-set> loc module name))
(let ((references (module-info-qualified-references info)))
(if (vhash-assoc module references)
info
(module-info (module-info-location info)
(vhash-cons module #t references)
(module-info-toplevel-references info)
(module-info-toplevel-definitions info)))))
((or ($ <toplevel-ref> loc module name)
($ <toplevel-set> loc module name))
(if (equal? module (module-name env))
(let ((references (module-info-toplevel-references info)))
(module-info (module-info-location info)
(module-info-qualified-references info)
(cons x references)
(module-info-toplevel-definitions info)))
(let ((references (module-info-qualified-references info)))
(module-info (module-info-location info)
(vhash-cons module #t references)
(module-info-toplevel-references info)
(module-info-toplevel-definitions info)))))
(($ <toplevel-define> loc module name)
(module-info (module-info-location info)
(module-info-qualified-references info)
(module-info-toplevel-references info)
(vhash-consq name x
(module-info-toplevel-definitions info))))
;; Record the approximate location of the module import. We
;; could parse the #:imports arguments to determine the location
;; of each #:use-module but we'll leave that as an exercise for
;; the reader.
(($ <call> loc ($ <module-ref> _ '(guile) 'define-module*))
(module-info loc
(module-info-qualified-references info)
(module-info-toplevel-references info)
(module-info-toplevel-definitions info)))
(($ <call> loc ($ <module-ref> _ '(guile) 'process-use-modules))
(module-info loc
(module-info-qualified-references info)
(module-info-toplevel-references info)
(module-info-toplevel-definitions info)))
(_
info)))
(lambda (x info env locs) ;leaving X's scope
info)
(lambda (info env) ;finishing
(define (defining-module ref env)
;; Return the name of the module that defines REF, a
;; <toplevel-ref> or <toplevel-set>, in ENV.
(let ((name (if (toplevel-ref? ref)
(toplevel-ref-name ref)
(toplevel-set-name ref))))
(match (vhash-assq name (module-info-toplevel-definitions info))
(#f
;; NAME is not among the top-level definitions of this
;; compilation unit, so check which module provides it.
(and=> (module-variable env name)
(lambda (variable)
(and=> (find (lambda (module)
(module-reverse-lookup module variable))
(module-uses env))
module-name))))
(_
(if (toplevel-ref? ref)
(toplevel-ref-mod ref)
(toplevel-set-mod ref))))))
(define (module-bindings-reexported? module env)
;; Return true if ENV reexports one or more bindings from MODULE.
(let ((module (resolve-interface module))
(tag (make-prompt-tag)))
(call-with-prompt tag
(lambda ()
(module-for-each (lambda (symbol variable)
(when (module-reverse-lookup module variable)
(abort-to-prompt tag)))
(module-public-interface env))
#f)
(const #t))))
(define (module-exports-macros? module)
;; Return #t if MODULE exports one or more macros.
(let ((tag (make-prompt-tag)))
(call-with-prompt tag
(lambda ()
(module-for-each (lambda (symbol variable)
(when (and (variable-bound? variable)
(macro?
(variable-ref variable)))
(abort-to-prompt tag)))
module)
#f)
(const #t))))
(let ((used-modules ;list of modules actually used
(fold (lambda (reference modules)
(let ((module (defining-module reference env)))
(if (or (not module) (vhash-assoc module modules))
modules
(vhash-cons module #t modules))))
(module-info-qualified-references info)
(module-info-toplevel-references info))))
;; Compare the modules imported by ENV with USED-MODULES, the
;; list of modules actually referenced. When a module is not in
;; USED-MODULES, check whether ENV reexports bindings from it.
(for-each (lambda (module)
(unless (or (vhash-assoc (module-name module)
used-modules)
(module-bindings-reexported?
(module-name module) env))
;; If MODULE exports macros, and if the expansion
;; of those macros doesn't contain <module-ref>s
;; inside MODULE, then we cannot conclude whether
;; or not MODULE is used.
(warning 'unused-module
(module-info-location info)
(module-name module)
(not (module-exports-macros? module)))))
(module-uses env))))
(module-info #f vlist-null '() vlist-null)))
;;;
;;; Shadowed top-level definition analysis.
@ -1268,6 +1417,8 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
#:level 3 #:kind unused-variable #:analysis unused-variable-analysis)
(define-analysis make-unused-toplevel-analysis
#:level 2 #:kind unused-toplevel #:analysis unused-toplevel-analysis)
(define-analysis make-unused-module-analysis
#:level 2 #:kind unused-module #:analysis unused-module-analysis)
(define-analysis make-shadowed-toplevel-analysis
#:level 2 #:kind shadowed-toplevel #:analysis shadowed-toplevel-analysis)
(define-analysis make-arity-analysis
@ -1287,6 +1438,7 @@ resort, return #t when EXP refers to the global variable SPECIAL-NAME."
(analysis (cons analysis tail)))))))
(let ((analyses (compute-analyses make-unused-variable-analysis
make-unused-toplevel-analysis
make-unused-module-analysis
make-shadowed-toplevel-analysis
make-arity-analysis
make-format-analysis

11
module/system/base/message.scm
View file

@ -1,6 +1,6 @@
;;; User interface messages
;; Copyright (C) 2009-2012,2016,2018,2020-2021 Free Software Foundation, Inc.
;; Copyright (C) 2009-2012,2016,2018,2020-2021,2023 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
@ -115,6 +115,15 @@
(emit port "~A: warning: possibly unused local top-level variable `~A'~%"
loc name)))
(unused-module
"report unused modules"
,(lambda (port loc name definitely-unused?)
(if definitely-unused?
(emit port "~A: warning: unused module ~a~%"
loc name)
(emit port "~A: warning: possibly unused module ~a~%"
loc name))))
(shadowed-toplevel
"report shadowed top-level variables"
,(lambda (port loc name previous-loc)

157
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,2018-2021 Free Software Foundation, Inc.
;;;; Copyright (C) 2009-2014,2018-2021,2023 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
@ -217,6 +217,9 @@
(define %opts-w-unused-toplevel
'(#:warnings (unused-toplevel)))
(define %opts-w-unused-module
'(#:warnings (unused-module)))
(define %opts-w-shadowed-toplevel
'(#:warnings (shadowed-toplevel)))
@ -414,6 +417,158 @@
#:to 'cps
#:opts %opts-w-unused-toplevel))))))
(with-test-prefix "unused-module"
(pass-if-equal "quiet"
'()
(call-with-warnings
(lambda ()
(compile '(begin
(use-modules (ice-9 popen))
(define (proc cmd)
(open-input-pipe cmd)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module))))
(pass-if-equal "quiet, renamer"
'()
(call-with-warnings
(lambda ()
(compile '(begin
(use-modules ((ice-9 popen) #:prefix p-))
(define (proc cmd)
(p-open-input-pipe cmd)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module))))
(pass-if "definitely unused"
(let* ((defmod '(define-module (foo)
#:use-module (ice-9 vlist)
#:use-module (ice-9 popen)
#:export (proc)))
(w (call-with-warnings
(lambda ()
(set-source-properties! defmod
'((filename . "foo.scm")
(line . 0)
(column . 0)))
(compile `(begin
,defmod
(define (frob x)
(vlist-cons x vlist-null)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module)))))
(and (= (length w) 1)
(string-prefix? "foo.scm:1:0" (car w))
(number? (string-contains (car w)
"unused module (ice-9 popen)")))))
(pass-if "definitely unused, use-modules"
(let* ((usemod '(use-modules (rnrs bytevectors)
(ice-9 q)))
(w (call-with-warnings
(lambda ()
(set-source-properties! usemod
'((filename . "bar.scm")
(line . 5)
(column . 0)))
(compile `(begin
,usemod
(define (square x)
(* x x)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module)))))
(and (= (length w) 2)
(string-prefix? "bar.scm:6:0" (car w))
(number? (string-contains (car w)
"unused module (rnrs bytevectors)"))
(number? (string-contains (cadr w)
"unused module (ice-9 q)")))))
(pass-if "definitely unused, local binding shadows imported one"
(let ((w (call-with-warnings
(lambda ()
(compile `(begin
(define-module (whatever x y z)
#:use-module (ice-9 popen)
#:export (frob))
(define (open-input-pipe x)
;; Shadows the one from (ice-9 popen).
x)
(define (frob y)
(close-port (open-input-pipe y))))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"unused module (ice-9 popen)")))))
(pass-if-equal "(ice-9 match) is actually used"
'()
;; (ice-9 match) is used and the macro expansion of the 'match'
;; form refers to (@@ (ice-9 match) car) and the likes.
(call-with-warnings
(lambda ()
(compile '(begin
(use-modules (ice-9 match))
(define (proc lst)
(match lst
((a b c) (+ a (* b c))))))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module))))
(pass-if-equal "re-exporting is using"
'()
;; This module re-exports a binding from (ice-9 q), so (ice-9 q)
;; should be considered as used.
(call-with-warnings
(lambda ()
(compile '(begin
(define-module (this is an ice-9 q user)
#:use-module (ice-9 q)
#:re-export (make-q)
#:export (proc))
(define (proc a b)
(* a b)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module))))
(pass-if "(srfi srfi-26) might be unused"
;; At the tree-il level, it is impossible to know whether (srfi
;; srfi-26) is actually use, because all we see is the output of
;; macro expansion, and in this case it doesn't capture any
;; binding from (srfi srfi-26).
(let* ((w (call-with-warnings
(lambda ()
(compile `(begin
(define-module (whatever)
#:use-module (srfi srfi-26)
#:export (square))
(define double
(cut * 2 <>)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module)))))
(and (= (length w) 1)
(number? (string-contains (car w)
"possibly unused module (srfi srfi-26)")))))
(pass-if-equal "(ice-9 format) is actually used"
'()
;; The 'format' binding of (ice-9 format) takes precedence over
;; (@@ (guile) format), so (ice-9 format) must not be reported as
;; unused.
(call-with-warnings
(lambda ()
(compile '(begin
(define-module (whatever-else)
#:use-module (ice-9 format)
#:export (proc))
(define (proc lst)
(format #f "~{~a ~}~%" lst)))
#:env (make-fresh-user-module)
#:opts %opts-w-unused-module)))))
(with-test-prefix "shadowed-toplevel"
(pass-if "quiet"