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 @@
:mailto "asdf-devel@common-lisp.net"
:source-control (:git "git://common-lisp.net/projects/asdf/asdf.git")
: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
:around-compile call-without-redefinition-warnings ;; we need be the same as asdf-driver
:depends-on (:asdf/header :asdf/driver)
......@@ -74,7 +74,7 @@
:licence "MIT"
:description "Another System Definition Facility"
: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 ()
#+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.31.4: Another System Definition Facility.
;;; This is ASDF 2.31.5: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; 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
((or number character simple-string pathname) sexp)
(cons (cons (reify-simple-sexp (car sexp)) (reify-simple-sexp (cdr sexp))))
(simple-vector (vector (mapcar 'reify-simple-sexp (coerce sexp 'list))))))
(defun unreify-simple-sexp (sexp)
(etypecase 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
(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
: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)
(if-let (setfed (gethash function-name ccl::%setf-function-name-inverses%))
`(setf ,setfed)
function-name))
(let ((name (or (first function-name) ;; defun: extract the name
(first (second function-name))))) ;; defmethod: keep gf name, drop method specializers
(list name)))
(defun unreify-function-name (function-name)
(if (and (consp function-name) (eq (first function-name) 'setf))
(let ((setfed (second function-name)))
(gethash setfed ccl::%setf-function-names%))
function-name))
function-name)
(defun reify-deferred-warning (deferred-warning)
(with-accessors ((warning-type ccl::compiler-warning-warning-type)
(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
(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 (destructuring-bind (fun . formals) args
(cons (reify-function-name fun) formals)))))
:args (destructuring-bind (fun formals env) args
(declare (ignorable env))
(list (unsymbolify-function-name fun)
(mapcar (constantly nil) formals)
nil)))))
(defun unreify-deferred-warning (reified-deferred-warning)
(destructuring-bind (&key warning-type function-name source-note args)
reified-deferred-warning
......@@ -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)
:warning-type warning-type
:args (destructuring-bind (fun . formals) args
(cons (unreify-function-name fun) formals))))))
(cons (symbolify-function-name fun) formals))))))
#+(or cmu scl)
(defun reify-undefined-warning (warning)
;; Extracting undefined-warnings from the compilation-unit
......@@ -461,7 +470,7 @@ possibly in a different process."
(unreify-deferred-warnings
(handler-case (safe-read-file-form file)
(error (c)
(delete-file-if-exists file)
;;(delete-file-if-exists file) ;; deleting forces rebuild but prevents debugging
(push c file-errors)
nil))))))
(dolist (error file-errors) (error error))
......
......@@ -8,9 +8,7 @@
#:operation
#:operation-original-initargs ;; backward-compatibility only. DO NOT USE.
#:build-op ;; THE generic operation
#:*operations*
#:make-operation
#:find-operation))
#:*operations* #:make-operation #:find-operation #:feature))
(in-package :asdf/operation)
;;; Operation Classes
......@@ -53,8 +51,8 @@
spec)
(defmethod find-operation (context (spec symbol))
(unless (member spec '(nil feature))
;; specially avoid the "FEATURE" misfeature from ASDF1.
;; Also, NIL designates itself.
;; NIL designates itself, i.e. absence of operation
;; FEATURE is the ASDF1 misfeature that comes with IF-COMPONENT-DEP-FAILS
(apply 'make-operation spec (operation-original-initargs context))))
(defmethod operation-original-initargs ((context symbol))
(declare (ignorable context))
......
......@@ -10,7 +10,8 @@
:test-asdf/file4))
(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
:version "2.2"
......@@ -43,7 +44,12 @@
(:module "file3mod"
:pathname ""
: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
:version "1.0"
......
......@@ -28,22 +28,15 @@
: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 :use-foo-only :force t))
(error (c)
(DBG :cfwbi c)
nil)))
(handler-bind
((error (lambda (c) (DBG :cfwbi-ufo c))))
(let ((*compile-file-warnings-behaviour* :ignore))
(load-system :use-foo-only :force t)))
(assert
(handler-case
(let ((*compile-file-warnings-behaviour* :ignore))
(load-system :use-setf-foo-only :force t)
t)
(error (c)
(DBG :cfwbi c)
nil)))
(handler-bind
((error (lambda (c) (DBG :cfwbi-usfo c))))
(let ((*compile-file-warnings-behaviour* :ignore))
(load-system :use-setf-foo-only :force t)))
(DBG :tdw1 *warnings-file-type*)
(assert
......@@ -79,6 +72,7 @@
(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)
;; FIXME: on CCL, the defmacro warning is found while loading the defmacro fasl.
......
(in-package :asdf-test/deferred-warnings)
(defclass <bar> () ())
(defun use-setf-foo (v x)
(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)
(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
;; "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.31.4")
(asdf-version "2.31.5")
(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