...

...

...

...

"Raymond" == Raymond Toy toy.raymond@gmail.com 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")