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

2.31.5: Fix deferred-warnings on CCL. Fix old FEATURE broken by 2.31.2.

On CCL, we were trying to persist data that can't be written and read back
regarding the specializers of context function and values of arguments.
Now drop the information at the cost of slightly less precise warning messages.

In 2.31.2, we failed to export FEATURE from asdf/operation,
causing this compatibility feature to fail.
parent 5f0f990a
...@@ -37,7 +37,7 @@ ...@@ -37,7 +37,7 @@
:mailto "asdf-devel@common-lisp.net" :mailto "asdf-devel@common-lisp.net"
:source-control (:git "git://common-lisp.net/projects/asdf/asdf.git") :source-control (:git "git://common-lisp.net/projects/asdf/asdf.git")
:version (:read-file-form "version.lisp-expr") :version (:read-file-form "version.lisp-expr")
:build-operation monolithic-concatenate-source-op :build-operation monolithic-load-compiled-concatenated-source-op
:build-pathname "build/asdf" ;; our target :build-pathname "build/asdf" ;; our target
:around-compile call-without-redefinition-warnings ;; we need be the same as asdf-driver :around-compile call-without-redefinition-warnings ;; we need be the same as asdf-driver
:depends-on (:asdf/header :asdf/driver) :depends-on (:asdf/header :asdf/driver)
...@@ -74,7 +74,7 @@ ...@@ -74,7 +74,7 @@
:licence "MIT" :licence "MIT"
:description "Another System Definition Facility" :description "Another System Definition Facility"
:long-description "ASDF builds Common Lisp software organized into defined systems." :long-description "ASDF builds Common Lisp software organized into defined systems."
:version "2.31.4" ;; to be automatically updated by make bump-version :version "2.31.5" ;; to be automatically updated by make bump-version
:depends-on () :depends-on ()
#+asdf3 :encoding #+asdf3 :utf-8 #+asdf3 :encoding #+asdf3 :utf-8
;; For most purposes, asdf itself specially counts as a builtin system. ;; For most purposes, asdf itself specially counts as a builtin system.
......
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*- ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;; This is ASDF 2.31.4: Another System Definition Facility. ;;; This is ASDF 2.31.5: Another System Definition Facility.
;;; ;;;
;;; Feedback, bug reports, and patches are all welcome: ;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel@common-lisp.net>. ;;; please mail to <asdf-devel@common-lisp.net>.
......
...@@ -192,7 +192,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -192,7 +192,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
((or number character simple-string pathname) sexp) ((or number character simple-string pathname) sexp)
(cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp)))) (cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp))))
(simple-vector (vector (mapcar 'reify-simple-sexp (coerce sexp 'list)))))) (simple-vector (vector (mapcar 'reify-simple-sexp (coerce sexp 'list))))))
(defun unreify-simple-sexp (sexp) (defun unreify-simple-sexp (sexp)
(etypecase sexp (etypecase sexp
((or symbol number character simple-string pathname) sexp) ((or symbol number character simple-string pathname) sexp)
...@@ -214,15 +214,21 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -214,15 +214,21 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(destructuring-bind (&key filename start-pos end-pos source) source-note (destructuring-bind (&key filename start-pos end-pos source) source-note
(ccl::make-source-note :filename filename :start-pos start-pos :end-pos end-pos (ccl::make-source-note :filename filename :start-pos start-pos :end-pos end-pos
:source (unreify-source-note source))))) :source (unreify-source-note source)))))
(defun unsymbolify-function-name (name)
(if-let (setfed (gethash name ccl::%setf-function-name-inverses%))
`(setf ,setfed)
name))
(defun symbolify-function-name (name)
(if (and (consp name) (eq (first name) 'setf))
(let ((setfed (second name)))
(gethash setfed ccl::%setf-function-names%))
name))
(defun reify-function-name (function-name) (defun reify-function-name (function-name)
(if-let (setfed (gethash function-name ccl::%setf-function-name-inverses%)) (let ((name (or (first function-name) ;; defun: extract the name
`(setf ,setfed) (first (second function-name))))) ;; defmethod: keep gf name, drop method specializers
function-name)) (list name)))
(defun unreify-function-name (function-name) (defun unreify-function-name (function-name)
(if (and (consp function-name) (eq (first function-name) 'setf)) function-name)
(let ((setfed (second function-name)))
(gethash setfed ccl::%setf-function-names%))
function-name))
(defun reify-deferred-warning (deferred-warning) (defun reify-deferred-warning (deferred-warning)
(with-accessors ((warning-type ccl::compiler-warning-warning-type) (with-accessors ((warning-type ccl::compiler-warning-warning-type)
(args ccl::compiler-warning-args) (args ccl::compiler-warning-args)
...@@ -230,8 +236,11 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -230,8 +236,11 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
(function-name ccl:compiler-warning-function-name)) deferred-warning (function-name ccl:compiler-warning-function-name)) deferred-warning
(list :warning-type warning-type :function-name (reify-function-name function-name) (list :warning-type warning-type :function-name (reify-function-name function-name)
:source-note (reify-source-note source-note) :source-note (reify-source-note source-note)
:args (destructuring-bind (fun . formals) args :args (destructuring-bind (fun formals env) args
(cons (reify-function-name fun) formals))))) (declare (ignorable env))
(list (unsymbolify-function-name fun)
(mapcar (constantly nil) formals)
nil)))))
(defun unreify-deferred-warning (reified-deferred-warning) (defun unreify-deferred-warning (reified-deferred-warning)
(destructuring-bind (&key warning-type function-name source-note args) (destructuring-bind (&key warning-type function-name source-note args)
reified-deferred-warning reified-deferred-warning
...@@ -241,7 +250,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -241,7 +250,7 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when
:source-note (unreify-source-note source-note) :source-note (unreify-source-note source-note)
:warning-type warning-type :warning-type warning-type
:args (destructuring-bind (fun . formals) args :args (destructuring-bind (fun . formals) args
(cons (unreify-function-name fun) formals)))))) (cons (symbolify-function-name fun) formals))))))
#+(or cmu scl) #+(or cmu scl)
(defun reify-undefined-warning (warning) (defun reify-undefined-warning (warning)
;; Extracting undefined-warnings from the compilation-unit ;; Extracting undefined-warnings from the compilation-unit
...@@ -461,7 +470,7 @@ possibly in a different process." ...@@ -461,7 +470,7 @@ possibly in a different process."
(unreify-deferred-warnings (unreify-deferred-warnings
(handler-case (safe-read-file-form file) (handler-case (safe-read-file-form file)
(error (c) (error (c)
(delete-file-if-exists file) ;;(delete-file-if-exists file) ;; deleting forces rebuild but prevents debugging
(push c file-errors) (push c file-errors)
nil)))))) nil))))))
(dolist (error file-errors) (error error)) (dolist (error file-errors) (error error))
......
...@@ -8,9 +8,7 @@ ...@@ -8,9 +8,7 @@
#:operation #:operation
#:operation-original-initargs ;; backward-compatibility only. DO NOT USE. #:operation-original-initargs ;; backward-compatibility only. DO NOT USE.
#:build-op ;; THE generic operation #:build-op ;; THE generic operation
#:*operations* #:*operations* #:make-operation #:find-operation #:feature))
#:make-operation
#:find-operation))
(in-package :asdf/operation) (in-package :asdf/operation)
;;; Operation Classes ;;; Operation Classes
...@@ -53,8 +51,8 @@ ...@@ -53,8 +51,8 @@
spec) spec)
(defmethod find-operation (context (spec symbol)) (defmethod find-operation (context (spec symbol))
(unless (member spec '(nil feature)) (unless (member spec '(nil feature))
;; specially avoid the "FEATURE" misfeature from ASDF1. ;; NIL designates itself, i.e. absence of operation
;; Also, NIL designates itself. ;; FEATURE is the ASDF1 misfeature that comes with IF-COMPONENT-DEP-FAILS
(apply 'make-operation spec (operation-original-initargs context)))) (apply 'make-operation spec (operation-original-initargs context))))
(defmethod operation-original-initargs ((context symbol)) (defmethod operation-original-initargs ((context symbol))
(declare (ignorable context)) (declare (ignorable context))
......
...@@ -10,7 +10,8 @@ ...@@ -10,7 +10,8 @@
:test-asdf/file4)) :test-asdf/file4))
(defsystem :test-asdf/file1 (defsystem :test-asdf/file1
:components ((:file "file1"))) :components ((:file "file1" :if-feature :common-lisp)
(:file "does-not-exist" :if-feature (:not :common-lisp))))
(defsystem :test-asdf/file2 (defsystem :test-asdf/file2
:version "2.2" :version "2.2"
...@@ -43,7 +44,12 @@ ...@@ -43,7 +44,12 @@
(:module "file3mod" (:module "file3mod"
:pathname "" :pathname ""
:components :components
((:file "file3"))))))) ((:file "file3"
:in-order-to ((compile-op (feature :common-lisp))))
(:file "does-not-exist"
:in-order-to ((compile-op (feature (:not :common-lisp))))))
:if-component-dep-fails :ignore)))))
(defsystem :test-asdf/test9-2 (defsystem :test-asdf/test9-2
:version "1.0" :version "1.0"
......
...@@ -28,22 +28,15 @@ ...@@ -28,22 +28,15 @@
:components ((:file "use-setf-foo") (:file "defsetf-foo"))) :components ((:file "use-setf-foo") (:file "defsetf-foo")))
(DBG :tdw0 *compile-file-warnings-behaviour*) (DBG :tdw0 *compile-file-warnings-behaviour*)
(assert (handler-bind
(handler-case ((error (lambda (c) (DBG :cfwbi-ufo c))))
(let ((*compile-file-warnings-behaviour* :ignore)) (let ((*compile-file-warnings-behaviour* :ignore))
(load-system :use-foo-only :force t)) (load-system :use-foo-only :force t)))
(error (c)
(DBG :cfwbi c)
nil)))
(assert (handler-bind
(handler-case ((error (lambda (c) (DBG :cfwbi-usfo c))))
(let ((*compile-file-warnings-behaviour* :ignore)) (let ((*compile-file-warnings-behaviour* :ignore))
(load-system :use-setf-foo-only :force t) (load-system :use-setf-foo-only :force t)))
t)
(error (c)
(DBG :cfwbi c)
nil)))
(DBG :tdw1 *warnings-file-type*) (DBG :tdw1 *warnings-file-type*)
(assert (assert
...@@ -79,6 +72,7 @@ ...@@ -79,6 +72,7 @@
(load-system :use-setf-then-defun-foo) (load-system :use-setf-then-defun-foo)
;;#+clozure (format t "~S~%" asdf/lisp-build::*warnings*)
;;#+clozure (trace load compile-file check-deferred-warnings check-lisp-compile-warnings) ;;#+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. ;; FIXME: on CCL, the defmacro warning is found while loading the defmacro fasl.
......
(in-package :asdf-test/deferred-warnings) (in-package :asdf-test/deferred-warnings)
(defclass <bar> () ())
(defun use-setf-foo (v x) (defun use-setf-foo (v x)
(setf (foo x) v)) (setf (foo x) v))
(defmethod gf ((x <bar>) (y (eql (+ 1 1))))
(setf (foo (make-instance '<bar>)) #(1 2 3 4)))
(defmethod (setf gf) (value (x <bar>) (y (eql (+ 1 1))))
(setf (foo x) (+ y value)))
#+clisp (eval-when (:compile-toplevel :load-toplevel :execute) #+clisp (eval-when (:compile-toplevel :load-toplevel :execute)
(format t "~&~S~%" `(sys::*unknown-functions* ,sys::*unknown-functions*))) (format t "~&~S~%" `(sys::*unknown-functions* ,sys::*unknown-functions*)))
...@@ -52,7 +52,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO ...@@ -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.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.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 ;; "3.4.5.67.8" would be your eighth local modification of development version 3.4.5.67
(asdf-version "2.31.4") (asdf-version "2.31.5")
(existing-version (asdf-version))) (existing-version (asdf-version)))
(setf *asdf-version* asdf-version) (setf *asdf-version* asdf-version)
(when (and existing-version (not (equal asdf-version existing-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