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.

diff --git a/module/language/tree-il/analyze.scm b/module/language/tree-il/analyze.scm
index 42ad74d..352462f 100644 (file)
--- a/module/language/tree-il/analyze.scm
+++ b/module/language/tree-il/analyze.scm
@@ -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)))))
 

diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index ffc1785..90dde7d 100644 (file)
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -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)))))))))