From fea63928f41f070ed66df2076ce0a176f7320349 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Thu, 14 Feb 2013 03:48:40 +0100 Subject: [PATCH] 2.28.9: implement deferred-warnings support for CMUCL (and SCL?) Low-level code provided by Raymond Toy. --- asdf.asd | 2 +- header.lisp | 2 +- lisp-action.lisp | 4 +- lisp-build.lisp | 70 +++++++++++++++++++++++++++++- test/test-deferred-warnings.script | 19 ++++++-- upgrade.lisp | 2 +- version.lisp-expr | 2 +- 7 files changed, 90 insertions(+), 11 deletions(-) diff --git a/asdf.asd b/asdf.asd index 279ee54c..198d145f 100644 --- a/asdf.asd +++ b/asdf.asd @@ -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. diff --git a/header.lisp b/header.lisp index 7eb3bde3..9434d3d3 100644 --- a/header.lisp +++ b/header.lisp @@ -1,5 +1,5 @@ ;;; -*- 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>. diff --git a/lisp-action.lisp b/lisp-action.lisp index bfd5d482..1945d817 100644 --- a/lisp-action.lisp +++ b/lisp-action.lisp @@ -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)))))) diff --git a/lisp-build.lisp b/lisp-build.lisp index 139670bb..627e5b9b 100644 --- a/lisp-build.lisp +++ b/lisp-build.lisp @@ -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") diff --git a/test/test-deferred-warnings.script b/test/test-deferred-warnings.script index f8e3ab8d..2687d1c8 100644 --- a/test/test-deferred-warnings.script +++ b/test/test-deferred-warnings.script @@ -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)) diff --git a/upgrade.lisp b/upgrade.lisp index 47a8837b..5fc3b9d6 100644 --- a/upgrade.lisp +++ b/upgrade.lisp @@ -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))) diff --git a/version.lisp-expr b/version.lisp-expr index c7114f1c..ade6f928 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -1 +1 @@ -"2.28.8" +"2.28.9" -- GitLab