mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 14:00:21 +02:00
Have `-Wunbound-variable' account for GOOPS top-level definitions.
* module/language/tree-il/analyze.scm (goops-toplevel-definition): New procedure. (report-possibly-unbound-variables): Check for GOOPS top-level definitions. * test-suite/tests/tree-il.test ("warnings")["GOOPS definitions are visible"]: New test.
This commit is contained in:
parent
60c8ad9ea3
commit
b6d2306d40
2 changed files with 43 additions and 0 deletions
|
@ -633,6 +633,23 @@
|
|||
(defs toplevel-info-defs) ;; (VARIABLE-NAME ...)
|
||||
(locs toplevel-info-locs)) ;; (LOCATION ...)
|
||||
|
||||
(define (goops-toplevel-definition proc args)
|
||||
;; If application of PROC to ARGS is a GOOPS top-level definition, return
|
||||
;; the name of the variable being defined; otherwise return #f. This
|
||||
;; assumes knowledge of the current implementation of `define-class' et al.
|
||||
(record-case proc
|
||||
((<module-ref> mod public? name)
|
||||
(and (equal? mod '(oop goops))
|
||||
(not public?)
|
||||
(eq? name 'toplevel-define!)
|
||||
(pair? args) (pair? (cdr args)) (null? (cddr args))
|
||||
(record-case (car args)
|
||||
((<const> exp)
|
||||
(and (symbol? exp)
|
||||
exp))
|
||||
(else #f))))
|
||||
(else #f)))
|
||||
|
||||
;; TODO: Combine with `report-unused-variables' so we don't traverse the tree
|
||||
;; once for each warning type.
|
||||
|
||||
|
@ -682,6 +699,17 @@
|
|||
(make-toplevel-info (alist-delete name refs eq?)
|
||||
(cons name defs)
|
||||
locs))
|
||||
|
||||
((<application> proc args)
|
||||
;; Check for a dynamic top-level definition, as is
|
||||
;; done by code expanded from GOOPS macros.
|
||||
(let ((name (goops-toplevel-definition proc args)))
|
||||
(if (symbol? name)
|
||||
(make-toplevel-info (alist-delete name refs
|
||||
eq?)
|
||||
(cons name defs)
|
||||
locs)
|
||||
(make-toplevel-info refs defs locs))))
|
||||
(else
|
||||
(make-toplevel-info refs defs locs)))))
|
||||
|
||||
|
|
|
@ -649,6 +649,21 @@
|
|||
"(define (f)
|
||||
(set! chbouib 3))
|
||||
(define chbouib 5)")))
|
||||
(read-and-compile in
|
||||
#:env m
|
||||
#:opts %opts-w-unbound)))))))
|
||||
|
||||
(pass-if "GOOPS definitions are visible"
|
||||
(let ((m (make-module))
|
||||
(v (gensym)))
|
||||
(beautify-user-module! m)
|
||||
(module-use! m (resolve-interface '(oop goops)))
|
||||
(null? (call-with-warnings
|
||||
(lambda ()
|
||||
(let ((in (open-input-string
|
||||
"(define-class <foo> ()
|
||||
(bar #:getter foo-bar))
|
||||
(define z (foo-bar (make <foo>)))")))
|
||||
(read-and-compile in
|
||||
#:env m
|
||||
#:opts %opts-w-unbound)))))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue