Commit fea63928 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.28.9: implement deferred-warnings support for CMUCL (and SCL?)

Low-level code provided by Raymond Toy.
parent 1b6ee97b
......@@ -74,7 +74,7 @@
:licence "MIT"
:description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.28.8" ;; to be automatically updated by make bump-version
:version "2.28.9" ;; to be automatically updated by make bump-version
:depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.28.8: Another System Definition Facility.
;;; This is ASDF 2.28.9: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -90,7 +90,7 @@
&optional
#+clisp lib-file
#+(or ecl mkcl) object-file
#+(or clozure sbcl) warnings-file) outputs
#+(or cmu clozure sbcl scl) warnings-file) outputs
(call-with-around-compile-hook
c #'(lambda (&rest flags)
(with-muffled-compiler-conditions ()
......@@ -100,7 +100,7 @@
(append
#+clisp (list :lib-file lib-file)
#+(or ecl mkcl) (list :object-file object-file)
#+(or clozure sbcl) (list :warnings-file warnings-file)
#+(or cmu clozure sbcl scl) (list :warnings-file warnings-file)
flags (compile-op-flags o)))))))
(check-lisp-compile-results output warnings-p failure-p
"~/asdf-action::format-action/" (list (cons o c))))))
......
......@@ -228,6 +228,26 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
:warning-type warning-type
:args (unreify-simple-sexp args)))))
#+(or cmu scl)
(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))))
#+sbcl
(defun reify-undefined-warning (warning)
;; Extracting undefined-warnings from the compilation-unit
......@@ -257,6 +277,18 @@ WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings sup
(if-let (dw ccl::*outstanding-deferred-warnings*)
(let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
(ccl::deferred-warnings.warnings mdw))))
#+(or cmu scl)
(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))))
#+sbcl
(when sb-c::*in-compilation-unit*
;; Try to send nothing through the pipe if nothing needs to be accumulated
......@@ -284,6 +316,32 @@ One of three functions required for deferred-warnings support in ASDF."
(setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t)))))
(appendf (ccl::deferred-warnings.warnings dw)
(mapcar 'unreify-deferred-warning reified-deferred-warnings)))
#+(or cmu scl)
(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))))))
#+sbcl
(dolist (item reified-deferred-warnings)
;; Each item is (symbol . adjustment) where the adjustment depends on the symbol.
......@@ -318,6 +376,12 @@ One of three functions required for deferred-warnings support in ASDF."
(if-let (dw ccl::*outstanding-deferred-warnings*)
(let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
(setf (ccl::deferred-warnings.warnings mdw) nil)))
#+(or cmu scl)
(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))
#+sbcl
(when sb-c::*in-compilation-unit*
(setf sb-c::*undefined-warnings* nil
......@@ -339,8 +403,10 @@ 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")))
((:cmu :cmucl) "cmucl-warnings")
((:sbcl) "sbcl-warnings")
((:clozure :ccl) "ccl-warnings")
((:scl) "scl-warnings")))
(defvar *warnings-file-type* (warnings-file-type)
"Type for warnings files")
......
......@@ -5,14 +5,27 @@
:serial t
:components ((:file "undefined-function")
(:file "file1")))
(DBG :tdw0 *compile-file-warnings-behaviour*)
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :ignore))
(load-system :test-deferred-warnings :force t)
t)
(compile-file-error () nil)))
(error (c)
(DBG :cfwbi c)
nil)))
#+(or clozure sbcl)
(DBG :tdw1 *warnings-file-type*)
(assert
(handler-case
(let ((*warnings-file-type* nil))
(load-system :test-deferred-warnings :force t)
t)
(error ()
(DBG :wftn c)
nil)))
#+(or clozure cmu sbcl scl)
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :error))
......@@ -20,7 +33,7 @@
nil)
(compile-warned-error () t)))
#+(or clozure sbcl)
#+(or clozure cmu sbcl scl)
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :error))
......
......@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
;; "3.4.5.67" would be a development version in the official upstream of 3.4.5.
;; "3.4.5.0.8" would be your eighth local modification of official release 3.4.5
;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "2.28.8")
(asdf-version "2.28.9")
(existing-version (asdf-version)))
(setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-version)))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment