From c534ca65441f3f8ba743497699bec9b5eebc75ec Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 14 Jan 2013 09:45:45 -0500
Subject: [PATCH] 2.26.93: play nicer with packages, notably for Allegro and
 CLISP

On Allegro, frob the autoload earlier and intern the gethostname later
so we don't unnecessarily autoload stuff.

On CLISP, don't undefine functions, just unintern everything in the beginning,
and it won't complain about disappearing methods anymore.

Also, only retrigger the upgrade attempt on source-registry change
if ASDF was not upgraded yet. This avoids unnecessary reloading of ASDF.

Finally, be sure to share more symbols between everyone - hopefully,
all the symbols that were used in ASDF and got recycled.
Slot names are a big one, notably.
---
 action.lisp              |  2 +-
 asdf.asd                 |  2 +-
 compatibility.lisp       |  6 ++----
 concatenate-source.lisp  |  5 +++--
 defsystem.lisp           |  4 ++--
 header.lisp              |  2 +-
 interface.lisp           |  4 +++-
 lisp-action.lisp         |  2 +-
 os.lisp                  |  2 +-
 output-translations.lisp |  2 +-
 package.lisp             | 24 +++++++++++++++++-------
 source-registry.lisp     |  8 ++++++--
 system.lisp              | 10 +++++-----
 test/run-tests.sh        |  2 +-
 test/script-support.lisp |  7 +++++--
 upgrade.lisp             |  7 +++++--
 utility.lisp             |  1 +
 version.lisp-expr        |  2 +-
 18 files changed, 57 insertions(+), 35 deletions(-)

diff --git a/action.lisp b/action.lisp
index 247569753..61eeb7760 100644
--- a/action.lisp
+++ b/action.lisp
@@ -19,7 +19,7 @@
    #:input-files #:output-files #:output-file #:operation-done-p
    #:action-status #:action-stamp #:action-done-p
    #:component-operation-time #:mark-operation-done #:compute-action-stamp
-   #:perform #:perform-with-restarts #:retry #:accept))
+   #:perform #:perform-with-restarts #:retry #:accept #:feature))
 (in-package :asdf/action)
 
 (deftype action () '(cons operation component)) ;; a step to be performed while building the system
diff --git a/asdf.asd b/asdf.asd
index ff40eae52..2a0e709d9 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.92" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.93" ;; 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 generate-asdf))))
diff --git a/compatibility.lisp b/compatibility.lisp
index f5b62c6df..c7304306d 100644
--- a/compatibility.lisp
+++ b/compatibility.lisp
@@ -35,14 +35,12 @@
 
 #+allegro
 (eval-when (:load-toplevel :compile-toplevel :execute)
-  (setf excl::*autoload-package-name-alist*
-        (remove "asdf" excl::*autoload-package-name-alist*
-                :test 'equalp :key 'car)) ; need that BEFORE any mention of package ASDF as below
   (defparameter *acl-warn-save*
     (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
       excl:*warn-on-nested-reader-conditionals*))
   (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
-    (setf excl:*warn-on-nested-reader-conditionals* nil)))
+    (setf excl:*warn-on-nested-reader-conditionals* nil))
+  (setf *print-readably* nil))
 
 #+ecl
 (eval-when (:load-toplevel :compile-toplevel :execute)
diff --git a/concatenate-source.lisp b/concatenate-source.lisp
index 2a1a0b60b..fa784368d 100644
--- a/concatenate-source.lisp
+++ b/concatenate-source.lisp
@@ -5,8 +5,9 @@
   (:recycle :asdf/concatenate-source :asdf)
   (:intern #:translate-output-p #:concatenated-source-file)
   (:use :common-lisp :asdf/utility :asdf/stream
-        :asdf/component :asdf/operation :asdf/system :asdf/find-system :asdf/defsystem
-        :asdf/action :asdf/lisp-action :asdf/bundle)
+   :asdf/upgrade :asdf/component :asdf/operation
+   :asdf/system :asdf/find-system :asdf/defsystem
+   :asdf/action :asdf/lisp-action :asdf/bundle)
   (:export
    #:concatenate-source-op
    #:load-concatenated-source-op
diff --git a/defsystem.lisp b/defsystem.lisp
index 8efea30a8..d1a2f2f22 100644
--- a/defsystem.lisp
+++ b/defsystem.lisp
@@ -4,8 +4,8 @@
 (asdf/package:define-package :asdf/defsystem
   (:recycle :asdf/defsystem :asdf)
   (:use :common-lisp :asdf/utility :asdf/pathname :asdf/stream
-   :asdf/component :asdf/system :asdf/find-system :asdf/find-component
-   :asdf/lisp-action :asdf/operate
+   :asdf/upgrade :asdf/component :asdf/system
+   :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/operate
    :asdf/backward-internals)
   #+gcl<2.7 (:shadowing-import-from :asdf/compatibility #:type-of)
   (:export
diff --git a/header.lisp b/header.lisp
index 360abf0b1..efc53eb15 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.92: Another System Definition Facility.
+;;; This is ASDF 2.26.93: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
diff --git a/interface.lisp b/interface.lisp
index 5f4544cdc..1a5e77e36 100644
--- a/interface.lisp
+++ b/interface.lisp
@@ -5,7 +5,7 @@
   (:nicknames :asdf :asdf-utilities)
   (:recycle :asdf/interface :asdf)
   (:unintern
-   #:*asdf-revision* #:around #:asdf-method-combination #:intern*
+   #:*asdf-revision* #:around #:asdf-method-combination
    #:do-traverse #:do-dep #:do-one-dep #:visit-action #:component-visited-p
    #:split #:make-collector
    #:loaded-systems ; makes for annoying SLIME completion
@@ -17,6 +17,8 @@
    :asdf/output-translations :asdf/source-registry
    :asdf/plan :asdf/operate :asdf/defsystem :asdf/bundle :asdf/concatenate-source
    :asdf/backward-interface)
+  (:shadowing-import-from :asdf/package
+   :find-symbol* #:intern*)
   ;; TODO: automatically generate interface by merging select used packages?
   (:export
    #:defsystem #:find-system #:locate-system #:coerce-name
diff --git a/lisp-action.lisp b/lisp-action.lisp
index 70911cb63..95835092a 100644
--- a/lisp-action.lisp
+++ b/lisp-action.lisp
@@ -5,7 +5,7 @@
   (:recycle :asdf/lisp-action :asdf)
   (:intern #:proclamations #:flags)
   (:use :common-lisp :asdf/compatibility :asdf/utility :asdf/lisp-build
-   :asdf/component :asdf/system :asdf/find-component :asdf/operation :asdf/action)
+   :asdf/upgrade :asdf/component :asdf/system :asdf/find-component :asdf/operation :asdf/action)
   (:export
    #:compile-error #:compile-failed #:compile-warned #:try-recompiling
    #:cl-source-file #:cl-source-file.cl #:cl-source-file.lsp
diff --git a/os.lisp b/os.lisp
index 253e17d0b..6b2c037c2 100644
--- a/os.lisp
+++ b/os.lisp
@@ -199,7 +199,7 @@ then returning the non-empty string value of the variable"
   ;; Note: untested on RMCL
   #+(or abcl clozure cmucl ecl genera lispworks mcl mkcl sbcl scl xcl) (machine-instance)
   #+cormanlisp "localhost" ;; is there a better way? Does it matter?
-  #+allegro (excl.osi:gethostname)
+  #+allegro (symbol-call :excl.osi :gethostname)
   #+clisp (first (split-string (machine-instance) :separator " "))
   #+gcl (system:gethostname))
 
diff --git a/output-translations.lisp b/output-translations.lisp
index f4702b5b7..fd0d60c09 100644
--- a/output-translations.lisp
+++ b/output-translations.lisp
@@ -5,7 +5,7 @@
   (:recycle :asdf/output-translations :asdf)
   (:use :common-lisp :asdf/utility :asdf/pathname :asdf/os :asdf/lisp-build :asdf/upgrade :asdf/configuration)
   (:export
-   #:*output-translations* #:*output-translation-parameter*
+   #:*output-translations* #:*output-translations-parameter*
    #:invalid-output-translation
    #:output-translations #:output-translations-initialized-p
    #:initialize-output-translations #:clear-output-translations
diff --git a/package.lisp b/package.lisp
index 905a8aabd..cc5472b19 100644
--- a/package.lisp
+++ b/package.lisp
@@ -284,11 +284,14 @@ or when loading the package is optional."
 ;;; ensure-package, define-package
 
 (eval-when (:load-toplevel :compile-toplevel :execute)
-  (defvar *all-package-fishiness* '(t))
+  (defvar *all-package-happiness* '())
+  (defvar *all-package-fishiness* (list t))
   (defvar *package-fishiness* '())
   (defun flush-fishy ()
     (when *package-fishiness*
-      (push (nreverse *package-fishiness*) *all-package-fishiness*)
+      (if (null (rest *package-fishiness*))
+          (push (first *package-fishiness*) *all-package-happiness*)
+          (push (nreverse *package-fishiness*) *all-package-fishiness*))
       (setf *package-fishiness* nil)))
   (defun record-fishy (info)
     (push info *package-fishiness*))
@@ -570,9 +573,16 @@ or when loading the package is optional."
                (foo))
      (apply 'ensure-package ',(parse-define-package-form package clauses))))
 
-#+clisp
-(eval-when (:compile-toplevel :load-toplevel :execute)
+
+;;; Final tricks to keep various implementations happier
+(eval-when (:load-toplevel :compile-toplevel :execute)
+  #+allegro
+  (setf excl::*autoload-package-name-alist*
+        (remove "asdf" excl::*autoload-package-name-alist*
+                :test 'equalp :key 'car)) ; We need that BEFORE any mention of package ASDF.
   (unless (member :asdf2.27 *features*)
-    (when (find-package :asdf)
-      (delete-package* :asdf t))
-    (make-package :asdf :use ())))
+    #+clisp
+    (progn
+      (when (find-package :asdf)
+        (delete-package* :asdf t))
+      (make-package :asdf :use ()))))
diff --git a/source-registry.lisp b/source-registry.lisp
index b5de6f38c..47b08c54c 100644
--- a/source-registry.lisp
+++ b/source-registry.lisp
@@ -289,10 +289,14 @@ with a different configuration, so the configuration would be re-read then."
 (defvar *source-registry-parameter* nil)
 
 (defun* initialize-source-registry (&optional (parameter *source-registry-parameter*))
-  #-clisp ;; CLISP really hates our package munging. Don't try to load it twice.
-  (setf *asdf-upgrade-already-attempted* nil) ;; in case a new ASDF appears in the registry
+  ;; In case we haven't upgraded ASDF yet, and it appears in the registry,
+  ;; clear the upgrade attempt flag:
+  (setf *asdf-upgrade-already-attempted* (not *upgraded-p*))
+  ;; Record the parameter used to configure the registry 
   (setf *source-registry-parameter* parameter)
+  ;; Clear the previous registry database:
   (setf *source-registry* (make-hash-table :test 'equal))
+  ;; Do it!
   (compute-source-registry parameter))
 
 ;; Checks an initial variable to see whether the state is initialized
diff --git a/system.lisp b/system.lisp
index c8d15b251..ef8b86a24 100644
--- a/system.lisp
+++ b/system.lisp
@@ -83,13 +83,13 @@
 (defclass proto-system () ; slots to keep when resetting a system
   ;; To preserve identity for all objects, we'd need keep the components slots
   ;; but also to modify parse-component-form to reset the recycled objects.
-  ((asdf/component::name) (source-file) #|(children) (children-by-names)|#))
+  ((name) (source-file) #|(children) (children-by-names)|#))
 
 (defclass system (module proto-system)
   ;; Backward-compatibility: inherit from module. ASDF3: only inherit from parent-component.
   (;; {,long-}description is now inherited from component, but we add the legacy accessors
-   (asdf/component::description :accessor system-description)
-   (asdf/component::long-description :accessor system-long-description)
+   (description :accessor system-description)
+   (long-description :accessor system-long-description)
    (author :accessor system-author :initarg :author)
    (maintainer :accessor system-maintainer :initarg :maintainer)
    (licence :accessor system-licence :initarg :licence
@@ -105,8 +105,8 @@
 ;;;; Pathnames
 
 (defmethod component-pathname ((system system))
-  (if (or (slot-boundp system 'asdf/component::relative-pathname)
-            (slot-boundp system 'asdf/component::absolute-pathname)
+  (if (or (slot-boundp system 'relative-pathname)
+            (slot-boundp system 'absolute-pathname)
             (slot-value system 'source-file))
     (call-next-method)
     (default-directory)))
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 1d5126547..d8969012a 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -114,7 +114,7 @@ case "$lisp" in
     eval="--eval" ;;
   allegro)
     command="${ALLEGRO:-alisp}"
-    flags="-q"
+    #flags="-q"
     nodebug="-batch"
     eval="-e" ;;
   allegromodern)
diff --git a/test/script-support.lisp b/test/script-support.lisp
index fa179cff3..5393fa8ec 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -40,8 +40,11 @@ Some constraints:
 
 ;;; Minimal compatibility layer
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  #+allegro (setf excl:*warn-on-nested-reader-conditionals* nil)
-
+  #+allegro
+  (setf excl:*warn-on-nested-reader-conditionals* nil
+        excl::*autoload-package-name-alist*
+        (remove "asdf" excl::*autoload-package-name-alist*
+                :test 'equalp :key 'car)) ; We need that BEFORE any mention of package ASDF.
   #+gcl
   (when (or (< system::*gcl-major-version* 2)
             (and (= system::*gcl-major-version* 2)
diff --git a/upgrade.lisp b/upgrade.lisp
index 90bcf1d45..ea5b1744c 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -10,7 +10,10 @@
    #:*asdf-upgrade-already-attempted*
    #:*post-upgrade-cleanup-hook* #:*post-upgrade-restart-hook* #:cleanup-upgraded-asdf
    #:asdf-version #:*upgraded-p*
-   #:asdf-message #:*asdf-verbose* #:*verbose-out*))
+   #:asdf-message #:*asdf-verbose* #:*verbose-out*
+   ;; There will be no symbol left behind!
+   #:o #:c #:dep-o #:dep-c #:intern*)
+  (:import-from :asdf/package #:intern* #:find-symbol*))
 (in-package :asdf/upgrade)
 
 ;;; Special magic to detect if this is an upgrade
@@ -32,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.92")
+         (asdf-version "2.26.93")
          (existing-asdf (find-class (find-symbol* :component :asdf nil) nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
diff --git a/utility.lisp b/utility.lisp
index 9d03d59fc..b42f24f23 100644
--- a/utility.lisp
+++ b/utility.lisp
@@ -51,6 +51,7 @@
     ((defdef (def* def)
        `(defmacro ,def* (name formals &rest rest)
           `(progn
+             #-clisp ;; clisp is unhappy about fmakunbound.
              (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 f27308924..91cc49c04 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.92"
+"2.26.93"
-- 
GitLab