From 49ab669ef863e454a78d7e1b82c121cf28bcf310 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sun, 20 Jan 2013 14:25:33 -0500
Subject: [PATCH] 2.26.127: upgrade frobbing. Got CLISP much further along.

---
 asdf.asd                                      |  2 +-
 component.lisp                                |  4 +++-
 defsystem.lisp                                |  2 +-
 footer.lisp                                   |  2 +-
 header.lisp                                   |  2 +-
 package.lisp                                  | 17 +++++++++-----
 system.lisp                                   |  2 --
 test/run-tests.sh                             |  1 +
 test/script-support.lisp                      | 10 +++++++-
 ...nd-test.script => test-run-program.script} |  0
 upgrade.lisp                                  | 23 ++++++++++---------
 utility.lisp                                  |  3 +--
 version.lisp-expr                             |  2 +-
 13 files changed, 42 insertions(+), 28 deletions(-)
 rename test/{run-shell-command-test.script => test-run-program.script} (100%)

diff --git a/asdf.asd b/asdf.asd
index 359716642..bbb030270 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -15,7 +15,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.26.126" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.127" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components ((:module "build" :components ((:file "asdf"))))
   :in-order-to (#+asdf2.27 (compile-op (monolithic-load-concatenated-source-op asdf/defsystem))))
diff --git a/component.lisp b/component.lisp
index fcecc0ac1..0a44ec478 100644
--- a/component.lisp
+++ b/component.lisp
@@ -29,7 +29,9 @@
 
    ;; Internals we'd like to share with the ASDF package, especially for upgrade purposes
    #:name #:version #:description #:long-description #:author #:maintainer #:licence
-   #:defsystem-depends-on
+   #:components-by-name #:components
+   #:children #:children-by-name #:default-component-class
+   #:author #:maintainer #:licence #:source-file #:defsystem-depends-on
    #:sibling-dependencies #:if-feature #:in-order-to #:inline-methods
    #:relative-pathname #:absolute-pathname #:operation-times #:around-compile
    #:%encoding #:properties #:parent))
diff --git a/defsystem.lisp b/defsystem.lisp
index 4064947b7..fdd181c8d 100644
--- a/defsystem.lisp
+++ b/defsystem.lisp
@@ -136,7 +136,7 @@
       (component-pathname component) ; eagerly compute the absolute pathname
       (let ((sysdir (system-source-directory (component-system component)))) ;; requires the previous
         (setf version (normalize-version version sysdir)))
-      (when (and versionp (not (parse-version version nil)))
+      (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)
diff --git a/footer.lisp b/footer.lisp
index c188b22f4..2cb277d8b 100644
--- a/footer.lisp
+++ b/footer.lisp
@@ -12,7 +12,7 @@
 
 ;;;; Configure
 (setf asdf/utility:*asdf-debug-utility*
-      '(asdf/interface:system-relative-pathname :asdf "contrib/debug.lisp"))
+      '(asdf/system:system-relative-pathname :asdf "contrib/debug.lisp"))
 
 ;;;; Hook ASDF into the implementation's REQUIRE and other entry points.
 
diff --git a/header.lisp b/header.lisp
index 05bc6b652..c1e0b0ebe 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.26.126: Another System Definition Facility.
+;;; This is ASDF 2.26.127: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/package.lisp b/package.lisp
index 3874cd468..376456367 100644
--- a/package.lisp
+++ b/package.lisp
@@ -10,6 +10,8 @@
 ;; and reexported in a different package
 ;; (alternatively the package may be dropped & replaced by one with a new name).
 
+#+clisp (declaim (optimize (speed 1)(safety 3)(debug 3)))
+
 (defpackage :asdf/package
   (:use :common-lisp)
   (:export
@@ -253,6 +255,10 @@ or when loading the package is optional."
         (when nuke (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))
         (ensure-package-unused p)
         (delete-package package))))
+  (defun package-names (package)
+    (cons (package-name package) (package-nicknames package)))
+  (defun packages-from-names (names)
+    (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t))
   (defun fresh-package-name (&key (prefix :%TO-BE-DELETED)
                                separator
                                (index (random most-positive-fixnum)))
@@ -260,12 +266,11 @@ or when loading the package is optional."
           :for n = (format nil "~A~@[~A~D~]" prefix (and (plusp i) (or separator "")) i)
           :thereis (and (not (find-package n)) n)))
   (defun rename-package-away (p &rest keys &key prefix &allow-other-keys)
-    (rename-package
-     p (apply 'fresh-package-name :prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
-  (defun package-names (package)
-    (cons (package-name package) (package-nicknames package)))
-  (defun packages-from-names (names)
-    (remove-duplicates (remove nil (mapcar #'find-package names)) :from-end t)))
+    (let ((new-name
+            (apply 'fresh-package-name
+                   :prefix (or prefix (format nil "__~A__" (package-name p))) keys)))
+      (record-fishy (list :rename-away (package-names p) new-name))
+      (rename-package p new-name))))
 
 
 ;;; Communicable representation of symbol and package information
diff --git a/system.lisp b/system.lisp
index aa0e0d63d..3a85c9fae 100644
--- a/system.lisp
+++ b/system.lisp
@@ -4,8 +4,6 @@
 (asdf/package:define-package :asdf/system
   (:recycle :asdf :asdf/system)
   (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component)
-  (:intern #:children #:children-by-name #:default-component-class
-           #:author #:maintainer #:licence #:source-file #:defsystem-depends-on)
   (:export
    #:system #:proto-system
    #:system-source-file #:system-source-directory #:system-relative-pathname
diff --git a/test/run-tests.sh b/test/run-tests.sh
index cef03a6b0..b3cc3ad51 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -249,6 +249,7 @@ upgrade_methods () {
         echo $ASDF_UPGRADE_TEST_METHODS ; return
     fi
     cat <<EOF
+'load-asdf-lisp'load-asdf-lisp-clean
 'load-asdf-lisp'load-asdf-system
 'load-asdf-lisp'compile-load-asdf
 'load-asdf-lisp'load-asdf-fasl
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 2fe0e5f74..ed74220a5 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -17,7 +17,7 @@ Some constraints:
    #:*test-directory* #:*asdf-directory*
    #:load-asdf #:maybe-compile-asdf
    #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl
-   #:compile-load-asdf #:load-asdf-system
+   #:compile-load-asdf #:load-asdf-system #:clean-load-asdf-system
    #:register-directory #:load-test-system
    #:with-test #:test-asdf #:debug-asdf
    #:assert-compare
@@ -251,6 +251,14 @@ is bound, write a message and exit on an error.  If
 (defun register-directory (dir)
   (pushnew dir (symbol-value (asym :*central-registry*))))
 
+(defun clean-asdf-system ()
+  (let ((fasl (resolve-output "asdf" "build" "asdf.fasl")))
+    (when (DBG :clean fasl (probe-file fasl)) (delete-file fasl))))
+
+(defun load-asdf-lisp-clean ()
+  (load-asdf-lisp)
+  (clean-asdf-system))
+
 (defun load-asdf-system (&rest keys)
   (quietly
    (register-directory *asdf-directory*)
diff --git a/test/run-shell-command-test.script b/test/test-run-program.script
similarity index 100%
rename from test/run-shell-command-test.script
rename to test/test-run-program.script
diff --git a/upgrade.lisp b/upgrade.lisp
index ab2f19551..c27bb7042 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -35,7 +35,7 @@
          ;; "2.345.6" would be a development version in the official upstream
          ;; "2.345.0.7" would be your seventh local modification of official release 2.345
          ;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
-         (asdf-version "2.26.126")
+         (asdf-version "2.26.127")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version))
@@ -45,7 +45,7 @@
              #:component-depends-on #:input-files
              #:perform-with-restarts #:component-relative-pathname
              #:system-source-file #:operate #:find-component #:find-system
-             #:apply-output-translations
+             #:apply-output-translations #:component-self-dependencies
              #:system-relative-pathname
              #:inherit-source-registry #:process-source-registry
              #:process-source-registry-directive #:source-file-type
@@ -57,13 +57,15 @@
              #:split #:make-collector #:do-dep #:do-one-dep
              #:resolve-relative-location-component #:resolve-absolute-location-component
              #:output-files-for-system-and-operation))) ; obsolete ASDF-BINARY-LOCATION function
+    (declare (ignorable redefined-functions uninterned-symbols))
+    (setf *asdf-version* asdf-version)
     (when (and existing-asdf (not already-there))
-      (when existing-asdf
-        (asdf-message "~&; Upgrading ASDF ~@[from version ~A ~]to version ~A~%"
-                      existing-version asdf-version)
-        (push existing-version *upgraded-p*))
-      ;;(format t "UPGRADE FROBBING! ~S~%" (list existing-asdf existing-version asdf-version)) ;XXX
-      (loop :for name :in (append #-(or clisp ecl) redefined-functions)
+      (push existing-version *upgraded-p*)
+      (when *asdf-verbose*
+        (format *trace-output*
+                (compatfmt "~&~@<; ~@;Upgrading ASDF ~@[from version ~A ~]to version ~A~@:>~%")
+                existing-version asdf-version))
+      (loop :for name :in (append #-(or clisp ecl common-lisp) redefined-functions)
               :for sym = (find-symbol* name :asdf nil) :do
                 (when sym
                   ;;(format t "Undefining ~S~%" sym);XXX
@@ -84,13 +86,12 @@
                        (shadowing-import new asdf))))))
         ;; Note that this massive package destruction makes it impossible
         ;; to use asdf/driver on top of an old ASDF on these implementations
-        #+(or clisp xcl)
+        #+(or xcl)
         (let ((p (find-package :asdf)))
           (when p
             (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s)))
             (rename-package-away p :prefix (format nil "~A-~A" :asdf (or existing-version :1.x))
-                         :index 0 :separator "-"))))
-    (setf *asdf-version* asdf-version)))
+                         :index 0 :separator "-"))))))
 
 
 ;;; Upgrade interface
diff --git a/utility.lisp b/utility.lisp
index d57f2a1e0..63a363663 100644
--- a/utility.lisp
+++ b/utility.lisp
@@ -63,8 +63,7 @@
              ;; but we usually try to do it only for the functions that need it,
              ;; which happens in asdf/upgrade - however, for ECL, we need this hammer,
              ;; (which causes issues in clisp)
-               #-ecl ;XXX
-               ,@(when (or supersede #+(or (and gcl (not gcl-pre2.7))) t)
+               ,@(when (or #-ecl supersede #+(or (and gcl (not gcl-pre2.7))) t) ; XXX
                    `((undefine-function ',name)))
                #-gcl ; gcl 2.7.0 notinline functions lose secondary return values :-(
                ,@(when (and #+ecl (symbolp name)) ; fails for setf functions on ecl
diff --git a/version.lisp-expr b/version.lisp-expr
index a69540736..70bb24158 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.126"
+"2.26.127"
-- 
GitLab