1
Fork 0
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:
Ludovic Courtès 2009-10-22 00:37:36 +02:00
parent 60c8ad9ea3
commit b6d2306d40
2 changed files with 43 additions and 0 deletions

View file

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

View file

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