From 813549e7388767c00b01f337be559995999c3260 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Thu, 7 Feb 2013 01:41:49 +0100
Subject: [PATCH] 2.28.5: make upgrade work better for CCL with setf
 component-version.

This is kind of a kluge: use slot-value in parse-component-form
instead of a proper accessor.
A better fix is required in the long term, but this will do for now.
---
 TODO                     |  1 +
 asdf.asd                 |  2 +-
 component.lisp           |  2 ++
 defsystem.lisp           |  6 ++++--
 header.lisp              |  2 +-
 test/script-support.lisp |  2 +-
 test/test-asdf.asd       | 42 +++++++++++++++++++++++++++++++++++-----
 upgrade.lisp             |  5 +++--
 version.lisp-expr        |  2 +-
 9 files changed, 51 insertions(+), 13 deletions(-)

diff --git a/TODO b/TODO
index def466e3..e98eb6a9 100644
--- a/TODO
+++ b/TODO
@@ -1,3 +1,4 @@
+* have a single test .asd that tests as many features as possible, use it for upgrade test.
 * implement deferred warnings support on abcl, allegro, clisp, cmucl, lispworks, scl)
 * fix upgrade on clisp
 ** Extract minimal test case
diff --git a/asdf.asd b/asdf.asd
index 9d5c5875..a30b132c 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.4" ;; to be automatically updated by make bump-version
+  :version "2.28.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.
diff --git a/component.lisp b/component.lisp
index d03902ec..a00cdeb3 100644
--- a/component.lisp
+++ b/component.lisp
@@ -53,6 +53,8 @@ another pathname in a degenerate way."))
   (defgeneric component-external-format (component))
   (defgeneric component-encoding (component))
   (defgeneric version-satisfies (component version))
+  (defgeneric component-version (component))
+  (defgeneric (setf component-version) (new-version component))
 
   ;; Backward compatible way of computing the FILE-TYPE of a component.
   ;; TODO: find users, have them stop using that, remove it for ASDF4.
diff --git a/defsystem.lisp b/defsystem.lisp
index 03a8746a..c1540b5f 100644
--- a/defsystem.lisp
+++ b/defsystem.lisp
@@ -103,7 +103,7 @@
 
 ;;; Main parsing function
 (with-upgradability ()
-  (defun parse-component-form (parent options &key previous-serial-component)
+  (defun* (parse-component-form) (parent options &key previous-serial-component)
     (destructuring-bind
         (type name &rest rest &key
                                 (builtin-system-p () bspp)
@@ -149,7 +149,9 @@
         (when (and versionp version (not (parse-version version nil)))
           (warn (compatfmt "~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>")
                 version name parent))
-        (setf (component-version component) version)
+        ;; Don't use the accessor: kluge to avoid upgrade issue on CCL 1.8.
+        ;; A better fix is required.
+        (setf (slot-value component 'version) version)
         (when (typep component 'parent-component)
           (setf (component-children component)
                 (loop
diff --git a/header.lisp b/header.lisp
index d402fac1..b7794f8f 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.4: Another System Definition Facility.
+;;; This is ASDF 2.28.5: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 34d80ecb..e1d8d82d 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -545,7 +545,7 @@ is bound, write a message and exit on an error.  If
     (funcall new-method)
     (format t "Testing it~%")
     (register-directory *test-directory*)
-    (load-test-system :test-module-depend)
+    (load-test-system :test-asdf/all)
     (assert (asymval '#:*file1* :test-package))
     (assert (asymval '#:*file3* :test-package))))
 
diff --git a/test/test-asdf.asd b/test/test-asdf.asd
index 53cd5857..edfdf3cc 100644
--- a/test/test-asdf.asd
+++ b/test/test-asdf.asd
@@ -2,13 +2,45 @@
   (:use :cl :asdf))
 (in-package :test-asdf-system)
 
-(defsystem :test-asdf
-  :components ())
+(defsystem :test-asdf)
+
+(defsystem :test-asdf/all
+  :version "0"
+  :depends-on ((:version :test-asdf/file2 "2")
+               :test-asdf/file4))
+
+(defsystem :test-asdf/file1
+  :components ((:file "file1")))
+
+(defsystem :test-asdf/file2
+  :version "2.2"
+  :depends-on (:test-asdf/file1)
+  :components ((:module "foo" :pathname ""
+                :components ((:module "bar" :pathname ""
+                              :components ((:file "file2")))))))
+
+(defsystem :test-asdf/file4
+  :components ((:file "file3")
+               (:file "file4" :in-order-to ((load-op (load-op "file3"))
+                                            (compile-op (load-op "file3"))))))
 
 (defsystem :test-asdf/test9-1
-    :version "1.1"
-    :components ((:file "file2"))
-    :depends-on ((:version :test-asdf/test9-2 "2.0")))
+  :version "1.1"
+  :components ((:file "file2"))
+  :depends-on ((:version :test-asdf/test9-2 "2.0")))
+
+(defsystem :test-asdf/test-module-depend
+  :components
+  ((:file "file1")
+   (:module "quux"
+    :pathname ""
+    :depends-on ("file1")
+    :components
+    ((:file "file2")
+     (:module "file3mod"
+      :pathname ""
+      :components
+      ((:file "file3")))))))
 
 (defsystem :test-asdf/test9-2
   :version "1.0"
diff --git a/upgrade.lisp b/upgrade.lisp
index aa4828ff..f37ad13d 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -39,7 +39,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
   (defun upgrading-p ()
     (and *previous-asdf-versions* (not (equal *asdf-version* (first *previous-asdf-versions*)))))
   (defmacro when-upgrading ((&key (upgrading-p '(upgrading-p)) when) &body body)
-    `(eval-when (:compile-toplevel :load-toplevel :execute)
+    `(with-upgradability ()
        (when (and ,upgrading-p ,@(when when `(,when)))
          (handler-bind ((style-warning #'muffle-warning))
            (eval '(progn ,@body))))))
@@ -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.4")
+         (asdf-version "2.28.5")
          (existing-version (asdf-version)))
     (setf *asdf-version* asdf-version)
     (when (and existing-version (not (equal asdf-version existing-version)))
@@ -72,6 +72,7 @@ You can compare this string with e.g.: (ASDF:VERSION-SATISFIES (ASDF:ASDF-VERSIO
              #:component-depends-on #:component-self-dependencies #:operation-done-p
              #:traverse ;; plan
              #:operate  ;; operate
+             #:parse-component-form ;; defsystem
              #:apply-output-translations ;; output-translations
              #:process-output-translations-directive
              #:inherit-source-registry #:process-source-registry ;; source-registry
diff --git a/version.lisp-expr b/version.lisp-expr
index b921a872..93cb37ac 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.28.4"
+"2.28.5"
-- 
GitLab