>>>>> "Raymond" == Raymond Toy <[email protected]> writes:
Raymond> Is there an example of deferred warnings support? I have a
possible
Raymond> implementation for cmucl, but I'd like to test it somehow before I
Raymond> propose a patch.
Here is a patch. I have no idea if it works or not.
Ray
diff --git a/lisp-build.lisp b/lisp-build.lisp
index 412cc2c..a9dbe72 100644
--- a/lisp-build.lisp
+++ b/lisp-build.lisp
@@ -244,6 +244,26 @@ Note that ASDF ALWAYS raises an error if it fails to
create an output file when
:original-source-path
,(sb-c::compiler-error-context-original-source-path frob)))
(sb-c::undefined-warning-warnings warning))))
+#+cmu
+(defun reify-undefined-warning (warning)
+ ;; Extracting undefined-warnings from the compilation-unit
+ ;; To be passed through the above reify/unreify link, it must be a
"simple-sexp"
+ (list*
+ (c::undefined-warning-kind warning)
+ (c::undefined-warning-name warning)
+ (c::undefined-warning-count warning)
+ (mapcar
+ #'(lambda (frob)
+ ;; the lexenv slot can be ignored for reporting purposes
+ `(:enclosing-source ,(c::compiler-error-context-enclosing-source frob)
+ :source ,(c::compiler-error-context-source frob)
+ :original-source ,(c::compiler-error-context-original-source frob)
+ :context ,(c::compiler-error-context-context frob)
+ :file-name ,(c::compiler-error-context-file-name frob) ; a pathname
+ :file-position ,(c::compiler-error-context-file-position frob) ; an
integer
+ :original-source-path
,(c::compiler-error-context-original-source-path frob)))
+ (c::undefined-warning-warnings warning))))
+
(defun reify-deferred-warnings ()
"return a portable S-expression, portably readable and writeable in any
Common Lisp implementation
using READ within a WITH-SAFE-IO-SYNTAX, that represents the warnings
currently deferred by
@@ -266,7 +286,20 @@ WITH-COMPILATION-UNIT. One of three functions required for
deferred-warnings sup
sb-c::*compiler-note-count*)
:for value = (symbol-value what)
:when (plusp value)
- :collect `(,what . ,value)))))
+ :collect `(,what . ,value))))
+ #+cmu
+ (when lisp::*in-compilation-unit*
+ ;; Try to send nothing through the pipe if nothing needs to be accumulated
+ `(,@(when c::*undefined-warnings*
+ `((c::*undefined-warnings*
+ ,@(mapcar #'reify-undefined-warning c::*undefined-warnings*))))
+ ,@(loop :for what :in '(c::*compiler-error-count*
+ c::*compiler-warning-count*
+ c::*compiler-note-count*)
+ :for value = (symbol-value what)
+ :when (plusp value)
+ :collect `(,what . ,value))))
+ )
(defun unreify-deferred-warnings (reified-deferred-warnings)
"given a S-expression created by REIFY-DEFERRED-WARNINGS, reinstantiate the
corresponding
@@ -305,6 +338,32 @@ One of three functions required for deferred-warnings
support in ASDF."
adjustment)
sb-c::*undefined-warnings*)))
(otherwise
+ (set symbol (+ (symbol-value symbol) adjustment))))))
+ #+cmu
+ (dolist (item reified-deferred-warnings)
+ ;; Each item is (symbol . adjustment) where the adjustment depends on the
symbol.
+ ;; For *undefined-warnings*, the adjustment is a list of initargs.
+ ;; For everything else, it's an integer.
+ (destructuring-bind (symbol . adjustment) item
+ (case symbol
+ ((c::*undefined-warnings*)
+ (setf c::*undefined-warnings*
+ (nconc (mapcan
+ #'(lambda (stuff)
+ (destructuring-bind (kind name count . rest) stuff
+ (unless (case kind (:function (fboundp name)))
+ (list
+ (c::make-undefined-warning
+ :name name
+ :kind kind
+ :count count
+ :warnings
+ (mapcar #'(lambda (x)
+ (apply
#'c::make-compiler-error-context x))
+ rest))))))
+ adjustment)
+ c::*undefined-warnings*)))
+ (otherwise
(set symbol (+ (symbol-value symbol) adjustment)))))))
(defun reset-deferred-warnings ()
@@ -321,7 +380,13 @@ One of three functions required for deferred-warnings
support in ASDF."
sb-c::*compiler-error-count* 0
sb-c::*compiler-warning-count* 0
sb-c::*compiler-style-warning-count* 0
- sb-c::*compiler-note-count* 0)))
+ sb-c::*compiler-note-count* 0))
+ #+cmu
+ (when lisp::*in-compilation-unit*
+ (setf c::*undefined-warnings* nil
+ c::*compiler-error-count* 0
+ c::*compiler-warning-count* 0
+ c::*compiler-note-count* 0)))
(defun* save-deferred-warnings (warnings-file)
"Save forward reference conditions so they may be issued at a latter time,
@@ -335,7 +400,8 @@ possibly in a different process."
(defun* warnings-file-type (&optional implementation-type)
(case (or implementation-type *implementation-type*)
(:sbcl "sbcl-warnings")
- ((:clozure :ccl) "ccl-warnings")))
+ ((:clozure :ccl) "ccl-warnings")
+ (:cmu "cmucl-warnings")))
(defvar *warnings-file-type* (warnings-file-type)
"Type for warnings files")
_______________________________________________
asdf-devel mailing list
[email protected]
http://lists.common-lisp.net/cgi-bin/mailman/listinfo/asdf-devel
