From faae2d80e535db0836a833ce62be70b2387970fb Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sat, 2 Mar 2013 22:18:40 -0500
Subject: [PATCH] 2.31.7: Package issues.

Another pass package upgrade.
Export FEATURE from correct package.
Use package :asdf-user when reading file for version.
---
 TODO                       |   1 +
 action.lisp                |   2 +-
 asdf.asd                   |   2 +-
 defsystem.lisp             |   2 +-
 header.lisp                |   2 +-
 package.lisp               | 102 +++++++++++++++++++++++--------------
 test/test-utilities.script |   2 +-
 upgrade.lisp               |   2 +-
 version.lisp-expr          |   2 +-
 9 files changed, 72 insertions(+), 45 deletions(-)

diff --git a/TODO b/TODO
index 4b9540fd..1bf7b141 100644
--- a/TODO
+++ b/TODO
@@ -1,3 +1,4 @@
+* make sure asdf-driver works with asdf 2.26.
 * have a mode to explain WHY a module needs to be recompiled.
 * have a better defsystem form verifier - see lp#1007335
 * have a function verify-strict-asd that can verify a asd is pure lp#541562
diff --git a/action.lisp b/action.lisp
index 773cd836..8edf15e1 100644
--- a/action.lisp
+++ b/action.lisp
@@ -14,7 +14,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 #:feature
+   #:perform #:perform-with-restarts #:retry #:accept
    #:traverse-actions #:traverse-sub-actions #:required-components ;; in plan
    #:action-path #:find-action #:stamp #:done-p))
 (in-package :asdf/action)
diff --git a/asdf.asd b/asdf.asd
index abaea87c..f35a58fd 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.31.6" ;; to be automatically updated by make bump-version
+  :version "2.31.7" ;; 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/defsystem.lisp b/defsystem.lisp
index 1bbdfb39..7bcfbf49 100644
--- a/defsystem.lisp
+++ b/defsystem.lisp
@@ -105,7 +105,7 @@
                     (case (first form)
                       ((:read-file-form)
                        (destructuring-bind (subpath &key (at 0)) (rest form)
-                         (safe-read-file-form (subpathname pathname subpath) :at at)))
+                         (safe-read-file-form (subpathname pathname subpath) :at at :package :asdf-user)))
                       ((:read-file-line)
                        (destructuring-bind (subpath &key (at 0)) (rest form)
                          (read-file-lines (subpathname pathname subpath) :at at)))
diff --git a/header.lisp b/header.lisp
index 7695337e..6b0ff7dc 100644
--- a/header.lisp
+++ b/header.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
-;;; This is ASDF 2.31.6: Another System Definition Facility.
+;;; This is ASDF 2.31.7: 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 a16e38e3..4ede7a31 100644
--- a/package.lisp
+++ b/package.lisp
@@ -3,14 +3,14 @@
 ;;
 ;; See https://bugs.launchpad.net/asdf/+bug/485687
 ;;
-;; CAUTION: we must handle the first few packages specially for hot-upgrade.
-;; asdf/package will be frozen as of ASDF 3
-;; to forever export the same exact symbols.
-;; Any other symbol must be import-from'ed
-;; and reexported in a different package
-;; (alternatively the package may be dropped & replaced by one with a new name).
 
 (defpackage :asdf/package
+  ;; CAUTION: we must handle the first few packages specially for hot-upgrade.
+  ;; This package definition MUST NOT change unless its name too changes;
+  ;; if/when it changes, don't forget to add new functions missing from below.
+  ;; Until then, asdf/package is frozen to forever
+  ;; import and export the same exact symbols as for ASDF 2.27.
+  ;; Any other symbol must be import-from'ed and re-export'ed in a different package.
   (:use :common-lisp)
   (:export
    #:find-package* #:find-symbol* #:symbol-call
@@ -61,6 +61,12 @@ or when loading the package is optional."
     (let* ((package (find-package* package-designator))
            (symbol (intern* name package)))
       (export (or symbol (list symbol)) package)))
+  (defun import* (symbol package-designator)
+    (import (or symbol (list symbol)) (find-package* package-designator)))
+  (defun shadowing-import* (symbol package-designator)
+    (shadowing-import (or symbol (list symbol)) (find-package* package-designator)))
+  (defun shadow* (name package-designator)
+    (shadow (string name) (find-package* package-designator)))
   (defun make-symbol* (name)
     (etypecase name
       (string (make-symbol name))
@@ -179,8 +185,8 @@ or when loading the package is optional."
       (multiple-value-bind (sym stat) (find-symbol name package)
         (when (and (member stat '(:internal :external)) (eq symbol sym))
           (if (symbol-shadowing-p symbol package)
-              (shadowing-import (get-dummy-symbol symbol) package)
-              (unintern symbol package))))))
+              (shadowing-import* (get-dummy-symbol symbol) package)
+              (unintern* symbol package))))))
   (defun nuke-symbol (symbol &optional (packages (list-all-packages)))
     #+(or clisp clozure)
     (multiple-value-bind (setf-symbol kind)
@@ -205,18 +211,18 @@ or when loading the package is optional."
              (package-name package) overwritten-symbol-status overwritten-symbol-shadowing-p)
             (when old-package
               (if shadowing
-                  (shadowing-import shadowing old-package))
-              (unintern symbol old-package))
+                  (shadowing-import* shadowing old-package))
+              (unintern* symbol old-package))
             (cond
               (overwritten-symbol-shadowing-p
-               (shadowing-import symbol package))
+               (shadowing-import* symbol package))
               (t
                (when overwritten-symbol-status
-                 (unintern overwritten-symbol package))
-               (import symbol package)))
+                 (unintern* overwritten-symbol package))
+               (import* symbol package)))
             (if shadowing
-                (shadowing-import symbol old-package)
-                (import symbol old-package))
+                (shadowing-import* symbol old-package)
+                (import* symbol old-package))
             #+(or clisp clozure)
             (multiple-value-bind (setf-symbol kind)
                 (get-setf-function-symbol symbol)
@@ -229,7 +235,7 @@ or when loading the package is optional."
                    (symbol-name setf-symbol) (symbol-package-name setf-symbol)
                    (symbol-name new-setf-symbol) (symbol-package-name new-setf-symbol))
                   (when (symbol-package setf-symbol)
-                    (unintern setf-symbol (symbol-package setf-symbol)))
+                    (unintern* setf-symbol (symbol-package setf-symbol)))
                   (setf (fdefinition new-setf-symbol) setf-function)
                   (set-setf-function-symbol new-setf-symbol symbol kind))))
             #+(or clisp clozure)
@@ -356,7 +362,34 @@ or when loading the package is optional."
               (or (home-package-p import-me from-package) (symbol-package-name import-me))
               (package-name to-package) status
               (and status (or (home-package-p existing to-package) (symbol-package-name existing)))))
-           (shadowing-import import-me to-package))))))
+           (shadowing-import* import-me to-package))))))
+  (defun ensure-imported (import-me into-package &optional from-package)
+    (check-type import-me symbol)
+    (check-type into-package package)
+    (check-type from-package (or null package))
+    (let ((name (symbol-name import-me)))
+      (multiple-value-bind (existing status) (find-symbol name into-package)
+        (cond
+          ((not status)
+           (import* import-me into-package))
+          ((eq import-me existing))
+          (t
+           (let ((shadowing-p (symbol-shadowing-p existing into-package)))
+             (note-package-fishiness
+              :ensure-imported name
+              (and from-package (package-name from-package))
+              (or (home-package-p import-me from-package) (symbol-package-name import-me))
+              (package-name into-package)
+              status
+              (and status (or (home-package-p existing into-package) (symbol-package-name existing)))
+              shadowing-p)
+             (cond
+               ((or shadowing-p (eq status :inherited))
+                (shadowing-import* import-me into-package))
+               (t
+                (unintern* existing into-package)
+                (import* import-me into-package))))))))
+    (values))
   (defun ensure-import (name to-package from-package shadowed imported)
     (check-type name string)
     (check-type to-package package)
@@ -367,27 +400,18 @@ or when loading the package is optional."
       (when (null import-status)
         (note-package-fishiness
          :import-uninterned name (package-name from-package) (package-name to-package))
-        (setf import-me (intern name from-package)))
+        (setf import-me (intern* name from-package)))
       (multiple-value-bind (existing status) (find-symbol name to-package)
         (cond
-          ((gethash name imported)
-           (unless (eq import-me existing)
+          ((and imported (gethash name imported))
+           (unless (and status (eq import-me existing))
              (error "Can't import ~S from both ~S and ~S"
                     name (package-name (symbol-package existing)) (package-name from-package))))
           ((gethash name shadowed)
            (error "Can't both shadow ~S and import it from ~S" name (package-name from-package)))
           (t
-           (setf (gethash name imported) t)
-           (unless (and status (eq import-me existing))
-             (when status
-               (note-package-fishiness
-                :import name
-                (package-name from-package)
-                (or (home-package-p import-me from-package) (symbol-package-name import-me))
-                (package-name to-package) status
-                (and status (or (home-package-p existing to-package) (symbol-package-name existing))))
-               (unintern* existing to-package))
-             (import import-me to-package)))))))
+           (setf (gethash name imported) t))))
+      (ensure-imported import-me to-package from-package)))
   (defun ensure-inherited (name symbol to-package from-package mixp shadowed imported inherited)
     (check-type name string)
     (check-type symbol symbol)
@@ -405,7 +429,7 @@ or when loading the package is optional."
           (note-package-fishiness
            :import-uninterned name
            (package-name from-package) (package-name to-package) mixp)
-          (import symbol from-package)
+          (import* symbol from-package)
           (setf sp (package-name from-package)))
         (cond
           ((gethash name shadowed))
@@ -478,7 +502,7 @@ or when loading the package is optional."
   (defun symbol-recycled-p (sym recycle)
     (check-type sym symbol)
     (check-type recycle list)
-    (member (symbol-package sym) recycle))
+    (and (member (symbol-package sym) recycle) t))
   (defun ensure-symbol (name package intern recycle shadowed imported inherited exported)
     (check-type name string)
     (check-type package package)
@@ -512,6 +536,7 @@ or when loading the package is optional."
     (check-type symbol symbol)
     (check-type to-package package)
     (check-type recycle list)
+    (assert (equal name (symbol-name symbol)))
     (multiple-value-bind (existing status) (find-symbol name to-package)
       (unless (and status (eq symbol existing))
         (let ((accessible
@@ -525,7 +550,7 @@ or when loading the package is optional."
                          (or (home-package-p existing to-package) (symbol-package-name existing))
                          status shadowing)
                         (if (or (eq status :inherited) shadowing)
-                            (shadowing-import symbol to-package)
+                            (shadowing-import* symbol to-package)
                             (unintern existing to-package))
                         t)))))
           (when (and accessible (eq status :external))
@@ -533,7 +558,8 @@ or when loading the package is optional."
   (defun ensure-exported (name symbol from-package &optional recycle)
     (dolist (to-package (package-used-by-list from-package))
       (ensure-exported-to-user name symbol to-package recycle))
-    (import symbol from-package)
+    (unless (eq from-package (symbol-package symbol))
+      (ensure-imported symbol from-package))
     (export* name from-package))
   (defun ensure-export (name from-package &optional recycle)
     (multiple-value-bind (symbol status) (find-symbol* name from-package)
@@ -615,9 +641,9 @@ or when loading the package is optional."
                    (note-package-fishiness
                     :shadow-imported (package-name package) name
                     (symbol-package-name existing) status shadowing)
-                   (shadowing-import dummy package)
-                   (import dummy package)))))))
-        (shadow name package))
+                   (shadowing-import* dummy package)
+                   (import* dummy package)))))))
+        (shadow* name package))
       (loop :for (p . syms) :in shadowing-import-from
             :for pp = (find-package* p) :do
               (dolist (sym syms) (ensure-shadowing-import (string sym) package pp shadowed imported)))
diff --git a/test/test-utilities.script b/test/test-utilities.script
index 971543e8..00741ca1 100644
--- a/test/test-utilities.script
+++ b/test/test-utilities.script
@@ -79,7 +79,6 @@
     asdf/action:accept
     asdf/action:action
     asdf/action:done-p
-    asdf/action:feature
     asdf/action:stamp
     asdf/bundle:prologue-code
     asdf/bundle:build-args
@@ -110,6 +109,7 @@
     asdf/component:sibling-dependencies
     asdf/component:version
     asdf/lisp-action:flags
+    asdf/operation:feature
     asdf/plan:index
     asdf/plan:forced
     asdf/plan:forced-not
diff --git a/upgrade.lisp b/upgrade.lisp
index 88356cfd..71914c78 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -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.6")
+         (asdf-version "2.31.7")
          (existing-version (asdf-version)))
     (setf *asdf-version* asdf-version)
     (when (and existing-version (not (equal asdf-version existing-version)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 173f1f81..bd240890 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.31.6"
+"2.31.7"
-- 
GitLab