1 ;;;; This file is for testing WITH-COMPILATION-UNIT (particularily the
2 ;;;; suppression of undefined-foo warnings for forward-references).
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; While most of SBCL is derived from the CMU CL system, the test
8 ;;;; files (like this one) were written from scratch after the fork
11 ;;;; This software is in the public domain and is provided with
12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
13 ;;;; more information.
15 (defvar *file-a* #p"with-compilation-unit-temp-a.lisp")
16 (defvar *file-b* #p"with-compilation-unit-temp-b.lisp")
18 (defun test-files (reset &optional want-suppress-p)
20 (assert (eql (raises-error?
21 (handler-bind ((warning (lambda (c)
22 (error "got a warning: ~a" c))))
23 (with-compilation-unit ()
24 (compile-file *file-a*)
25 (compile-file *file-b*))))
31 (handler-bind ((warning (lambda (c)
32 (error "got a warning: ~a" c))))
33 (compile-file *file-a*)
34 (compile-file *file-b*))))
37 (assert (eql (raises-error?
38 (handler-bind ((warning (lambda (c)
39 (error "got a warning: ~a" c))))
40 (with-compilation-unit ()
41 (compile-file *file-a*)
42 (load (compile-file-pathname *file-b*)))))
48 (handler-bind ((warning (lambda (c)
49 (error "got a warning: ~a" c))))
50 (compile-file *file-a*)
51 (load (compile-file-pathname *file-b*))))))
53 (with-test (:name (:with-compilation-unit :function))
54 (with-open-file (stream *file-b* :direction :output
55 :if-exists :supersede)
56 (write '(defun foo () 1) :stream stream))
57 (with-open-file (stream *file-a* :direction :output
58 :if-exists :supersede)
59 (write '(defun bar () (foo)) :stream stream))
61 (test-files (lambda ()
65 (with-test (:name (:with-compilation-unit :generic-function))
66 (with-open-file (stream *file-b* :direction :output
67 :if-exists :supersede)
68 (write '(defgeneric foo ()) :stream stream)
69 (write '(defmethod foo () 1) :stream stream))
70 (with-open-file (stream *file-a* :direction :output
71 :if-exists :supersede)
72 (write '(defmethod bar () (foo)) :stream stream))
74 (test-files (lambda ()
78 (with-test (:name (:with-compilation-unit :variable))
79 (with-open-file (stream *file-b* :direction :output
80 :if-exists :supersede)
81 (write `(defvar ,(intern "*A*") nil) :stream stream))
82 (with-open-file (stream *file-a* :direction :output
83 :if-exists :supersede)
84 (write `(defun bar () ,(intern "*A*")) :stream stream))
86 (test-files (lambda ()
87 (unintern (find-symbol "*A*"))
89 ;; Check that undefined variables are warned for, even
90 ;; if the variable is defined later in the compilation
94 (with-test (:name (:with-compilation-unit :type))
95 (with-open-file (stream *file-b* :direction :output
96 :if-exists :supersede)
97 (write `(deftype ,(intern "A-TYPE") () 'fixnum) :stream stream))
98 (with-open-file (stream *file-a* :direction :output
99 :if-exists :supersede)
100 (write `(defun bar () (typep 1 ',(intern "A-TYPE"))) :stream stream))
102 (test-files (lambda ()
103 (unintern (find-symbol "A-TYPE"))
104 (fmakunbound 'bar))))
106 (delete-file *file-a*)
107 (delete-file *file-b*)