From: Juho Snellman <jsnell@iki.fi>
Date: Fri, 19 Jan 2007 01:55:46 +0000 (+0000)
Subject: 1.0.1.33: Better forward reference handling in WITH-COMPILATION-UNIT ...
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ad0c59dd3e9a49777fce9790bf17f0a5ee7fbee6;p=sbcl.git

1.0.1.33: Better forward reference handling in WITH-COMPILATION-UNIT ...

        * ... for the case where a forward reference is made during
          compilation, and the referenced function is loaded from a
          pre-existing fasl while still inside the same compilation unit.
          (Reported by Jeremy Brown).
        * Tests.
---

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index dc5536e..b4c6c36 100644
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -217,6 +217,8 @@
     (style-warn "redefining ~S in DEFUN" name))
   (setf (sb!xc:fdefinition name) def)
 
+  (sb!c::note-name-defined name :function)
+
   ;; FIXME: I want to do this here (and fix bug 137), but until the
   ;; breathtaking CMU CL function name architecture is converted into
   ;; something sane, (1) doing so doesn't really fix the bug, and
diff --git a/tests/with-compilation-unit.impure.lisp b/tests/with-compilation-unit.impure.lisp
new file mode 100644
index 0000000..1239f67
--- /dev/null
+++ b/tests/with-compilation-unit.impure.lisp
@@ -0,0 +1,108 @@
+;;;; This file is for testing WITH-COMPILATION-UNIT (particularily the
+;;;; suppression of undefined-foo warnings for forward-references).
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; While most of SBCL is derived from the CMU CL system, the test
+;;;; files (like this one) were written from scratch after the fork
+;;;; from CMU CL.
+;;;;
+;;;; This software is in the public domain and is provided with
+;;;; absolutely no warranty. See the COPYING and CREDITS files for
+;;;; more information.
+
+(defvar *file-a* #p"with-compilation-unit-temp-a.lisp")
+(defvar *file-b* #p"with-compilation-unit-temp-b.lisp")
+
+(defun test-files (reset &optional want-suppress-p)
+  (funcall reset)
+  (assert (eql (raises-error?
+                (handler-bind ((warning (lambda (c)
+                                          (error "got a warning: ~a" c))))
+                  (with-compilation-unit ()
+                    (compile-file *file-a*)
+                    (compile-file *file-b*))))
+               want-suppress-p))
+
+  (funcall reset)
+  (assert
+   (raises-error?
+    (handler-bind ((warning (lambda (c)
+                              (error "got a warning: ~a" c))))
+      (compile-file *file-a*)
+      (compile-file *file-b*))))
+
+  (funcall reset)
+  (assert (eql (raises-error?
+                (handler-bind ((warning (lambda (c)
+                                          (error "got a warning: ~a" c))))
+                  (with-compilation-unit ()
+                    (compile-file *file-a*)
+                    (load (compile-file-pathname *file-b*)))))
+               want-suppress-p))
+
+  (funcall reset)
+  (assert
+   (raises-error?
+    (handler-bind ((warning (lambda (c)
+                              (error "got a warning: ~a" c))))
+      (compile-file *file-a*)
+      (load (compile-file-pathname *file-b*))))))
+
+(with-test (:name (:with-compilation-unit :function))
+  (with-open-file (stream *file-b* :direction :output
+:if-exists :supersede)
+    (write '(defun foo () 1) :stream stream))
+  (with-open-file (stream *file-a* :direction :output
+:if-exists :supersede)
+    (write '(defun bar () (foo)) :stream stream))
+
+  (test-files (lambda ()
+                (fmakunbound 'foo)
+                (fmakunbound 'bar))))
+
+(with-test (:name (:with-compilation-unit :generic-function))
+  (with-open-file (stream *file-b* :direction :output
+                          :if-exists :supersede)
+    (write '(defgeneric foo ()) :stream stream)
+    (write '(defmethod foo () 1) :stream stream))
+  (with-open-file (stream *file-a* :direction :output
+                          :if-exists :supersede)
+    (write '(defmethod bar () (foo)) :stream stream))
+
+  (test-files (lambda ()
+                (fmakunbound 'foo)
+                (fmakunbound 'bar))))
+
+(with-test (:name (:with-compilation-unit :variable))
+  (with-open-file (stream *file-b* :direction :output
+                          :if-exists :supersede)
+    (write `(defvar ,(intern "*A*") nil) :stream stream))
+  (with-open-file (stream *file-a* :direction :output
+                          :if-exists :supersede)
+    (write `(defun bar () ,(intern "*A*")) :stream stream))
+
+  (test-files (lambda ()
+                (unintern (find-symbol "*A*"))
+                (fmakunbound 'bar))
+              ;; Check that undefined variables are warned for, even
+              ;; if the variable is defined later in the compilation
+              ;; unit.
+              t))
+
+(with-test (:name (:with-compilation-unit :type))
+  (with-open-file (stream *file-b* :direction :output
+                          :if-exists :supersede)
+    (write `(deftype ,(intern "A-TYPE") () 'fixnum) :stream stream))
+  (with-open-file (stream *file-a* :direction :output
+                          :if-exists :supersede)
+    (write `(defun bar () (typep 1 ',(intern "A-TYPE"))) :stream stream))
+
+  (test-files (lambda ()
+                (unintern 'a-type)
+                (fmakunbound 'bar))))
+
+(delete-file *file-a*)
+(delete-file *file-b*)
+
diff --git a/version.lisp-expr b/version.lisp-expr
index 09affdb..33bfa6b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.1.32"
+"1.0.1.33"