Commit 8fdf8013 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

2.28.11: implement deferred warnings for allegro. Beef them up for CCL.

Many thanks to Duane Rettig for explanations on how to support Franz.
lisp-action cleaned up some more for deferred-warnings.
test-deferred-warnings beefed up.
CCL still isn't fully there yet, and needs to better detect
forward reference to macros.
Also, make safe-file-write-date NIL robust independently of implementation.
parent 6500c6e4
......@@ -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.10" ;; to be automatically updated by make bump-version
:version "2.28.11" ;; 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.
......
......@@ -74,7 +74,9 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
;; and we can survive and we will continue the planning
;; as if the file were very old.
;; (or should we treat the case in a different, special way?)
(handler-case (file-write-date (translate-logical-pathname pathname)) (file-error () nil)))
(and pathname
(handler-case (file-write-date (translate-logical-pathname pathname))
(file-error () nil))))
(defun probe-file* (p &key truename)
"when given a pathname P (designated by a string as per PARSE-NAMESTRING),
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.28.10: Another System Definition Facility.
;;; This is ASDF 2.28.11: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>.
......
......@@ -90,17 +90,17 @@
&optional
#+clisp lib-file
#+(or ecl mkcl) object-file
#+(or cmu clozure sbcl scl) warnings-file) outputs
warnings-file) outputs
(call-with-around-compile-hook
c #'(lambda (&rest flags)
(with-muffled-compiler-conditions ()
(apply 'compile-file* input-file
:output-file output-file
:external-format (component-external-format c)
:warnings-file warnings-file
(append
#+clisp (list :lib-file lib-file)
#+(or ecl mkcl) (list :object-file object-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))))))
......@@ -130,13 +130,13 @@
`(,f ;; the fasl is the primary output, in first position
#+clisp
,@`(,(make-pathname :type "lib" :defaults f))
,@(when (and *warnings-file-type* (not (builtin-system-p (component-system c))))
`(,(make-pathname :type *warnings-file-type* :defaults f)))
#+ecl
,@(unless (use-ecl-byte-compiler-p)
`(,(compile-file-pathname i :type :object)))
#+mkcl
,(compile-file-pathname i :fasl-p nil)))) ;; object file
,(compile-file-pathname i :fasl-p nil) ;; object file
,@(when (and *warnings-file-type* (not (builtin-system-p (component-system c))))
`(,(make-pathname :type *warnings-file-type* :defaults f))))))
(defmethod component-depends-on ((o compile-op) (c component))
(declare (ignorable o))
`((prepare-op ,c) ,@(call-next-method)))
......
......@@ -220,15 +220,17 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(let ((name (unreify-simple-sexp function-name)))
(if (and (consp name) (eq (first name) 'setf))
(let ((setfed (second name)))
(gethash setfed ccl::%setf-function-names%)
name))))
(gethash setfed ccl::%setf-function-names%))
name)))
(defun reify-deferred-warning (deferred-warning)
(with-accessors ((warning-type ccl::compiler-warning-warning-type)
(args ccl::compiler-warning-args)
(source-note ccl:compiler-warning-source-note)
(function-name ccl:compiler-warning-function-name)) deferred-warning
(list :warning-type warning-type :function-name (reify-function-name function-name)
:source-note (reify-source-note source-note) :args (reify-simple-sexp args))))
:source-note (reify-source-note source-note)
:args (destructuring-bind (fun . formals) args
(cons (reify-function-name fun) (reify-simple-sexp formals))))))
(defun unreify-deferred-warning (reified-deferred-warning)
(destructuring-bind (&key warning-type function-name source-note args)
reified-deferred-warning
......@@ -237,8 +239,8 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
:function-name (unreify-function-name function-name)
:source-note (unreify-source-note source-note)
:warning-type warning-type
:args (unreify-simple-sexp args)))))
:args (destructuring-bind (fun . formals) args
(cons (unreify-function-name fun) (unreify-simple-sexp formals)))))))
#+(or cmu scl)
(defun reify-undefined-warning (warning)
;; Extracting undefined-warnings from the compilation-unit
......@@ -283,6 +285,10 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
"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
WITH-COMPILATION-UNIT. One of three functions required for deferred-warnings support in ASDF."
#+allegro
(reify-simple-sexp
(list :functions-defined excl::.functions-defined.
:functions-called excl::.functions-called.))
#+clozure
(mapcar 'reify-deferred-warning
(if-let (dw ccl::*outstanding-deferred-warnings*)
......@@ -322,6 +328,13 @@ Handle any warning that has been resolved already,
such as an undefined function that has been defined since.
One of three functions required for deferred-warnings support in ASDF."
(declare (ignorable reified-deferred-warnings))
#+allegro
(destructuring-bind (&key functions-defined functions-called)
(unreify-simple-sexp reified-deferred-warnings)
(setf excl::.functions-defined.
(append functions-defined excl::.functions-defined.)
excl::.functions-called.
(append functions-called excl::.functions-called.)))
#+clozure
(let ((dw (or ccl::*outstanding-deferred-warnings*
(setf ccl::*outstanding-deferred-warnings* (ccl::%defer-warnings t)))))
......@@ -383,6 +396,9 @@ One of three functions required for deferred-warnings support in ASDF."
(defun reset-deferred-warnings ()
"Reset the set of deferred warnings to be handled at the end of the current WITH-COMPILATION-UNIT.
One of three functions required for deferred-warnings support in ASDF."
#+allegro
(setf excl::.functions-defined. nil
excl::.functions-called. nil)
#+clozure
(if-let (dw ccl::*outstanding-deferred-warnings*)
(let ((mdw (ccl::ensure-merged-deferred-warnings dw)))
......@@ -414,6 +430,8 @@ possibly in a different process."
(defun warnings-file-type (&optional implementation-type)
(case (or implementation-type *implementation-type*)
((:acl :allegro) "allegro-warnings")
;;((:clisp) "clisp-warnings")
((:cmu :cmucl) "cmucl-warnings")
((:sbcl) "sbcl-warnings")
((:clozure :ccl) "ccl-warnings")
......
(in-package :asdf-test/deferred-warnings)
(defmacro foo (x)
`(1+ ,x))
(in-package :asdf-test/deferred-warnings)
(defvar *foo* (make-hash-table :test 'equal))
(defun set-foo (x v)
(setf (gethash x *foo*) v))
(defsetf foo set-foo)
(in-package :asdf-test/deferred-warnings)
(defun foo (x)
(1+ x))
(in-package :asdf-test/deferred-warnings)
(defvar *foo* (make-hash-table :test 'equal))
(defun (setf foo) (v x)
(setf (gethash x *foo*) v))
......@@ -486,16 +486,17 @@ is bound, write a message and exit on an error. If
(pathname-components *test-directory*)
(pathname-components x)))
(setf *test-directory* x)))
(format t "Frob packages~%")
(use-package :asdf :asdf-test)
(use-package :asdf/driver :asdf-test)
(use-package :asdf/cache :asdf-test)
(setf *package* (find-package :asdf-test))
t)
(defun load-asdf (&optional tag)
#+gcl2.6 (load-asdf-lisp tag) #-gcl2.6
(load-asdf-fasl tag)
(use-package :asdf :asdf-test)
(use-package :asdf/driver :asdf-test)
(use-package :asdf/cache :asdf-test)
(configure-asdf)
(setf *package* (find-package :asdf-test)))
(configure-asdf))
(defun debug-asdf ()
(setf *debug-asdf* t)
......
;;; -*- Lisp -*-
(clear-system :test-deferred-warnings)
(def-test-system :test-deferred-warnings
(in-package :asdf-test)
(def-test-system :unintern-foo
:components ((:file "unintern-foo")))
(def-test-system :use-foo-only
:depends-on (:unintern-foo)
:components ((:file "use-foo")))
(def-test-system :use-then-defun-foo
:depends-on (:unintern-foo)
:serial t
:components ((:file "use-foo") (:file "defun-foo")))
(def-test-system :use-then-defmacro-foo
:depends-on (:unintern-foo)
:serial t
:components ((:file "use-foo") (:file "defmacro-foo")))
(def-test-system :use-setf-foo-only
:depends-on (:unintern-foo)
:components ((:file "use-setf-foo")))
(def-test-system :use-setf-then-defun-foo
:depends-on (:unintern-foo)
:serial t
:components ((:file "undefined-function")
(:file "file1")))
:components ((:file "use-setf-foo") (:file "defun-setf-foo")))
(def-test-system :use-setf-then-defsetf-foo
:depends-on (:unintern-foo)
:serial t
:components ((:file "use-setf-foo") (:file "defsetf-foo")))
(DBG :tdw0 *compile-file-warnings-behaviour*)
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :ignore))
(load-system :test-deferred-warnings :force t)
(load-system :use-foo-only :force t))
(error (c)
(DBG :cfwbi c)
nil)))
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :ignore))
(load-system :use-setf-foo-only :force t)
t)
(error (c)
(DBG :cfwbi c)
......@@ -19,24 +49,53 @@
(assert
(handler-case
(let ((*warnings-file-type* nil))
(load-system :test-deferred-warnings :force t)
(load-system :use-foo-only :force t)
t)
(error ()
(DBG :wftn c)
nil)))
#+(or clozure cmu sbcl scl)
(unless *warnings-file-type*
(leave-test 0 "Your Lisp does not support deferred-warnings"))
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :error))
(load-system :test-deferred-warnings :force t)
(perform 'compile-op :use-foo-only)
nil)
(compile-warned-error () t)))
#+(or clozure cmu sbcl scl)
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :error))
(perform 'compile-op :test-deferred-warnings)
(perform 'compile-op :use-setf-foo-only)
nil)
(compile-warned-error () t)))
(let ((*compile-file-warnings-behaviour* :error))
(load-system :use-then-defun-foo))
(setf *compile-file-warnings-behaviour* :error)
(load-system :use-setf-then-defun-foo)
;;#+clozure (trace load compile-file check-deferred-warnings check-lisp-compile-warnings)
;; FIXME: on CCL, the defmacro warning is found while loading the defmacro fasl.
;; We should probably beef up the detection in reify-deferred-warnings,
;; possibly file a bug.
#-clozure
(assert
(handler-case
(load-system :use-then-defmacro-foo :force t)
((or compile-file-error compile-warned-error) () t)
;;(t (c) (DBG :utdf0 c))
(:no-error (&rest values) (DBG :utdf1 values) nil)))
#-clozure
(assert
(handler-case
(load-system :use-setf-then-defsetf-foo :force t)
((or compile-file-error compile-warned-error) () t)
;;(t (c) (DBG :ustdf0 c))
(:no-error (&rest values) (DBG :ustdf1 values) nil)))
(in-package :asdf)
(defun using-some-undefined-function ()
(some-undefined-function))
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (find-package :asdf-test/deferred-warnings)
(delete-package :asdf-test/deferred-warnings)))
(defpackage :asdf-test/deferred-warnings (:use :asdf/driver :asdf/common-lisp))
(in-package :asdf-test/deferred-warnings)
(defun use-foo (x)
(foo x))
(in-package :asdf-test/deferred-warnings)
(defun use-setf-foo (v x)
(setf (foo x) v))
......@@ -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.10")
(asdf-version "2.28.11")
(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