Skip to content
Snippets Groups Projects
Commit 6500c6e4 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

2.28.10: fix issue with deferred warnings for setf foo functions in CCL 1.9.

Issue found by Bill StClair.
parent fea63928
No related branches found
No related tags found
No related merge requests found
...@@ -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.28.9" ;; to be automatically updated by make bump-version :version "2.28.10" ;; 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.28.9: Another System Definition Facility. ;;; This is ASDF 2.28.10: 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>.
......
...@@ -211,19 +211,30 @@ Note that ASDF ALWAYS raises an error if it fails to create an output file when ...@@ -211,19 +211,30 @@ 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 reify-function-name (function-name)
(reify-simple-sexp
(if-let (setfed (gethash function-name ccl::%setf-function-name-inverses%))
`(setf ,setfed)
function-name)))
(defun unreify-function-name (function-name)
(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))))
(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)
(source-note ccl:compiler-warning-source-note) (source-note ccl:compiler-warning-source-note)
(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-simple-sexp function-name) (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 (reify-simple-sexp args))))
(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
(make-condition (or (cdr (ccl::assq warning-type ccl::*compiler-whining-conditions*)) (make-condition (or (cdr (ccl::assq warning-type ccl::*compiler-whining-conditions*))
'ccl::compiler-warning) 'ccl::compiler-warning)
:function-name (unreify-simple-sexp function-name) :function-name (unreify-function-name function-name)
:source-note (unreify-source-note source-note) :source-note (unreify-source-note source-note)
:warning-type warning-type :warning-type warning-type
:args (unreify-simple-sexp args))))) :args (unreify-simple-sexp args)))))
......
...@@ -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.28.9") (asdf-version "2.28.10")
(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)))
......
"2.28.9" "2.28.10"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment