mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-13 23:20:32 +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 ...)
|
(defs toplevel-info-defs) ;; (VARIABLE-NAME ...)
|
||||||
(locs toplevel-info-locs)) ;; (LOCATION ...)
|
(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
|
;; TODO: Combine with `report-unused-variables' so we don't traverse the tree
|
||||||
;; once for each warning type.
|
;; once for each warning type.
|
||||||
|
|
||||||
|
@ -682,6 +699,17 @@
|
||||||
(make-toplevel-info (alist-delete name refs eq?)
|
(make-toplevel-info (alist-delete name refs eq?)
|
||||||
(cons name defs)
|
(cons name defs)
|
||||||
locs))
|
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
|
(else
|
||||||
(make-toplevel-info refs defs locs)))))
|
(make-toplevel-info refs defs locs)))))
|
||||||
|
|
||||||
|
|
|
@ -649,6 +649,21 @@
|
||||||
"(define (f)
|
"(define (f)
|
||||||
(set! chbouib 3))
|
(set! chbouib 3))
|
||||||
(define chbouib 5)")))
|
(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
|
(read-and-compile in
|
||||||
#:env m
|
#:env m
|
||||||
#:opts %opts-w-unbound)))))))))
|
#:opts %opts-w-unbound)))))))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue