From 7169b79451ff02055ed54376bde25f9d941e5340 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <fare@tunes.org>
Date: Tue, 15 May 2012 06:17:26 -0400
Subject: [PATCH] 2.21.2: Improve the way default-component-class is
 initialized following discussion with Nikodemus on asdf-devel. Also, improve
 the way we test for upgrade. Disable upgrade test on cmucl from asdf 2.00*.
 Restore -i.bak flag in bump-version: it's actually needed.

---
 Makefile                 | 42 +++++++++++++++-------------------
 asdf.asd                 |  2 +-
 asdf.lisp                | 21 ++++++++---------
 bin/bump-version         |  4 ++--
 test/script-support.lisp | 49 ++++++++++++++++++++++++++++++++++++++++
 5 files changed, 80 insertions(+), 38 deletions(-)

diff --git a/Makefile b/Makefile
index bf1639b2a..539bf284b 100644
--- a/Makefile
+++ b/Makefile
@@ -83,24 +83,17 @@ mrproper: clean
 
 test-upgrade:
 	fasl=fasl ; \
-	use_ccl () { li="${CCL} --no-init --quiet" ; ev="--eval" ; fasl=lx86fsl ; } ; \
-	use_clisp () { li="${CLISP} -norc -ansi --quiet --quiet" ; ev="-x" ; fasl=fas ; } ; \
-	use_sbcl () { li="${SBCL} --noinform --no-userinit" ; ev="--eval" ; fasl=fasl ; } ; \
-	use_ecl () { li="${ECL} -norc" ; ev="-eval" ; fasl=fas ; } ; \
-	use_cmucl () { li="${CMUCL} -noinit" ; ev="-eval" ; fasl=sse2f ; } ; \
-	use_abcl () { li="${ABCL} --noinit --nosystem --noinform" ; ev="--eval" ; fasl=fasl ; } ; \
-	use_scl () { li="${SCL} -noinit" ; ev="-eval" ; fasl=sse2f ; } ; \
-	use_allegro () { li="${ALLEGRO} -q" ; ev="-e" ; fasl=fas ; } ; \
-	use_allegromodern () { li="${ALLEGROMODERN} -q" ; ev="-e" ; fasl=fas ; } ; \
-	use_lispworks () { li="${LISPWORKS} -siteinit - -init -" ; ev="-eval" ; fasl=ufasl ; } ; \
+	use_ccl () { li="${CCL} --no-init --quiet" ; ev="--eval" ; } ; \
+	use_clisp () { li="${CLISP} -norc -ansi --quiet --quiet" ; ev="-x" ; } ; \
+	use_sbcl () { li="${SBCL} --noinform --no-userinit" ; ev="--eval" ; } ; \
+	use_ecl () { li="${ECL} -norc" ; ev="-eval" ; } ; \
+	use_cmucl () { li="${CMUCL} -noinit" ; ev="-eval" ; } ; \
+	use_abcl () { li="${ABCL} --noinit --nosystem --noinform" ; ev="--eval" ; } ; \
+	use_scl () { li="${SCL} -noinit" ; ev="-eval" ; } ; \
+	use_allegro () { li="${ALLEGRO} -q" ; ev="-e" ; } ; \
+	use_allegromodern () { li="${ALLEGROMODERN} -q" ; ev="-e" ; } ; \
+	use_lispworks () { li="${LISPWORKS} -siteinit - -init -" ; ev="-eval" ; } ; \
 	use_${lisp} ; \
-	mkdir -p tmp/fasls/${lisp} ; \
-	fa=tmp/fasls/${lisp}/upasdf.$${fasl} ; \
-	ll="(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning)) (format t \"ll~%\") (load \"asdf.lisp\"))" ; \
-	cf="(handler-bind ((warning #'muffle-warning)) (format t \"cf~%\") (compile-file \"asdf.lisp\" :output-file \"$$fa\" :verbose t :print t))" ; \
-	lf="(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning)) (format t \"lf\") (load \"$$fa\" :verbose t :print t))" ; \
-	la="(handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning)) (format t \"la\") (push #p\"${sourceDirectory}/\" asdf:*central-registry*) (asdf:oos 'asdf:load-op :asdf :verbose t))" ; \
-	te="(asdf-test::quit-on-error $$l (push #p\"${sourceDirectory}/test/\" asdf:*central-registry*) (princ \"te\") (asdf:oos 'asdf:load-op :test-module-depend :verbose t))" ; \
 	su=test/script-support ; lu="(load\"$$su\")" ; \
 	lv="$$li $$ev $$lu $$ev" ; \
 	for tag in 1.37 1.97 1.369 `git tag -l '2.0??'` `git tag -l '2.??'` ; do \
@@ -112,16 +105,17 @@ test-upgrade:
 	    case ${lisp}:$$tag:$$x in \
 	      ecl:1.*|ecl:2.00*|ecl:2.01[0-6]:*|ecl:2.20:*) \
 		: Skip, because of various ASDF issues ;; \
-	      cmucl:1.*) \
+	      cmucl:1.*|cmucl:2.00*) \
 		: Skip, CMUCL cannot upgrade from ASDF 1. Happily, it ships ASDF 2 ;; \
 	      *) (set -x ; \
                   case $$x in \
-		    load-system) $$lv "$$lo" $$ev "$$la" $$ev "$$te" ;; \
-		    load-lisp) $$lv "$$lo" $$ev "$$ll" $$ev "$$te" ;; \
-		    load-lisp-compile-load-fasl) $$lv "$$lo" $$ev "$$ll" $$ev "$$cf" $$ev "$$lf" $$ev "$$te" ;; \
-		    load-fasl) $$lv "$$lo" $$ev "$$lf" $$ev "$$te" ;; \
-		    just-load-fasl) $$lv "$$lf" $$ev "$$te" ;; \
-		    *) echo "WTF?" ; exit 2 ;; esac ) || \
+		    load-system) l="$$lo (asdf-test::load-asdf-system)" ;; \
+		    load-lisp) l="$$lo (asdf-test::load-asdf-lisp)" ;; \
+		    load-lisp-compile-load-fasl) l="$$lo (asdf-test::compile-load-asdf)" ;; \
+		    load-fasl) l="$$lo (asdf-test::load-asdf-fasl)" ;; \
+		    just-load-fasl) l="(asdf-test::load-asdf-fasl)" ;; \
+		    *) echo "WTF?" ; exit 2 ;; esac ; \
+		  $$lv "(asdf-test::test-asdf $$l)" ) || \
 		{ echo "upgrade FAILED" ; exit 1 ;} ;; esac ; \
 	done ; done
 
diff --git a/asdf.asd b/asdf.asd
index 07e16e7ca..1e8a007bf 100644
--- a/asdf.asd
+++ b/asdf.asd
@@ -14,7 +14,7 @@
   :licence "MIT"
   :description "Another System Definition Facility"
   :long-description "ASDF builds Common Lisp software organized into defined systems."
-  :version "2.21.1" ;; to be automatically updated by bin/bump-revision
+  :version "2.21.2" ;; to be automatically updated by bin/bump-revision
   :depends-on ()
   :components
   ((:file "asdf")
diff --git a/asdf.lisp b/asdf.lisp
index c7e20e453..11ffd1674 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,5 +1,5 @@
 ;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.21.1: Another System Definition Facility.
+;;; This is ASDF 2.21.2: Another System Definition Facility.
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome:
 ;;; please mail to <asdf-devel@common-lisp.net>.
@@ -116,7 +116,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.21.1")
+         (asdf-version "2.21.2")
          (existing-asdf (find-class 'component nil))
          (existing-version *asdf-version*)
          (already-there (equal asdf-version existing-version)))
@@ -1343,7 +1343,7 @@ processed in order by OPERATE."))
     :initarg :if-component-dep-fails
     :accessor module-if-component-dep-fails)
    (default-component-class
-    :initform *default-component-class*
+    :initform nil
     :initarg :default-component-class
     :accessor module-default-component-class)))
 
@@ -2799,8 +2799,11 @@ details."
                                  class (find-class 'component)))
         :return class)
       (and (eq type :file)
-           (or (and parent (module-default-component-class parent))
-               (find-class *default-component-class*)))
+           (aif
+            (or (loop :for module = parent :then (component-parent module) :while module
+                  :thereis (module-default-component-class module))
+                *default-component-class*)
+            (find-class it)))
       (sysdef-error "don't recognize component type ~A" type)))
 
 (defun* maybe-add-tree (tree op1 op2 c)
@@ -2886,7 +2889,7 @@ Returns the new tree (which probably shares structure with the old one)"
         (type name &rest rest &key
               ;; the following list of keywords is reproduced below in the
               ;; remove-keys form.  important to keep them in sync
-              components pathname default-component-class
+              components pathname
               perform explain output-files operation-done-p
               weakly-depends-on depends-on serial in-order-to
               do-first
@@ -2913,7 +2916,7 @@ Returns the new tree (which probably shares structure with the old one)"
                         :pathname pathname
                         :parent parent
                         (remove-keys
-                         '(components pathname default-component-class
+                         '(components pathname
                            perform explain output-files operation-done-p
                            weakly-depends-on depends-on serial in-order-to)
                          rest)))
@@ -2927,10 +2930,6 @@ Returns the new tree (which probably shares structure with the old one)"
           (setf ret (apply 'make-instance (class-for-type parent type) args)))
       (component-pathname ret) ; eagerly compute the absolute pathname
       (when (typep ret 'module)
-        (setf (module-default-component-class ret)
-              (or default-component-class
-                  (and (typep parent 'module)
-                       (module-default-component-class parent))))
         (let ((*serial-depends-on* nil))
           (setf (module-components ret)
                 (loop
diff --git a/bin/bump-version b/bin/bump-version
index 0582b9cc7..f37226570 100755
--- a/bin/bump-version
+++ b/bin/bump-version
@@ -13,8 +13,8 @@ if [ -z "$NEWVER" ] ; then
   NEWVER="$(echo $OLDVER | perl -npe 's/([0-9].[0-9]+)(\.([0-9]+))?/"${1}.".($3+1)/e')"
 fi
 echo "Setting ASDF version to $NEWVER"
-perl -npe 's/^(         \(asdf-version "|;;; This is ASDF )[0-9.]+("\)|:)/${1}'"$NEWVER"'${2}/' $ASDFLISP
-perl -npe 's/^(  :version ")[0-9.]+(")/${1}'"$NEWVER"'${2}/' $ASDFASD
+perl -i.bak -npe 's/^(         \(asdf-version "|;;; This is ASDF )[0-9.]+("\)|:)/${1}'"$NEWVER"'${2}/' $ASDFLISP
+perl -i.bak -npe 's/^(  :version ")[0-9.]+(")/${1}'"$NEWVER"'${2}/' $ASDFASD
 cat<<EOF
 To complete the version change, you may:
 	git add -u
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 1bda759bd..16a42a477 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -114,3 +114,52 @@ is bound, write a message and exit on an error.  If
                    (leave-lisp "~&Script failed~%" 1))))))
     (funcall thunk)
     (leave-lisp "~&Script succeeded~%" 0)))
+
+
+;;; These are used by the upgrade tests
+
+(defmacro quietly (&body body)
+  `(call-quietly #'(lambda () ,@body)))
+
+(defun call-quietly (thunk)
+  (handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
+    (funcall thunk)))
+
+(defun load-asdf-lisp ()
+  (load *asdf-lisp*))
+
+(defun compile-asdf ()
+  (ensure-directories-exist *asdf-fasl*)
+  (compile-file *asdf-lisp* :output-file *asdf-fasl* :verbose t :print t))
+
+(defun load-asdf-fasl ()
+  (load *asdf-fasl*))
+
+(defun compile-load-asdf ()
+  ;; emulate the way asdf upgrades itself: load source, compile, load fasl.
+  (load-asdf-lisp)
+  (compile-asdf)
+  (load-asdf-fasl))
+
+(defun register-directory (dir)
+  (pushnew dir (symbol-value (find-symbol (string :*central-registry*) :asdf))))
+
+(defun asdf-load (x)
+  (let ((xoos (find-symbol (string :oos) :asdf))
+        (xload-op (find-symbol (string :load-op) :asdf)))
+    (funcall xoos xload-op x :verbose t)))
+
+(defun load-asdf-system ()
+  (quietly
+   (register-directory *asdf-directory*)
+   (asdf-load :asdf)))
+
+(defun testing-asdf (thunk)
+  (quit-on-error
+   (quietly
+    (funcall thunk)
+    (register-directory *test-directory*)
+    (asdf-load :test-module-depend))))
+
+(defmacro test-asdf (&body body)
+  `(testing-asdf #'(lambda () ,@body)))
-- 
GitLab