From a730852adeadff02628bf6925b63efaccd6b5794 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Thu, 17 Jan 2013 23:11:38 -0500
Subject: [PATCH] 2.26.106: a new primary/secondary convention for subsystems
 and more

A system named foo/bar will be looked up in a registered file foo.asd.
This makes it possible to sensibly name several systems in a .asd file
and still have asdf find them all by name.
We now use it to not have the asdf header be part of asdf-driver.

A new generic operation build-op makes it possible to deal with
the fact that the default operation for systems need not be load-op,
yet that the end-user does not want to have to know the exact operation
for each of the system he uses.

ensure-pathname has been improved again, and its clients tweaked.

remove-keys was made more sensible by using EQL rather than STRING-EQUAL.

:version need not take the first form in a file, but can take
a path to a subform. This makes it possible to get the exact subform
in a Lisp source file that has the string.
See SUB-OBJECT for how these paths work.

Cleanup of the semantics of ENSURE-FUNCTION on CONSes: use APPLY, not EVAL.
---
 Makefile                 |  18 ++-
 action.lisp              |  14 +--
 asdf-driver.asd          |   2 +-
 asdf.asd                 |  40 +++++-
 backward-driver.lisp     |   2 +-
 backward-internals.lisp  |   6 +-
 bin/bump-version         |  41 +++---
 bin/make-tarball         | 131 +++++++++++++++-----
 bundle.lisp              |  18 +--
 component.lisp           |  77 +++++++++++-
 concatenate-source.lisp  |   5 -
 configuration.lisp       |  42 +++----
 defsystem.lisp           |  98 +++++++--------
 find-system.lisp         |  14 ++-
 generate-asdf.asd        |  34 -----
 header.lisp              |   2 +-
 interface.lisp           |  17 +--
 lisp-build.lisp          |   2 +-
 operate.lisp             |   7 ++
 operation.lisp           |   3 +
 os.lisp                  |  16 +--
 output-translations.lisp |   4 +-
 pathname.lisp            | 260 ++++++++++++++++++++++++---------------
 plan.lisp                |   2 +-
 run-program.lisp         |   2 +-
 source-registry.lisp     |   6 +-
 stream.lisp              |  90 +++++++++-----
 system.lisp              |  82 ++----------
 test/run-tests.sh        |   3 +
 test/script-support.lisp |   7 +-
 upgrade.lisp             |   8 +-
 utility.lisp             | 101 ++++++++++-----
 version.lisp-expr        |   2 +-
 33 files changed, 695 insertions(+), 461 deletions(-)
 delete mode 100644 generate-asdf.asd

diff --git a/Makefile b/Makefile
index f6551fc2d..a1efe8334 100644
--- a/Makefile
+++ b/Makefile
@@ -18,11 +18,6 @@ endif
 ## MAJOR FAIL: gclcvs -- Compiler bug fixed upstream, but gcl fails to compile on modern Linuxen.
 ## grep for #+/#- features in the test/ directory to see plenty of disabled tests.
 
-## Make sure testing remains within the confines of this filesystem tree
-export ASDF_OUTPUT_TRANSLATIONS := (:output-translations (t ("${sourceDirectory}/build/fasls" :implementation)) :ignore-inherited-configuration)
-export CL_SOURCE_REGISTRY := (:source-registry (:tree "${sourceDirectory}") :ignore-inherited-configuration)
-
-
 lisp ?= sbcl
 
 ABCL ?= abcl
@@ -41,17 +36,20 @@ XCL ?= xcl
 
 # website, tag, install
 
-driver_lisp := header.lisp package.lisp compatibility.lisp utility.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
+header_lisp := header.lisp
+driver_lisp := package.lisp compatibility.lisp utility.lisp pathname.lisp stream.lisp os.lisp image.lisp run-program.lisp lisp-build.lisp configuration.lisp backward-driver.lisp driver.lisp
 asdf_lisp := upgrade.lisp component.lisp system.lisp find-system.lisp find-component.lisp operation.lisp action.lisp lisp-action.lisp plan.lisp operate.lisp output-translations.lisp source-registry.lisp backward-internals.lisp defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp interface.lisp footer.lisp
 
 # Making ASDF itself should be our first, default, target:
 build/asdf.lisp: $(wildcard *.lisp)
 	mkdir -p build
-	cat $(driver_lisp) $(asdf_lisp) > $@
+	cat $(header_lisp) $(driver_lisp) $(asdf_lisp) > $@
 
 # This quickly locates such mistakes as unbalanced parentheses:
-load:
-	rlwrap sbcl `for i in $(driver_lisp) $(asdf_lisp) ; do echo --load $$i ; done`
+load: build/asdf.lisp
+	rlwrap sbcl \
+	`for i in $(driver_lisp) $(asdf_lisp) ; do echo --load $$i ; done` \
+	--eval '(in-package :asdf)'
 
 install: archive-copy
 
@@ -71,7 +69,7 @@ archive-copy: archive build/asdf.lisp
 ### Count lines separately for asdf-driver and asdf itself:
 wc:
 	@wc $(driver_lisp) | sort -n ; echo ; \
-	wc $(asdf_lisp) | sort -n ; \
+	wc $(header_lisp) $(asdf_lisp) | sort -n ; \
 	echo ; \
 	wc $(driver_lisp) $(asdf_lisp) | tail -n 1
 
diff --git a/action.lisp b/action.lisp
index ad0d6dfb9..5b4d1c13b 100644
--- a/action.lisp
+++ b/action.lisp
@@ -11,7 +11,6 @@
    #:action
    #:explain #:operation-description
    #:downward-operation #:upward-operation
-   #:file-component
    #:source-file #:c-source-file #:java-source-file
    #:static-file #:doc-file #:html-file
    #:operation-error #:error-component #:error-operation
@@ -140,8 +139,6 @@ You can put together sentences using this phrase."))
 
 ;;;; File components
 
-(defclass file-component (child-component)
-  ((type :accessor file-type :initarg :type))) ; no default
 (defclass source-file (file-component)
   ((type :initform nil))) ;; NB: many systems have come to rely on this default.
 (defclass c-source-file (source-file)
@@ -161,13 +158,6 @@ You can put together sentences using this phrase."))
       ;; I guess we work with the original source file, then
       (list (component-pathname c))))
 
-(defmethod source-file-type ((component parent-component) system) ; not just for source-file. ASDF3: rename.
-  (declare (ignorable component system))
-  :directory)
-(defmethod source-file-type ((component file-component) system)
-  (declare (ignorable system))
-  (file-type component))
-
 
 ;;;; Done performing
 
@@ -250,3 +240,7 @@ in some previous image, or T if it needs to be done.")
         (mark-operation-done operation component)
         (return)))))
 
+;;; Generic build operation
+(defmethod component-depends-on ((o build-op) (c component))
+  `((,(or (component-build-operation c) 'load-op) ,c)))
+
diff --git a/asdf-driver.asd b/asdf-driver.asd
index a6fff0864..3aa9c1292 100644
--- a/asdf-driver.asd
+++ b/asdf-driver.asd
@@ -1,5 +1,5 @@
 ;;; -*- mode: lisp -*-
-(defpackage :asdf-driver-system (:use :cl :asdf))
+(in-package :asdf)
 
 (defun call-without-redefinition-warnings (thunk)
   (handler-bind (#+clozure (ccl:compiler-warning #'muffle-warning))
diff --git a/asdf.asd b/asdf.asd
index a703a51f0..1275fbfdb 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.105" ;; to be automatically updated by bin/bump-revision
+  :version "2.26.106" ;; 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))))
@@ -30,3 +30,41 @@
 
 #+(and clisp (not asdf2.27))
 (rename-package :asdf :asdf-utilities)
+
+#+asdf2.27
+(defsystem :asdf/generate
+  :licence "MIT"
+  :description "All the components needed to build asdf.lisp"
+  :description "Generate asdf.lisp based on this and monolithic-concatenate-source-op"
+  :defsystem-depends-on (:asdf)
+  :class :bundle-system
+  :build-operation monolithic-concatenate-source-op
+  :bundle-pathname "build/asdf"
+  :translate-output-p nil
+  :serial t
+  :around-compile call-without-redefinition-warnings ;; be the same as asdf-driver
+  :depends-on (:asdf/header :asdf-driver)
+  :components
+  ((:file "upgrade")
+   (:file "component")
+   (:file "system" :depends-on ("component"))
+   (:file "find-system" :depends-on ("system"))
+   (:file "find-component" :depends-on ("find-system"))
+   (:file "operation")
+   (:file "action" :depends-on ("find-component" "operation"))
+   (:file "lisp-action" :depends-on ("action"))
+   (:file "plan" :depends-on ("action"))
+   (:file "operate" :depends-on ("plan"))
+   (:file "output-translations" :depends-on ("operate"))
+   (:file "source-registry" :depends-on ("find-system"))
+   (:file "backward-internals" :depends-on ("action" "operate"))
+   (:file "defsystem" :depends-on ("backward-internals"))
+   (:file "bundle" :depends-on ("lisp-action"))
+   (:file "concatenate-source" :depends-on ("lisp-action"))
+   (:file "backward-interface" :depends-on ("lisp-action"))
+   (:file "interface")
+   (:file "footer" :depends-on ("interface"))))
+
+(defsystem :asdf/header
+  :components
+  ((:static-file "header.lisp")))
diff --git a/backward-driver.lisp b/backward-driver.lisp
index 040675e91..1f15aab67 100644
--- a/backward-driver.lisp
+++ b/backward-driver.lisp
@@ -27,7 +27,7 @@
   ;; (warn "Please don't use ASDF::COMPONENT-NAME-TO-PATHNAME-COMPONENTS, use SPLIT-UNIX-NAMESTRING-DIRECTORY-COMPONENTS")
   (multiple-value-bind (relabs path filename file-only)
       (split-unix-namestring-directory-components
-       unix-style-namestring :want-directory force-directory)
+       unix-style-namestring :ensure-directory force-directory)
     (declare (ignore file-only))
     (when (and force-relative (not (eq relabs :relative)))
       (error (compatfmt "~@<Absolute pathname designator not allowed: ~3i~_~S~@:>")
diff --git a/backward-internals.lisp b/backward-internals.lisp
index 0d4b3d885..39cded0a3 100644
--- a/backward-internals.lisp
+++ b/backward-internals.lisp
@@ -7,7 +7,8 @@
    :asdf/system :asdf/component :asdf/find-system :asdf/action)
   (:export ;; for internal use
    #:%refresh-component-inline-methods
-   #:%resolve-if-component-dep-fails))
+   #:%resolve-if-component-dep-fails
+   #:make-sub-operation))
 (in-package :asdf/backward-internals)
 
 ;;;; Backward compatibility with "inline methods"
@@ -65,3 +66,6 @@
               :when (eq feature? 'feature) :do
                 (setf (component-if-feature c) feature)))))
 
+(when-upgrade (:when (fboundp 'make-sub-operation))
+  (defun* make-sub-operation (c o dep-c dep-o)
+    (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
diff --git a/bin/bump-version b/bin/bump-version
index 943712e3e..c1d77cb03 100755
--- a/bin/bump-version
+++ b/bin/bump-version
@@ -7,6 +7,12 @@
 
 (in-package :fare-utils)
 
+(defparameter *versioned-files*
+  '(("version.lisp-expr" "\"" "\"")
+    ("asdf.asd" "  :version \"" "\" ;; to be automatically updated by bin/bump-revision")
+    ("header.lisp" "This is ASDF " ": Another System Definition Facility.")
+    ("upgrade.lisp" "   (asdf-version \"" "\")")))
+
 (defvar *adir* (asdf:system-relative-pathname :asdf nil))
 
 (defun afile (x) (subpathname *adir* x))
@@ -18,24 +24,28 @@
 (defparameter *new-version* nil)
 
 (defun next-version (v)
-  (let ((pv (parse-version v)))
+  (let ((pv (parse-version v 'error)))
     (incf (third pv))
     (unparse-version pv)))
 
 (defun version-from-file ()
-  (safe-read-first-file-form *version-file*))
+  (safe-read-file-form *version-file*))
 
 (defun versions-from-argv (argv)
-  (ecase (length argv)
-    ((2) (values (second argv) (first argv)))
-    ((1) (values (version-from-file) (first argv)))
-    ((0) (let ((old (version-from-file)))
-           (values old (next-version old))))))
+  (labels ((check (old new)
+             (parse-version old 'error)
+             (parse-version new 'error)
+             (values old new)))
+    (ecase (length argv)
+      ((2) (check (second argv) (first argv)))
+      ((1) (check (version-from-file) (first argv)))
+      ((0) (let ((old (version-from-file)))
+             (check old (next-version old)))))))
 
 (multiple-value-setq (*old-version* *new-version*)
   (versions-from-argv *command-line-arguments*))
 
-(format t "Bumping ASDF version from ~A to ~A~%" *old-version* *new-version*)
+(a "Bumping ASDF version from " *old-version* " to " *new-version*)
 
 (deftype byte-vector () '(array (unsigned-byte 8) (*)))
 
@@ -57,7 +67,7 @@
           (clobber-file-with-vector file written-contents :external-format external-format)
           (format t "done.~%")))))
 
-(defun version-transformer (new-version file prefix suffix)
+(defun version-transformer (new-version file prefix suffix &optional dont-warn)
   (let* ((qprefix (cl-ppcre:quote-meta-chars prefix))
          (versionrx "([0-9]+(\\.[0-9]+)+)")
          (qsuffix (cl-ppcre:quote-meta-chars suffix))
@@ -67,16 +77,10 @@
     (lambda (text)
       (multiple-value-bind (new-text foundp)
           (cl-ppcre:regex-replace regex text replacement)
-        (unless (or foundp t)
+        (unless (or foundp dont-warn)
           (warn "Missing version in ~A" (file-namestring file)))
         (values new-text foundp)))))
 
-(defparameter *versioned-files*
-  '(("version.lisp-expr" "\"" "\"")
-    ("asdf.asd" "  :version \"" "\" ;; to be automatically updated by bin/bump-revision")
-    ("header.lisp" "This is ASDF " ": Another System Definition Facility.")
-    ("upgrade.lisp" "   (asdf-version \"" "\")")))
-
 (defun transform-file (new-version file prefix suffix)
   (maybe-replace-file (afile file) (version-transformer new-version file prefix suffix)))
 
@@ -87,7 +91,7 @@
   (let ((lines (read-file-lines (afile file))))
     (dolist (l lines (progn (warn "Couldn't find a match in ~A" file) nil))
       (multiple-value-bind (new-text foundp)
-          (funcall (version-transformer new-version file prefix suffix) l)
+          (funcall (version-transformer new-version file prefix suffix t) l)
         (when foundp
           (format t "Found a match:~%  ==> ~A~%Replacing with~%  ==> ~A~%~%"
                   l new-text)
@@ -95,3 +99,6 @@
 (defun z () (apply 'test-transform-file *new-version* (first *versioned-files*)))
 
 (transform-files)
+
+(a "Re-generate ASDF with bumped version")
+(asdf:build-system :asdf/generate)
diff --git a/bin/make-tarball b/bin/make-tarball
index 283363d57..39906f907 100755
--- a/bin/make-tarball
+++ b/bin/make-tarball
@@ -10,40 +10,103 @@
 
 (asdf-debug)
 
-(describe (find-system :asdf))
+;;; Make sure asdf.lisp is built.
+(asdf:build-system :asdf/generate)
 
-(defparameter *ad* (find-system :asdf-driver))
+;;; ASDF directory
 (defparameter *asdf-dir*
-  (ensure-pathname (system-source-directory *ad*)
-                   :want-existing t :want-absolute t))
-(defun apath (x) (subpathname *asdf-dir* x))
-(defun ann (x) (native-namestring (apath x)))
-(defparameter *build-dir* (apath "build/"))
-(defparameter /build-dir/ (ann "build/"))
-(defun bpath (x) (subpathname *build-dir* x))
-(defun bnn (x) (native-namestring (bpath x)))
-(defparameter *files*
-  (list* "asdf-driver.asd" "version.lisp-expr"
-         (loop :for c :in (operated-components
-                           *ad* :goal-operation 'load-op
-                                :keep-operation 'load-op)
-               :for n = (enough-namestring (component-pathname c)
-                                           *asdf-directory*)
-               :when (typep c 'cl-source-file)
-                 :collect n)))
+  (ensure-pathname (system-relative-pathname :asdf ())
+                   :want-physical t :want-absolute t
+                   :want-existing t :truename t))
+(defparameter /asdf-dir/
+  (native-namestring *asdf-dir*))
+
+;;; build directory
+(defparameter *build-dir*
+  (ensure-pathname
+   "build/" :defaults *asdf-dir*
+            :want-relative t :ensure-absolute t
+            :ensure-subpath t))
+(defparameter /build-dir/
+  (native-namestring *build-dir*))
+
 (defparameter *version*
-  (safe-read-first-file-form (apath "version.lisp-expr")))
-(defparameter *name* (format nil "asdf-driver-~A" *version*))
-(defparameter *tarname* (strcat *name* ".tar.gz"))
-(defparameter dirname/ (strcat *name* "/"))
-(defparameter *destination*
-  (ensure-pathname (bpath dirname/)
-                   :want-directory t :want-absolute t))
-(assert (< 6 (length (pathname-directory *destination*))))
-(defparameter /destination/ (native-namestring *destination*))
-(run-program/ `("rm" "-rf" ,/destination/))
-(ensure-directory-exists *destination*)
-(run-program/ `("ln" ,@(mapcar 'ann *files*) ,/destination/))
-(run-program/ (format nil "cd ~S && tar zcf ~S ~S"
-                      ,/build-dir/, ,*tarname* ,dirname/))
-(run-program/ `("rm" "-rf" ,/destination/))
+  (safe-read-first-file-form
+   (subpathname *asdf-dir* "version.lisp-expr")))
+
+(defparameter *asdf-driver* (format nil "asdf-driver-~A" *version*))
+
+(defun enough-namestring! (base pathname)
+  (let ((e (enough-namestring b p)))
+    (assert (relative-pathname e))
+    e))
+
+(defun enough-namestrings (base pathnames)
+  (loop :with b = (ensure-pathname base :want-absolute t :want-directory t)
+        :for p :in pathnames
+        :collect (enough-namestring! base p)))
+
+(defun system-source-files (system)
+  (let* ((sys (find-system system))
+         (dir (ensure-pathname
+               (system-source-directory sys)
+               :want-absolute t :want-directory t))
+         (components
+           (operated-components
+            sys :other-systems nil
+            :goal-operation 'load-op
+            :keep-operation 'load-op))
+         (pathnames (mapcar 'component-pathname components)))
+    (enough-namestrings dir pathnames)))
+
+(defparameter *driver-files*
+  (list* "asdf-driver.asd" "version.lisp-expr"
+         (system-source-files :asdf-driver)))
+
+(defparameter *asdf-only*
+  (format nil "asdf-only-~A" *version*))
+(defparameter *asdf-only-files*
+  (list* "asdf.asd" "version.lisp-expr"
+         (system-source-files :asdf/generate)))
+
+(defun tarname (name) (strcat name ".tar.gz"))
+
+(defun make-tarball-under-build (name base files)
+  (let* ((/base/
+           (native-namestring
+            (ensure-pathname
+             base
+             :want-absolute t :want-directory t
+             :want-existing t :want-truename t)))
+         (destination
+           (ensure-pathname
+            name
+            :defaults *build-dir*
+            :want-relative t :ensure-absolute t
+            :ensure-subpath t :ensure-directory t))
+         (/destination/
+           (native-namestring destination))
+         (/tarball/
+           (native-namestring
+            (ensure-pathname
+             (tarname name)
+             :defaults *build-dir*
+             :want-relative t :ensure-absolute t
+             :ensure-subpath t :want-file t
+             :ensure-directories-exist t)))
+         (/files/
+           (mapcar 'native-namestring files)))
+    (assert (< 6 (length (pathname-directory destination))))
+    (run-program/ `("rm" "-rf" ,/destination/))
+    (ensure-directories-exist destination)
+    (run-program/ (format nil "cd ~S && cp -lax --parents ~{~S ~} ~S"
+                          /base/ /files/ /destination/))
+    (run-program/ (format nil "tar zcvfC ~S ~S ~S/"
+                          /tarball/ /build/ name))
+    (run-program/ `("rm" "-rf" ,/destination/))))
+
+(make-tarball-under-build *asdf-driver* *asdf-directory* *asdf-driver-files*)
+(make-tarball-under-build *asdf-only* *asdf-directory* *asdf-only-files*)
+
+(run-program/ (format nil "cd ~S && tar zcf build/asdf-~A.tar.gz build/asdf.lisp $(git ls-files)"
+                      /asdf-dir/ *version*))
diff --git a/bundle.lisp b/bundle.lisp
index a9c5e1db7..ff2e01d82 100644
--- a/bundle.lisp
+++ b/bundle.lisp
@@ -11,7 +11,7 @@
    #:fasl-op #:load-fasl-op #:lib-op #:dll-op #:binary-op
    #:monolithic-op #:monolithic-bundle-op #:dependency-files
    #:monolithic-binary-op #:monolithic-fasl-op #:monolithic-lib-op #:monolithic-dll-op
-   #:program-op #:program-system
+   #:program-op
    #:compiled-file #:precompiled-system #:prebuilt-system
    #:operation-monolithic-p
    #:user-system-p #:user-system #:trivial-system-p
@@ -105,10 +105,6 @@
    (translate-output-p
     :initform nil :initarg :translate-output-p :accessor component-translate-output-p)))
 
-(defclass program-system (bundle-system)
-  ((bundle-pathname :initarg :executable-name)
-   (bundle-operation :initform 'program-op)))
-
 (defun* bundle-pathname-type (bundle-type)
   (etypecase bundle-type
     ((eql :no-output-file) nil) ;; should we error out instead?    
@@ -181,13 +177,13 @@
                          &allow-other-keys)
         (operation-original-initargs instance)
       (setf (operation-original-initargs instance)
-            (remove-keys '(lisp-files epilogue-code prologue-code) original-initargs)
+            (remove-keys '(:lisp-files :epilogue-code :prologue-code) original-initargs)
             (monolithic-op-prologue-code instance) prologue-code
             (monolithic-op-epilogue-code instance) epilogue-code)
       #-ecl (assert (null (or lisp-files epilogue-code prologue-code)))
       #+ecl (setf (bundle-op-lisp-files instance) lisp-files)))
   (setf (bundle-op-build-args instance)
-        (remove-keys '(type monolithic name-suffix)
+        (remove-keys '(:type :monolithic :name-suffix)
                      (operation-original-initargs instance))))
 
 (defmethod bundle-op-build-args :around ((o lib-op))
@@ -297,6 +293,12 @@
   (declare (ignorable o c))
   nil)
 
+(defmethod component-depends-on :around ((o bundle-op) (c component))
+  (declare (ignorable o c))
+  (if-bind (op (and (eq (type-of o) 'bundle-op) (component-bundle-operation c)))
+      `((,op ,c))
+      (call-next-method)))
+
 (defun* dependency-files (o c &key (test 'identity) (key 'output-files))
   (while-collecting (collect)
     (visit-dependencies
@@ -330,7 +332,7 @@
                              (merge-pathnames "./asdf-output/")))
          (operation (apply #'operate operation-name
                            system
-                           (remove-keys '(monolithic type move-here) args)))
+                           (remove-keys '(:monolithic :type :move-here) args)))
          (system (find-system system))
          (files (and system (output-files operation system))))
     (if (or move-here (and (null move-here-p)
diff --git a/component.lisp b/component.lisp
index 3cc8bef7d..4be0c3bac 100644
--- a/component.lisp
+++ b/component.lisp
@@ -8,6 +8,8 @@
    #:component #:component-find-path
    #:component-name #:component-pathname #:component-relative-pathname
    #:component-parent #:component-system #:component-parent-pathname
+   #:child-component #:parent-component #:module
+   #:file-component
    #:source-file-type ;; backward-compatibility
    #:component-in-order-to #:component-sibling-dependencies
    #:component-if-feature #:around-compile-hook
@@ -18,6 +20,10 @@
    #:component-operation-times ;; For internal use only.
    ;; portable ASDF encoding and implementation-specific external-format
    #:component-external-format #:component-encoding
+   #:component-children-by-name #:component-children #:compute-children-by-name
+   #:component-build-operation
+   #:module-default-component-class
+   #:module-components ;; backward-compatibility. DO NOT USE.
 
    ;; Internals we'd like to share with the ASDF package.
    #:name #:version #:description #:long-description
@@ -44,6 +50,9 @@ another pathname in a degenerate way."))
 (defgeneric* component-external-format (component))
 (defgeneric* component-encoding (component))
 (defgeneric* version-satisfies (component version))
+
+;;; Backward compatible way of computing the FILE-TYPE of a component.
+;;; TODO: find users, have them stop using that.
 (defgeneric* source-file-type (component system))
 
 (when-upgrade (:when (find-class 'component nil))
@@ -95,7 +104,9 @@ another pathname in a degenerate way."))
    (properties :accessor component-properties :initarg :properties
                :initform nil)
    ;; For backward-compatibility, this slot is part of component rather than child-component
-   (parent :initarg :parent :initform nil :reader component-parent)))
+   (parent :initarg :parent :initform nil :reader component-parent)
+   (build-operation
+    :initarg :build-operation :initform nil :reader component-build-operation)))
 
 (defun* component-find-path (component)
   (check-type component (or null component))
@@ -113,6 +124,57 @@ another pathname in a degenerate way."))
     component))
 
 
+;;;; Component hierarchy within a system
+;; The tree typically but not necessarily follows the filesystem hierarchy.
+
+(defclass child-component (component) ())
+
+(defclass file-component (child-component)
+  ((type :accessor file-type :initarg :type))) ; no default
+
+(defclass parent-component (component)
+  ((children
+    :initform nil
+    :initarg :components
+    :reader module-components ; backward-compatibility
+    :accessor component-children)
+   (children-by-name
+    :reader module-components-by-name ; backward-compatibility
+    :accessor component-children-by-name)
+   (default-component-class
+    :initform nil
+    :initarg :default-component-class
+    :accessor module-default-component-class)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun* compute-children-by-name (parent &key only-if-needed-p)
+    (unless (and only-if-needed-p (slot-boundp parent 'children-by-name))
+      (let ((hash (make-hash-table :test 'equal)))
+        (setf (component-children-by-name parent) hash)
+        (loop :for c :in (component-children parent)
+              :for name = (component-name c)
+              :for previous = (gethash name hash)
+              :do (when previous (error 'duplicate-names :name name))
+                  (setf (gethash name hash) c))
+        hash))))
+
+(when-upgrade (:when (find-class 'module nil))
+  (defmethod reinitialize-instance :after ((m module) &rest initargs &key)
+    (declare (ignorable m initargs)) (values))
+  (defmethod update-instance-for-redefined-class :after
+      ((m module) added deleted plist &key)
+    (declare (ignorable m added deleted plist))
+    (when (and (member 'children added) (member 'components deleted))
+      (setf (slot-value m 'children)
+            ;; old ECLs provide an alist instead of a plist(!)
+            (if (or #+ecl (consp (first plist))) (or #+ecl (cdr (assoc 'components plist)))
+                (getf plist 'components)))
+      (compute-children-by-name m))))
+
+(defclass module (child-component parent-component)
+  ())
+
+
 ;;;; component pathnames
 
 (defun* component-parent-pathname (component)
@@ -138,14 +200,25 @@ another pathname in a degenerate way."))
         pathname)))
 
 (defmethod component-relative-pathname ((component component))
+  ;; source-file-type is backward-compatibility with ASDF1;
+  ;; we ought to be able to extract this from the component alone with COMPONENT-TYPE.
+  ;; TODO: track who uses it, and have them not use it anymore.
   (parse-unix-namestring
    (or (and (slot-boundp component 'relative-pathname)
             (slot-value component 'relative-pathname))
        (component-name component))
    :want-relative t
-   :type (source-file-type component (component-system component)) ;; backward-compatibility
+   :type (source-file-type component (component-system component))
    :defaults (component-parent-pathname component)))
 
+(defmethod source-file-type ((component parent-component) system)
+  (declare (ignorable component system))
+  :directory)
+
+(defmethod source-file-type ((component file-component) system)
+  (declare (ignorable system))
+  (file-type component))
+
 
 ;;;; General component-property - ASDF3: remove? Define clean subclasses, not messy "properties".
 
diff --git a/concatenate-source.lisp b/concatenate-source.lisp
index 8b1e9add7..c45766436 100644
--- a/concatenate-source.lisp
+++ b/concatenate-source.lisp
@@ -16,7 +16,6 @@
    #:monolithic-load-concatenated-source-op
    #:monolithic-compile-concatenated-source-op
    #:monolithic-load-compiled-concatenated-source-op
-   #:concatenated-source-system
    #:component-concatenated-source-file
    #:concatenated-source-file))
 (in-package :asdf/concatenate-source)
@@ -38,10 +37,6 @@
 (defclass monolithic-compile-concatenated-source-op (compile-concatenated-source-op monolithic-op) ())
 (defclass monolithic-load-compiled-concatenated-source-op (load-compiled-concatenated-source-op monolithic-op) ())
 
-(defclass concatenated-source-system (bundle-system)
-  ((bundle-pathname :initarg :concatenated-source-file)
-   (bundle-operation :initform :load-compiled-concatenated-source-op)))
-
 (defmethod input-files ((operation concatenate-source-op) (s system))
   (loop :with encoding = (or (component-encoding s) *default-encoding*)
         :with other-encodings = '()
diff --git a/configuration.lisp b/configuration.lisp
index 9eef435e2..124167557 100644
--- a/configuration.lisp
+++ b/configuration.lisp
@@ -151,33 +151,33 @@ values of TAG include :source-registry and :output-translations."
                   :do (report-invalid-form invalid-form-reporter :form form :location file)))
       :inherit-configuration)))
 
-(defun* resolve-relative-location-component (x &key want-directory wilden)
+(defun* resolve-relative-location-component (x &key ensure-directory wilden)
   (ensure-pathname
    (etypecase x
      (pathname x)
      (string (parse-unix-namestring
-              x :want-directory want-directory))
+              x :ensure-directory ensure-directory))
      (cons
       (if (null (cdr x))
           (resolve-relative-location-component
-           (car x) :want-directory want-directory :wilden wilden)
+           (car x) :ensure-directory ensure-directory :wilden wilden)
           (let* ((car (resolve-relative-location-component
-                       (car x) :want-directory t :wilden nil)))
+                       (car x) :ensure-directory t :wilden nil)))
             (merge-pathnames*
              (resolve-relative-location-component
-              (cdr x) :want-directory want-directory :wilden wilden)
+              (cdr x) :ensure-directory ensure-directory :wilden wilden)
              car))))
      ((eql :*/) *wild-directory*)
      ((eql :**/) *wild-inferiors*)
      ((eql :*.*.*) *wild-file*)
      ((eql :implementation)
       (parse-unix-namestring
-       (implementation-identifier) :want-directory t))
+       (implementation-identifier) :ensure-directory t))
      ((eql :implementation-type)
       (parse-unix-namestring
-       (string-downcase (implementation-type)) :want-directory t))
+       (string-downcase (implementation-type)) :ensure-directory t))
      ((eql :hostname)
-      (parse-unix-namestring (hostname) :want-directory t)))
+      (parse-unix-namestring (hostname) :ensure-directory t)))
   :wilden (and wilden (not (pathnamep x)) (not (member x '(:*/ :**/ :*.*.*))))
   :want-relative t))
 
@@ -201,7 +201,7 @@ directive.")
            '(:home ".cache" "common-lisp" :implementation)))))
 (register-image-restore-hook 'compute-user-cache)
 
-(defun* resolve-absolute-location-component (x &key want-directory wilden)
+(defun* resolve-absolute-location-component (x &key ensure-directory wilden)
   (ensure-pathname
    (etypecase x
      (pathname x)
@@ -209,17 +209,17 @@ directive.")
       (let ((p #-mcl (parse-namestring x)
                #+mcl (probe-posix x)))
         #+mcl (unless p (error "POSIX pathname ~S does not exist" x))
-        (if want-directory (ensure-directory-pathname p) p)))
+        (if ensure-directory (ensure-directory-pathname p) p)))
      (cons
       (return-from resolve-absolute-location-component
         (if (null (cdr x))
             (resolve-absolute-location-component
-             (car x) :want-directory want-directory :wilden wilden)
+             (car x) :ensure-directory ensure-directory :wilden wilden)
             (merge-pathnames*
              (resolve-relative-location-component
-              (cdr x) :want-directory want-directory :wilden wilden)
+              (cdr x) :ensure-directory ensure-directory :wilden wilden)
              (resolve-absolute-location-component
-              (car x) :want-directory t :wilden nil)))))
+              (car x) :ensure-directory t :wilden nil)))))
      ((eql :root)
       ;; special magic! we return a relative pathname,
       ;; but what it means to the output-translations is
@@ -229,25 +229,25 @@ directive.")
           (if wilden (wilden p) p))))
      ((eql :home) (user-homedir))
      ((eql :here) (resolve-absolute-location-component
-                   *here-directory* :want-directory t :wilden nil))
+                   *here-directory* :ensure-directory t :wilden nil))
      ((eql :user-cache) (resolve-absolute-location-component
-                         *user-cache* :want-directory t :wilden nil)))
+                         *user-cache* :ensure-directory t :wilden nil)))
    :wilden (and wilden (not (pathnamep x)))
    :want-absolute t))
 
-(defun* resolve-location (x &key want-directory wilden directory)
-  (when directory (setf want-directory t)) ;; :directory backward compatibility, until 2014-01-16.
+(defun* resolve-location (x &key ensure-directory wilden directory)
+  (when directory (setf ensure-directory t)) ;; :directory backward compatibility, until 2014-01-16.
   (if (atom x)
-      (resolve-absolute-location-component x :want-directory want-directory :wilden wilden)
+      (resolve-absolute-location-component x :ensure-directory ensure-directory :wilden wilden)
       (loop :with path = (resolve-absolute-location-component
-                          (car x) :want-directory (and (or want-directory (cdr x)) t)
+                          (car x) :ensure-directory (and (or ensure-directory (cdr x)) t)
                           :wilden (and wilden (null (cdr x))))
         :for (component . morep) :on (cdr x)
-        :for dir = (and (or morep want-directory) t)
+        :for dir = (and (or morep ensure-directory) t)
         :for wild = (and wilden (not morep))
         :do (setf path (merge-pathnames*
                         (resolve-relative-location-component
-                         component :want-directory dir :wilden wild)
+                         component :ensure-directory dir :wilden wild)
                         path))
         :finally (return path))))
 
diff --git a/defsystem.lisp b/defsystem.lisp
index 9cc5a8765..febebb1bc 100644
--- a/defsystem.lisp
+++ b/defsystem.lisp
@@ -26,7 +26,7 @@
   ;;    is considered (as deduced from e.g. *LOAD-PATHNAME*), and
   ;;    if it is indeed available and an absolute pathname, then
   ;;    the PATHNAME argument is normalized to a relative pathname
-  ;;    as per PARSE-UNIX-NAMESTRING (with WANT-DIRECTORY T)
+  ;;    as per PARSE-UNIX-NAMESTRING (with ENSURE-DIRECTORY T)
   ;;    and merged into that DIRECTORY as per SUBPATHNAME.
   ;; If no absolute pathname was found, we return NIL.
   (check-type pathname (or null string pathname))
@@ -71,7 +71,7 @@
                 type name value))
 
 (defun* check-component-input (type name weakly-depends-on
-                              depends-on components in-order-to)
+                                    depends-on components)
   "A partial test of the values of a component."
   (unless (listp depends-on)
     (sysdef-error-component ":depends-on must be a list."
@@ -81,80 +81,82 @@
                             type name weakly-depends-on))
   (unless (listp components)
     (sysdef-error-component ":components must be NIL or a list of components."
-                            type name components))
-  (unless (and (listp in-order-to) (listp (car in-order-to)))
-    (sysdef-error-component ":in-order-to must be NIL or a list of components."
-                            type name in-order-to)))
+                            type name components)))
 
 (defun* normalize-version (form pathname)
-  (cond
-    ((typep form '(or string null)) form)
-    ((length=n-p form 2)
+  (etypecase form
+    ((or string null) form)
+    (cons
      (ecase (first form)
        ((:read-file-form)
-        (safe-read-first-file-form (subpathname pathname (second form))))))))
+        (destructuring-bind (subpath &key (path 0)) (rest form)
+          (safe-read-file-form (subpathname pathname subpath) :path path)))))))
+
 
 ;;; Main parsing function
 
 (defun* parse-component-form (parent options &key previous-serial-component)
   (destructuring-bind
-        (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
-              perform explain output-files operation-done-p
-              weakly-depends-on depends-on serial in-order-to
-              do-first if-component-dep-fails
-              (version nil versionp)
-              ;; list ends
-              &allow-other-keys) options
+      (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 perform explain output-files operation-done-p
+       weakly-depends-on depends-on serial
+       do-first if-component-dep-fails (version nil versionp)
+       ;; list ends
+       &allow-other-keys) options
     (declare (ignorable perform explain output-files operation-done-p))
-    (check-component-input type name weakly-depends-on depends-on components in-order-to)
+    (check-component-input type name weakly-depends-on depends-on components)
     (when (and parent
                (find-component parent name)
                (not ;; ignore the same object when rereading the defsystem
                 (typep (find-component parent name)
                        (class-for-type parent type))))
       (error 'duplicate-names :name name))
-    (when do-first (error "DO-FIRST is not supported anymore since ASDF 2.27"))
+    (when do-first (error "DO-FIRST is not supported anymore as of ASDF 2.27"))
     (let* ((args `(:name ,(coerce-name name)
                    :pathname ,pathname
                    ,@(when parent `(:parent ,parent))
                    ,@(remove-keys
-                      '(components pathname if-component-dep-fails
-                        perform explain output-files operation-done-p
-                        weakly-depends-on depends-on serial in-order-to)
+                      '(:components :pathname :if-component-dep-fails :version
+                        :perform :explain :output-files :operation-done-p
+                        :weakly-depends-on :depends-on :serial)
                       rest)))
-           (ret (find-component parent name)))
+           (component (find-component parent name)))
       (when weakly-depends-on
-        (appendf depends-on (remove-if (complement #'(lambda (x) (find-system x nil))) weakly-depends-on)))
+        ;; ASDF3: deprecate this feature and remove it.
+        (appendf depends-on
+                 (remove-if (complement #'(lambda (x) (find-system x nil))) weakly-depends-on)))
       (when previous-serial-component
         (push previous-serial-component depends-on))
-      (if ret ; preserve identity
-          (apply 'reinitialize-instance ret args)
-          (setf ret (apply 'make-instance (class-for-type parent type) args)))
-      (component-pathname ret) ; eagerly compute the absolute pathname
-      (when versionp
-        (unless (parse-version (normalize-version
-                                version (system-source-directory (component-system ret))) nil)
-          (warn (compatfmt "~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>")
-                version name parent)))
-      (when (typep ret 'parent-component)
-        (setf (component-children ret)
+      (if component ; preserve identity
+          (apply 'reinitialize-instance component args)
+          (setf component (apply 'make-instance (class-for-type parent type) args)))
+      (component-pathname component) ; eagerly compute the absolute pathname
+      (let ((sysdir (system-source-directory (component-system component)))) ;; requires the previous
+        (when versionp
+          (setf version (normalize-version version sysdir))
+          (unless (parse-version version nil)
+            (warn (compatfmt "~@<Invalid version ~S for component ~S~@[ of ~S~]~@:>")
+                  version name parent))
+          (setf (component-version component) version)))
+      (when (typep component 'parent-component)
+        (setf (component-children component)
               (loop
                 :with previous-component = nil
                 :for c-form :in components
-                :for c = (parse-component-form ret c-form
+                :for c = (parse-component-form component c-form
                                                :previous-serial-component previous-component)
                 :for name = (component-name c)
                 :collect c
                 :when serial :do (setf previous-component name)))
-        (compute-children-by-name ret))
-      (setf (component-sibling-dependencies ret) depends-on) ;; Used by POIU. ASDF3: rename to component-depends-on
-      (setf (component-in-order-to ret) in-order-to)
-      (%refresh-component-inline-methods ret rest)
-      (when if-component-dep-fails (%resolve-if-component-dep-fails if-component-dep-fails ret))
-      ret)))
+        (compute-children-by-name component))
+      ;; Used by POIU. ASDF3: rename to component-depends-on
+      (setf (component-sibling-dependencies component) depends-on)
+      (%refresh-component-inline-methods component rest)
+      (when if-component-dep-fails
+        (%resolve-if-component-dep-fails if-component-dep-fails component))
+      component)))
 
 (defun* register-system-definition
     (name &rest options &key pathname (class 'system) (source-file () sfp)
@@ -171,11 +173,11 @@
            (registered (system-registered-p name))
            (registered! (if registered
                             (rplaca registered (safe-file-write-date source-file))
-                            (register-system (make-instance 'system :name name :source-file source-file))))
+                            (register-system
+                             (make-instance 'system :name name :source-file source-file))))
            (system (reset-system (cdr registered!)
                                  :name name :source-file source-file))
-           (component-options (remove-keyword :class options)))
-      (setf (gethash name *systems-being-defined*) system)
+           (component-options (remove-key :class options)))
       (apply 'load-systems defsystem-depends-on)
       ;; We change-class AFTER we loaded the defsystem-depends-on
       ;; since the class might be defined as part of those.
diff --git a/find-system.lisp b/find-system.lisp
index f448eb54a..cde6ea98e 100644
--- a/find-system.lisp
+++ b/find-system.lisp
@@ -6,7 +6,8 @@
   (:use :common-lisp :asdf/driver :asdf/upgrade :asdf/component :asdf/system)
   (:export
    #:remove-entry-from-registry #:coerce-entry-to-directory
-   #:coerce-name #:find-system #:locate-system #:load-sysdef #:with-system-definitions
+   #:coerce-name #:primary-system-name
+   #:find-system #:locate-system #:load-sysdef #:with-system-definitions
    #:system-registered-p #:register-system #:registered-systems #:clear-system #:map-systems
    #:system-definition-error #:missing-component #:missing-requires #:missing-parent
    #:formatted-system-definition-error #:format-control #:format-arguments #:sysdef-error
@@ -71,6 +72,11 @@ of which is a system object.")
     (string name)
     (t (sysdef-error (compatfmt "~@<Invalid component designator: ~3i~_~A~@:>") name))))
 
+(defun* primary-system-name (name)
+  ;; When a system name has slashes, the file with defsystem is named by
+  ;; the first of the slash-separated components.
+  (first (split-string (coerce-name name) :separator "/")))
+
 (defun* system-registered-p (name)
   (gethash (coerce-name name) *defined-systems*))
 
@@ -165,7 +171,7 @@ Going forward, we recommend new users should be using the source-registry.
                 (return (pathname target))))))))))
 
 (defun* sysdef-central-registry-search (system)
-  (let ((name (coerce-name system))
+  (let ((name (primary-system-name system))
         (to-remove nil)
         (to-replace nil))
     (block nil
@@ -280,10 +286,10 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
       (when (and pathname (not (absolute-pathname-p pathname)))
         (setf pathname (ensure-pathname-absolute pathname))
         (when found-system
-          (%set-system-source-file pathname found-system)))
+          (setf (system-source-file found-system) pathname)))
       (when (and previous (not (#-cormanlisp equal #+cormanlisp equalp
                                              (system-source-file previous) pathname)))
-        (%set-system-source-file pathname previous)
+        (setf (system-source-file previous) pathname)
         (setf previous-time nil))
       (values foundp found-system pathname previous previous-time))))
 
diff --git a/generate-asdf.asd b/generate-asdf.asd
deleted file mode 100644
index e540df787..000000000
--- a/generate-asdf.asd
+++ /dev/null
@@ -1,34 +0,0 @@
-;;; -*- mode: lisp -*-
-
-(defsystem :generate-asdf
-  :licence "MIT"
-  :description "All the components needed to build asdf.lisp"
-  :description "Generate asdf.lisp based on this and monolithic-concatenate-source-op"
-  ;; :defsystem-depends-on (:asdf/bundle)
-  :class :concatenated-source-system
-  ;; :include-dependencies t
-  :translate-output-p nil
-  :concatenated-source-file "build/asdf"
-  :version (:read-file-form "version.lisp-expr")
-  :serial t
-  :depends-on (:asdf-driver)
-  :components
-  ((:file "upgrade")
-   (:file "component")
-   (:file "system" :depends-on ("component"))
-   (:file "find-system" :depends-on ("system"))
-   (:file "find-component" :depends-on ("find-system"))
-   (:file "operation")
-   (:file "action" :depends-on ("find-component" "operation"))
-   (:file "lisp-action" :depends-on ("action"))
-   (:file "plan" :depends-on ("action"))
-   (:file "operate" :depends-on ("plan"))
-   (:file "output-translations" :depends-on ("operate"))
-   (:file "source-registry" :depends-on ("find-system"))
-   (:file "backward-internals" :depends-on ("action" "operate"))
-   (:file "defsystem" :depends-on ("backward-internals"))
-   (:file "bundle" :depends-on ("lisp-action"))
-   (:file "concatenate-source" :depends-on ("lisp-action"))
-   (:file "backward-interface" :depends-on ("lisp-action"))
-   (:file "interface")
-   (:file "footer" :depends-on ("interface"))))
diff --git a/header.lisp b/header.lisp
index 434106788..beb038f4f 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.105: Another System Definition Facility.
+;;; This is ASDF 2.26.106: 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 2f02f9ecd..ee6eb48dd 100644
--- a/interface.lisp
+++ b/interface.lisp
@@ -25,7 +25,8 @@
    #:compile-system #:load-system #:load-systems
    #:require-system #:test-system #:clear-system
    #:operation #:upward-operation #:downward-operation #:make-operation
-   #:load-op #:prepare-op #:compile-op #:load-fasl-op #:fasl-op
+   #:build-system #:build-op
+   #:load-op #:prepare-op #:compile-op
    #:prepare-source-op #:load-source-op #:test-op
    #:feature #:version #:version-satisfies #:upgrade-asdf
    #:implementation-identifier #:implementation-type #:hostname
@@ -34,9 +35,9 @@
    #:needed-in-image-p
    #:run-program/ ; the recommended replacement for run-shell-command
    #:component-load-dependencies #:run-shell-command ; deprecated, do not use
-   #:precompiled-system #:compiled-file
-   #+ecl #:make-build #+mkcl #:bundle-system
-   #:program-op #:program-system
+   #:bundle-op  #:precompiled-system #:compiled-file #:bundle-system
+   #+ecl #:make-build
+   #:program-op #:load-fasl-op #:fasl-op #:lib-op #:binary-op
    #:concatenate-source-op
    #:load-concatenated-source-op
    #:compile-concatenated-source-op
@@ -45,9 +46,6 @@
    #:monolithic-load-concatenated-source-op
    #:monolithic-compile-concatenated-source-op
    #:monolithic-load-compiled-concatenated-source-op
-   #:concatenated-source-system
-   #:component-concatenated-source-file
-   #:concatenated-source-file
    #:operation-monolithic-p
 
    #:component #:parent-component #:child-component #:system #:module
@@ -148,8 +146,3 @@
    #:system-source-registry
    #:user-source-registry-directory
    #:system-source-registry-directory))
-(in-package :asdf/interface)
-
-(when-upgrade (:when (fboundp 'make-sub-operation))
-  (defun* make-sub-operation (c o dep-c dep-o)
-    (declare (ignore c o dep-c dep-o)) (asdf-upgrade-error)))
diff --git a/lisp-build.lisp b/lisp-build.lisp
index 7d4501ba6..f2527bca8 100644
--- a/lisp-build.lisp
+++ b/lisp-build.lisp
@@ -258,7 +258,7 @@ it will filter them appropriately."
   (etypecase x
     ((or pathname string #-(or gcl<2.7 clozure allegro) stream)
      (apply 'load x
-            #-gcl<2.7 keys #+gcl<2.7 (remove-keyword :external-format keys)))
+            #-gcl<2.7 keys #+gcl<2.7 (remove-key :external-format keys)))
     #-(or gcl<2.7 clozure allegro)
     ;; GCL 2.6 can't load from a string-input-stream
     ;; ClozureCL 1.6 can only load from file input stream
diff --git a/operate.lisp b/operate.lisp
index c8d8f0e21..3d73f3be8 100644
--- a/operate.lisp
+++ b/operate.lisp
@@ -8,6 +8,7 @@
    :asdf/find-system :asdf/find-component :asdf/lisp-action :asdf/plan)
   (:export
    #:operate #:oos #:*systems-being-operated* #:*asdf-upgrade-already-attempted*
+   #:build-system
    #:load-system #:load-systems #:compile-system #:test-system #:require-system
    #:*load-system-operation* #:module-provide-asdf
    #:component-loaded-p #:already-loaded-systems
@@ -94,6 +95,11 @@ or ASDF:LOAD-SOURCE-OP if your fasl loading is somehow broken.
 This may change in the future as we will implement component-based strategy
 for how to load or compile stuff")
 
+(defun* build-system (system &rest keys)
+  "Shorthand for `(operate 'asdf:build-op system)`."
+  (apply 'operate 'build-op system keys)
+  t)
+
 (defun* load-system (system &rest keys &key force force-not verbose version &allow-other-keys)
   "Shorthand for `(operate 'asdf:load-op system)`. See OPERATE for details."
   (declare (ignore force force-not verbose version))
@@ -147,6 +153,7 @@ for how to load or compile stuff")
 
 (defun* reset-asdf-systems ()
   (let ((asdf (find-system :asdf)))
+    (setf (component-version asdf) (asdf-version))
     ;; Invalidate all systems but ASDF itself.
     (setf *defined-systems* (make-defined-systems-table))
     (register-system asdf)
diff --git a/operation.lisp b/operation.lisp
index 4b604304b..de1b51fdb 100644
--- a/operation.lisp
+++ b/operation.lisp
@@ -7,6 +7,7 @@
   (:export
    #:operation
    #:operation-original-initargs ;; backward-compatibility only. DO NOT USE.
+   #:build-op ;; THE generic operation
    #:make-operation
    #:find-operation))
 (in-package :asdf/operation)
@@ -50,3 +51,5 @@
 (defmethod find-operation (context (spec symbol))
   (apply 'make-operation spec (operation-original-initargs context)))
 (defmethod operation-original-initargs ((context null)) context)
+
+(defclass build-op (operation) ())
diff --git a/os.lisp b/os.lisp
index a608bd6c4..5c83aced2 100644
--- a/os.lisp
+++ b/os.lisp
@@ -97,7 +97,7 @@ then returning the non-empty string value of the variable"
       (if (os-unix-p) (unix-namestring p)
           (namestring p)))))
 
-(defun* parse-native-namestring (string &rest constraints &key want-directory &allow-other-keys)
+(defun* parse-native-namestring (string &rest constraints &key ensure-directory &allow-other-keys)
   "From a native namestring suitable for use by the operating system, return
 a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
   (check-type string (or string null))
@@ -108,10 +108,10 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
                #+sbcl (sb-ext:parse-native-namestring string)
                #-(or clozure sbcl)
                (if (os-unix-p)
-                   (parse-unix-namestring string :type (when want-directory :directory))
+                   (parse-unix-namestring string :ensure-directory ensure-directory)
                    (parse-namestring string)))))
          (pathname
-           (if want-directory
+           (if ensure-directory
                (and pathname (ensure-directory-pathname pathname))
                pathname)))
     (apply 'ensure-pathname pathname constraints)))
@@ -134,9 +134,9 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
          (if eap constraints
              (list* :error-arguments '("~? from (getenv ~S)") constraints))))
 (defun* getenv-absolute-directory (x)
-  (getenv-pathname x :want-absolute t :want-directory t))
+  (getenv-pathname x :want-absolute t :ensure-directory t))
 (defun* getenv-absolute-directories (x)
-  (getenv-pathnames x :want-absolute t :want-directory t))
+  (getenv-pathnames x :want-absolute t :ensure-directory t))
 
 
 ;;;; implementation-identifier
@@ -259,7 +259,7 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
            #+gcl system::*system-directory*
            #+sbcl (if-bind (it (find-symbol* :sbcl-homedir-pathname :sb-int nil))
                      (funcall it)
-                     (getenv-pathname "SBCL_HOME" :want-directory t)))))
+                     (getenv-pathname "SBCL_HOME" :ensure-directory t)))))
     (if (and dir truename)
         (truename* dir)
         dir)))
@@ -309,10 +309,10 @@ a CL pathname satisfying all the specified constraints as per ENSURE-PATHNAME"
 (defun* default-temporary-directory ()
   (or
    (when (os-unix-p)
-     (or (getenv-pathname "TMPDIR" :want-directory t)
+     (or (getenv-pathname "TMPDIR" :ensure-directory t)
          (parse-native-namestring "/tmp/")))
    (when (os-windows-p)
-     (getenv-pathname "TEMP" :want-directory t))
+     (getenv-pathname "TEMP" :ensure-directory t))
    (subpathname (user-homedir) "tmp/")))
 
 (defvar *temporary-directory* nil)
diff --git a/output-translations.lisp b/output-translations.lisp
index d1366f49f..2fc67842a 100644
--- a/output-translations.lisp
+++ b/output-translations.lisp
@@ -186,7 +186,7 @@ and the order is by decreasing length of namestring of the source pathname.")
               (process-output-translations (pathname dst) :inherit nil :collect collect))
             (when src
               (let ((trusrc (or (eql src t)
-                                (let ((loc (resolve-location src :want-directory t :wilden t)))
+                                (let ((loc (resolve-location src :ensure-directory t :wilden t)))
                                   (if (absolute-pathname-p loc) (truenamize loc) loc)))))
                 (cond
                   ((location-function-p dst)
@@ -199,7 +199,7 @@ and the order is by decreasing length of namestring of the source pathname.")
                    (funcall collect (list trusrc t)))
                   (t
                    (let* ((trudst (if dst
-                                      (resolve-location dst :want-directory t :wilden t)
+                                      (resolve-location dst :ensure-directory t :wilden t)
                                       trusrc)))
                      (funcall collect (list trudst t))
                      (funcall collect (list trusrc trudst)))))))))))
diff --git a/pathname.lisp b/pathname.lisp
index f7526a190..ddf331e67 100644
--- a/pathname.lisp
+++ b/pathname.lisp
@@ -28,7 +28,7 @@
    ;; Wildcard pathnames
    #:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* #:*wild-path* #:wilden
    ;; Pathname host and its root
-   #:absolute-pathname-p #:hidden-pathname-p
+   #:absolute-pathname-p #:relative-pathname-p #:hidden-pathname-p
    #:pathname-root #:directory-separator-for-host
    #:directorize-pathname-host-device
    ;; defaults
@@ -43,7 +43,7 @@
    #:delete-file-if-exists
    ;; Translate a pathname
    #:translate-pathname*
-   ;; temporary 
+   ;; temporary
    #:add-pathname-suffix #:tmpize-pathname
    #:call-with-staging-pathname #:with-staging-pathname
    ;; physical pathnames
@@ -211,7 +211,21 @@ Otherwise return NIL"
                                   (pathname-directory pathname))))
               pathname))))
 
+(defun* relative-pathname-p (pathspec)
+  "If PATHSPEC is a pathname or namestring object that parses as a pathname
+possessing a :RELATIVE or NIL directory component, return the (parsed) pathname.
+Otherwise return NIL"
+  (and pathspec
+       (typep pathspec '(or null pathname string))
+       (let* ((pathname (pathname pathspec))
+              (directory (normalize-pathname-directory-component
+                          (pathname-directory pathname))))
+         (when (or (null directory) (eq :relative (car directory)))
+           pathname))))
+
 (defun* hidden-pathname-p (pathname)
+  "Return a boolean that is true if the pathname is hidden as per Unix style,
+i.e. its name starts with a dot."
   (and pathname (equal (first-char (pathname-name pathname)) #\.)))
 
 
@@ -249,6 +263,21 @@ actually-existing directory."
              (check-one (pathname-type pathname))
              t)))))
 
+(defun* file-pathname-p (pathname)
+  "Does PATHNAME represent a file, i.e. has a non-null NAME component?
+
+Accepts NIL, a string (converted through PARSE-NAMESTRING) or a PATHNAME.
+
+Note that this does _not_ check to see that PATHNAME points to an
+actually-existing file.
+
+Returns the (parsed) PATHNAME when true"
+  (when pathname
+    (let* ((pathname (pathname pathname))
+           (name (pathname-name pathname)))
+      (when (not (member name '(nil :unspecific "") :test 'equal))
+        pathname))))
+
 (defun* ensure-directory-pathname (pathspec)
   "Converts the non-wild pathname designator PATHSPEC to directory form."
   (cond
@@ -431,8 +460,8 @@ with given pathname and if it exists return its truename."
 
 ;;; Parsing filenames and lists thereof
 (defun* split-unix-namestring-directory-components
-    (unix-style-namestring &key want-directory dot-dot)
-  "Splits the path string UNIX-STYLE-NAMESTRING, returning four values:
+    (unix-namestring &key ensure-directory dot-dot)
+  "Splits the path string UNIX-NAMESTRING, returning four values:
 A flag that is either :absolute or :relative, indicating
    how the rest of the values are to be interpreted.
 A directory path --- a list of strings and keywords, suitable for
@@ -443,7 +472,7 @@ A last-component, either a file-namestring including type extension,
    or NIL in the case of a directory pathname.
 A flag that is true iff the unix-style-pathname was just
    a file-namestring without / path specification.
-WANT-DIRECTORY forces the namestring to be interpreted as a directory pathname:
+ENSURE-DIRECTORY forces the namestring to be interpreted as a directory pathname:
 the third return value will be NIL, and final component of the namestring
 will be treated as part of the directory path.
 
@@ -454,16 +483,16 @@ Absolute pathnames are only appropriate on Unix-style systems.
 
 The intention of this function is to support structured component names,
 e.g., \(:file \"foo/bar\"\), which will be unpacked to relative pathnames."
-  (check-type unix-style-namestring string)
+  (check-type unix-namestring string)
   (check-type dot-dot (member nil :back :up))
-  (if (and (not (find #\/ unix-style-namestring)) (not want-directory)
-           (plusp (length unix-style-namestring)))
-      (values :relative () unix-style-namestring t)
-      (let* ((components (split-string unix-style-namestring :separator "/"))
+  (if (and (not (find #\/ unix-namestring)) (not ensure-directory)
+           (plusp (length unix-namestring)))
+      (values :relative () unix-namestring t)
+      (let* ((components (split-string unix-namestring :separator "/"))
              (last-comp (car (last components))))
         (multiple-value-bind (relative components)
             (if (equal (first components) "")
-                (if (equal (first-char unix-style-namestring) #\/)
+                (if (equal (first-char unix-namestring) #\/)
                     (values :absolute (cdr components))
                     (values :relative nil))
                 (values :relative components))
@@ -473,7 +502,7 @@ e.g., \(:file \"foo/bar\"\), which will be unpacked to relative pathnames."
           (cond
             ((equal last-comp "")
              (values relative components nil nil)) ; "" already removed from components
-            (want-directory
+            (ensure-directory
              (values relative components nil nil))
             (t
              (values relative (butlast components) last-comp nil)))))))
@@ -494,7 +523,7 @@ For an empty type, *UNSPECIFIC-PATHNAME-TYPE* is returned."
         (values filename *unspecific-pathname-type*)
         (values name type))))
 
-(defun* parse-unix-namestring (name &rest keys &key type defaults dot-dot want-directory
+(defun* parse-unix-namestring (name &rest keys &key type defaults dot-dot ensure-directory
                                     &allow-other-keys)
   "Coerce NAME into a PATHNAME using standard Unix syntax.
 
@@ -512,31 +541,35 @@ When given a STRING, portably decompose it into a pathname as below.
 #\\/ separates directory components.
 
 The last #\\/-separated substring is interpreted as follows:
-if TYPE is NIL, the substring is file-namestring, and its NAME and TYPE
-are separated by SPLIT-NAME-TYPE.
-if TYPE is a string, it is the given TYPE, and the whole string is the NAME;
-if TYPE is :DIRECTORY, the string is made the last directory component,
-and NAME and TYPE are NIL.
-if the string is empty, it's the empty pathname with all slots NIL.
+1- If TYPE is :DIRECTORY or ENSURE-DIRECTORY is true,
+ the string is made the last directory component, and NAME and TYPE are NIL.
+ if the string is empty, it's the empty pathname with all slots NIL.
+2- If TYPE is NIL, the substring is file-namestring, and its NAME and TYPE
+ are separated by SPLIT-NAME-TYPE.
+3- If TYPE is a string, it is the given TYPE, and the whole string is the NAME.
 
 Directory components with an empty name the name . are removed.
-Any directory named .. is read as DOT-DOT, which defaults to :BACK (not :UP).
+Any directory named .. is read as DOT-DOT,
+which must be one of :BACK or :UP and defaults to :BACK.
 
 HOST, DEVICE and VERSION components are taken from DEFAULTS,
-which itself defaults to (ROOT-PATHNAME).
+which itself defaults to (ROOT-PATHNAME), also used if DEFAULTS in NIL.
 No host or device can be specified in the string itself,
-which might make it unsuitable for absolute pathnames on Windows.
+which makes it unsuitable for absolute pathnames outside Unix.
 
-For relative pathnames, these defaults won't matter if you use MERGE-PATHNAMES*
-but will matter if you use MERGE-PATHNAMES (which you shouldn't).
+For relative pathnames, these components (and hence the defaults) won't matter
+if you use MERGE-PATHNAMES* but will matter if you use MERGE-PATHNAMES,
+which is an important reason to always use MERGE-PATHNAMES*.
 
-Arbitrary keys are accepted, that are finally passed to ENSURE-PATHNAME,
-removing TYPE DEFAULTS and DOT-DOT.
-we recommend you use :WANT-RELATIVE T to throw an error if the pathname is absolute
-when you're running portable code and the OS may not be Unixish."
+Arbitrary keys are accepted, and the parse result is passed to ENSURE-PATHNAME
+with those keys, removing TYPE DEFAULTS and DOT-DOT.
+When you're manipulating pathnames that are supposed to make sense portably
+even though the OS may not be Unixish, we recommend you use :WANT-RELATIVE T
+to throw an error if the pathname is absolute"
   (block nil
     (check-type type (or null string (eql :directory)))
-    (setf want-directory (or want-directory (eq type :directory)))
+    (when (eq type :directory)
+      (setf ensure-directory t))
     (etypecase name
       ((or null pathname) (return name))
       (symbol
@@ -544,10 +577,10 @@ when you're running portable code and the OS may not be Unixish."
       (string))
     (multiple-value-bind (relative path filename file-only)
         (split-unix-namestring-directory-components
-         name :dot-dot dot-dot :want-directory want-directory)
+         name :dot-dot dot-dot :ensure-directory ensure-directory)
       (multiple-value-bind (name type)
           (cond
-            ((or want-directory (null filename))
+            ((or ensure-directory (null filename))
              (values nil nil))
             (type
              (values filename type))
@@ -651,7 +684,7 @@ then it is merged with the PATHNAME-DIRECTORY-PATHNAME of PATHNAME."
                                            (eql x separator)))
                          root-namestring)))
     (multiple-value-bind (relative path filename)
-        (split-unix-namestring-directory-components root-string :want-directory t)
+        (split-unix-namestring-directory-components root-string :ensure-directory t)
       (declare (ignore relative filename))
       (let ((new-base
              (make-pathname* :defaults root :directory `(:absolute ,@path))))
@@ -930,90 +963,125 @@ Otherwise, this will be the root of some implementation-dependent filesystem hos
 ;;; Check pathname constraints
 
 (defun* ensure-pathname
-    (pathname &key want-pathname want-existing
-              want-absolute want-relative
+    (pathname &key
+              error-arguments
+              defaults type dot-dot
+              want-pathname
               want-logical want-physical ensure-physical
-              want-wild want-non-wild wilden
-              ensure-directory want-directory want-file
-              want-truename truenamize error-arguments)
-  "Coerces its argument into a PATHNAME, and checks specified constraints.
+              want-relative want-absolute ensure-absolute ensure-subpath
+              want-non-wild want-wild wilden
+              want-file want-directory ensure-directory
+              want-existing ensure-directories-exist
+              ensure-truename truenamize
+              &aux (p pathname)) ;; mutable working copy, preserve original
+  "Coerces its argument into a PATHNAME,
+optionally doing some transformations and checking specified constraints.
+
 If the argument is NIL, then NIL is returned unless the WANT-PATHNAME constraint is specified.
-If the argument is a STRING, it is first converted to a pathname via PARSE-NAMESTRING.
+
+If the argument is a STRING, it is first converted to a pathname via PARSE-UNIX-NAMESTRING
+reusing the keywords DEFAULTS TYPE DOT-DOT ENSURE-DIRECTORY WANT-RELATIVE;
+then the result is optionally merged into the DEFAULTS if ENSURE-ABSOLUTE is true,
+and the all the checks and transformations are run.
+
 Each non-nil constraint argument can be one of the symbols T, ERROR, CERROR or IGNORE.
 The boolean T is an alias for ERROR.
 ERROR means that an error will be raised if the constraint is not satisfied.
 CERROR means that an continuable error will be raised if the constraint is not satisfied.
 IGNORE means just return NIL instead of the pathname.
+
 The ERROR-ARGUMENTS arguments, if provided,
 will be passed on to the error primitive, together with three arguments:
-a string describing the error, that should be followed by a space and
-the pathname to report the error, the keyword that corresponds to that
-constraint name, and the pathname;
-this makes it usable whether you are using the short or long variants of ERROR,
-modulo your error object having to recognize the suitable keyword argument
-in case you use the long variant."
+the pathname, the keyword :reason, and a list (KEYWORD FORMAT ARGUMENTS)
+  the keyword that corresponds to that constraint name
+  a format string describing the error
+  and a list of any additional arguments required by said format string.
+This makes it usable whether you are using the short or long variants of ERROR,
+modulo your error object having to recognize the keyword :reason
+in case you use the long variant.
+
+The transformations and constraint checks are done in this order,
+which is also the order in the lambda-list:
+
+WANT-PATHNAME checks that pathname (after parsing if needed) is not null.
+Otherwise, if the pathname is NIL, ensure-pathname returns NIL.
+WANT-LOGICAL checks that pathname is a LOGICAL-PATHNAME
+WANT-PHYSICAL checks that pathname is not a LOGICAL-PATHNAME
+ENSURE-PHYSICAL ensures that pathname is physical via TRANSLATE-LOGICAL-PATHNAME
+WANT-RELATIVE checks that pathname has a relative directory component
+WANT-ABSOLUTE checks that pathname does have an absolute directory component
+ENSURE-ABSOLUTE merges with the DEFAULTS, then checks again
+that the result absolute is an absolute pathname indeed.
+ENSURE-SUBPATH checks that the pathname is a subpath of the DEFAULTS.
+WANT-FILE checks that pathname has a non-nil FILE component
+WANT-DIRECTORY checks that pathname has nil FILE and TYPE components
+ENSURE-DIRECTORY uses ENSURE-DIRECTORY-PATHNAME to interpret
+any file and type components as being actually a last directory component.
+WANT-NON-WILD checks that pathname is not a wild pathname
+WANT-WILD checks that pathname is a wild pathname
+WILDEN merges the pathname with **/*.*.* if it is not wild
+WANT-EXISTING checks that a file (or directory) exists with that pathname.
+ENSURE-DIRECTORIES-EXIST creates any parent directory with ENSURE-DIRECTORIES-EXIST.
+ENSURE-TRUENAME replaces the pathname by its truename, or errors if not possible.
+TRUENAMIZE uses TRUENAMIZE to resolve as many symlinks as possible."
   (block nil
-    (flet ((report-error (on-error keyword description)
-             (let ((err (append (or error-arguments '("Invalid pathname: ~A~* ~S"))
-                                (list description keyword pathname))))
+    (flet ((report-error (on-error keyword description &rest arguments)
+             (let ((err (append (or error-arguments '("Invalid pathname ~S: ~*~{~*~?~}"))
+                                (list pathname :reason (list keyword description arguments)))))
                (ecase on-error
                  ((error t) (apply 'error err))
                  ((cerror) (apply 'cerror "ignore pathname constraint" err))
                  ((ignore) (return nil))))))
-      (macrolet ((err (constraint format)
-                   `(report-error ,constraint ',(intern* constraint :keyword) ,format)))
-        (etypecase pathname
-          (null
-           (when want-pathname
-             (err want-pathname "Expected a pathname, got"))
-           (return nil))
+      (macrolet ((err (constraint &rest arguments)
+                   `(report-error ,constraint ',(intern* constraint :keyword) ,@arguments))
+                 (check (constraint condition &rest arguments)
+                   `(when ,constraint
+                      (unless ,condition (err ,constraint ,@arguments))))
+                 (transform (flag condition expr)
+                   `(when ,flag
+                      (,@(if condition `(when ,condition) '(progn))
+                       (setf p ,expr)))))
+        (etypecase p
+          ((or null pathname))
           (string
-           (setf pathname (parse-namestring pathname)))
-          (pathname))
-        (when want-logical
-          (unless (typep pathname 'logical-pathname)
-            (err want-logical "Expected a logical pathname, got")))
-        (when want-physical
-          (unless (physical-pathname-p pathname)
-            (err want-physical "Expected a physical pathname, got")))
-        (when ensure-physical
-          (setf pathname (translate-logical-pathname pathname)))
-        (when want-absolute
-          (unless (absolute-pathname-p pathname)
-            (err want-absolute "Expected an absolute pathname, got")))
-        (when want-relative
-          (when (absolute-pathname-p pathname)
-            (err want-relative "Expected a relative pathname, got")))
-        (when want-wild
-          (unless (wild-pathname-p pathname)
-            (err want-wild "Expected a wildcard pathname, got")))
-        (when (or want-non-wild want-existing)
-          (when (wild-pathname-p pathname)
-            (err want-non-wild "Expected a non-wildcard pathname, got")))
-        (when (and wilden (not (wild-pathname-p pathname)))
-          (setf pathname (wilden pathname)))
-        (when ensure-directory
-          (setf pathname (ensure-directory-pathname pathname)))
-        (when want-directory
-          (unless (directory-pathname-p pathname)
-            (err want-directory "Expected a directory pathname, got")))
-        (when want-file
-          (unless (pathname-name pathname)
-            (err want-file "Expected a file pathname, got")))
+           (setf p (parse-unix-namestring
+                    p :defaults defaults :type type :dot-dot dot-dot
+                    :ensure-directory ensure-directory :want-relative want-relative))))
+        (check want-pathname (pathnamep p) "Expected a pathname, not NIL")
+        (unless pathname (return NIL))
+        (check want-logical (typep p 'logical-pathname) "Expected a logical pathname")
+        (check want-physical (physical-pathname-p p) "Expected a physical pathname")
+        (transform ensure-physical () (translate-logical-pathname p))
+        (check ensure-physical (physical-pathname-p p) "Could not translate to a physical pathname")
+        (check want-relative (relative-pathname-p p) "Expected a relative pathname")
+        (check want-absolute (absolute-pathname-p p) "Expected an absolute pathname")
+        (transform ensure-absolute (not (absolute-pathname-p p)) (merge-pathnames* defaults p))
+        (check ensure-absolute (absolute-pathname-p p)
+               "Could not make into an absolute pathname even after merging with ~S" defaults)
+        (check ensure-subpath (absolute-pathname-p defaults)
+               "cannot be checked to be a subpath of non-absolute pathname ~S" defaults)
+        (check ensure-subpath (not (absolute-pathname-p (enough-namestring p defaults)))
+               "is not a sub pathname of ~S" defaults)
+        (check want-file (file-pathname-p p) "Expected a file pathname")
+        (check want-directory (directory-pathname-p p) "Expected a directory pathname")
+        (transform ensure-directory (not (directory-pathname-p p)) (ensure-directory-pathname p))
+        (check want-non-wild (not (wild-pathname-p p)) "Expected a non-wildcard pathname")
+        (check want-wild (wild-pathname-p p) "Expected a wildcard pathname")
+        (transform wilden (not (wild-pathname-p p)) (wilden p))
         (when want-existing
-          (let ((existing (probe-file* pathname)))
+          (let ((existing (probe-file* p)))
             (if existing
-                (when (or want-truename truenamize)
+                (when (or ensure-truename truenamize)
                   (return existing))
-                (err want-existing "Expected an existing pathname, got"))))
-        (when want-truename
-          (let ((truename (truename* pathname)))
+                (err want-existing "Expected an existing pathname"))))
+        (when ensure-directories-exist (ensure-directories-exist p))
+        (when ensure-truename
+          (let ((truename (truename* p)))
             (if truename
                 (return truename)
-                (err want-truename "Can't get a truename for pathname"))))
-        (when truenamize
-          (return (truenamize pathname)))
-        pathname))))
+                (err truename "Can't get a truename for pathname"))))
+        (transform truenamize () (truenamize p))
+        p))))
 
 
 ;;; Hook for output translations
diff --git a/plan.lisp b/plan.lisp
index 77511fd00..26dd98bd3 100644
--- a/plan.lisp
+++ b/plan.lisp
@@ -319,7 +319,7 @@ processed in order by OPERATE."))
 (defmethod traverse ((o operation) (c component) &rest keys &key plan-class &allow-other-keys)
   (let ((plan (apply 'make-instance
                      (or plan-class 'sequential-plan)
-                     :system (component-system c) (remove-keyword :plan-class keys))))
+                     :system (component-system c) (remove-key :plan-class keys))))
     (traverse-action plan o c t)
     (plan-actions plan)))
 
diff --git a/run-program.lisp b/run-program.lisp
index 8cbb7a843..b7b06c6e9 100644
--- a/run-program.lisp
+++ b/run-program.lisp
@@ -167,7 +167,7 @@ by /bin/sh in POSIX"
 
 (defmethod slurp-input-stream ((x (eql :forms)) stream &key &allow-other-keys)
   (declare (ignorable x))
-  (slurp-stream-forms stream))
+  (slurp-stream-form stream :path nil))
 
 (defmethod slurp-input-stream (x stream &key (element-type 'character) &allow-other-keys)
   (declare (ignorable stream element-type))
diff --git a/source-registry.lisp b/source-registry.lisp
index 480853727..2885a88c2 100644
--- a/source-registry.lisp
+++ b/source-registry.lisp
@@ -198,11 +198,11 @@ system names to pathnames of .asd files")
       ((:directory)
        (destructuring-bind (pathname) rest
          (when pathname
-           (funcall register (resolve-location pathname :want-directory t)))))
+           (funcall register (resolve-location pathname :ensure-directory t)))))
       ((:tree)
        (destructuring-bind (pathname) rest
          (when pathname
-           (funcall register (resolve-location pathname :want-directory t)
+           (funcall register (resolve-location pathname :ensure-directory t)
                     :recurse t :exclude *source-registry-exclusions*))))
       ((:exclude)
        (setf *source-registry-exclusions* rest))
@@ -312,4 +312,4 @@ system names to pathnames of .asd files")
 
 (defun* sysdef-source-registry-search (system)
   (ensure-source-registry)
-  (values (gethash (coerce-name system) *source-registry*)))
+  (values (gethash (primary-system-name system) *source-registry*)))
diff --git a/stream.lisp b/stream.lisp
index 903a0598f..288559f53 100644
--- a/stream.lisp
+++ b/stream.lisp
@@ -11,13 +11,11 @@
    #:with-output #:output-string #:with-input
    #:with-input-file #:call-with-input-file
    #:finish-outputs #:format! #:safe-format!
-   #:read-file-forms #:read-first-file-form
    #:copy-stream-to-stream #:concatenate-files
    #:copy-stream-to-stream-line-by-line
-   #:slurp-stream-string #:slurp-stream-lines
-   #:slurp-stream-forms #:read-file-string
-   #:read-file-lines #:read-file-forms
-   #:safe-read-first-file-form #:eval-input #:eval-thunk #:standard-eval-thunk
+   #:slurp-stream-string #:slurp-stream-lines #:slurp-stream-forms #:slurp-stream-form
+   #:read-file-string #:read-file-lines #:read-file-forms #:read-file-form #:safe-read-file-form
+   #:eval-input #:eval-thunk #:standard-eval-thunk
    #:detect-encoding #:*encoding-detection-hook* #:always-default-encoding
    #:encoding-external-format #:*encoding-external-format-hook* #:default-encoding-external-format
    #:*default-encoding* #:*utf-8-external-format*))
@@ -110,14 +108,17 @@ as per CALL-WITH-INPUT, and evaluate BODY within the scope of this binding."
   `(call-with-input ,value #'(lambda (,input-var) ,@body)))
 
 (defun* call-with-input-file (pathname thunk
-                             &key (element-type *default-stream-element-type*)
-                             (external-format :default))
-  "Open FILE for input with given options, call THUNK with the resulting stream."
+                                       &key
+                                       (element-type *default-stream-element-type*)
+                                       (external-format :default)
+                                       (if-does-not-exist :error))
+  "Open FILE for input with given recognizes options, call THUNK with the resulting stream.
+Other keys are accepted but discarded."
   #+gcl<2.7 (declare (ignore external-format))
   (with-open-file (s pathname :direction :input
                      :element-type element-type
                      #-gcl<2.7 :external-format #-gcl<2.7 external-format
-                     :if-does-not-exist :error)
+                     :if-does-not-exist if-does-not-exist)
     (funcall thunk s)))
 
 (defmacro with-input-file ((var pathname &rest keys &key element-type external-format) &body body)
@@ -193,13 +194,41 @@ reading contents line by line."
   (with-open-stream (input input)
     (loop :for l = (read-line input nil nil) :while l :collect l)))
 
-(defun* slurp-stream-forms (input)
-  "Read the contents of the INPUT stream as a list of forms.
+(defun* slurp-stream-forms (input &key count)
+"Read the contents of the INPUT stream as a list of forms,
+and return those forms.
+
+If COUNT is null, read to the end of the stream;
+if COUNT is an integer, stop after COUNT forms were read.
+
 BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
-  (with-open-stream (input input)
-    (loop :with eof = '#:eof
-      :for form = (read input nil eof)
-      :until (eq form eof) :collect form)))
+  (check-type count (or null integer))
+  (loop :with eof = '#:eof
+        :for n :from 0
+        :for form = (if (and count (>= n count))
+                        eof
+                        (read-preserving-whitespace input nil eof))
+        :until (eq form eof) :collect form))
+
+(defun* slurp-stream-form (input &key (path 0))
+"Read the contents of the INPUT stream as a list of forms,
+then return the SUB-OBJECT of these forms following the PATH.
+PATH defaults to 0, i.e. return the first form.
+PATH is typically a list of integers.
+If PATH is NIL, it will return all the forms in the file.
+
+The stream will not be read beyond the Nth form,
+where N is the index specified by path,
+if path is either an integer or a list that starts with an integer.
+
+BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
+  (let* ((count (cond
+                  ((integerp path)
+                   (1+ path))
+                  ((and (consp path) (integerp (first path)))
+                   (1+ (first path)))))
+         (forms (slurp-stream-forms input :count count)))
+    (sub-object forms path)))
 
 (defun* read-file-string (file &rest keys)
   "Open FILE with option KEYS, read its contents as a string"
@@ -210,23 +239,28 @@ BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
 BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
   (apply 'call-with-input-file file 'slurp-stream-lines keys))
 
-(defun* read-file-forms (file &rest keys)
-  "Open FILE with option KEYS, read its contents as a list of forms.
+(defun* read-file-forms (file &rest keys &key count &allow-other-keys)
+  "Open input FILE with option KEYS (except COUNT),
+and read its contents as per SLURP-STREAM-FORMS with given COUNT.
 BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
-  (apply 'call-with-input-file file 'slurp-stream-forms keys))
+  (apply 'call-with-input-file file
+         #'(lambda (input) (slurp-stream-forms input :count count))
+         (remove-key :count keys)))
 
-(defun* read-first-file-form (pathname &key eof-error-p eof-value)
-  "Reads the first form from the top of a file.
+(defun* read-file-form (file &rest keys &key (path 0) &allow-other-keys)
+  "Open input FILE with option KEYS (except path),
+and read its contents as per SLURP-STREAM-FORM with given PATH.
 BEWARE: be sure to use WITH-SAFE-IO-SYNTAX, or some variant thereof"
-  (with-input-file (in pathname)
-    (read-preserving-whitespace in eof-error-p eof-value)))
-
-(defun* safe-read-first-file-form (pathname &key
-                                            (package :cl)
-                                            eof-error-p eof-value)
-  "Reads the first form from the top of a file using a safe standardized syntax"
+  (apply 'call-with-input-file file
+         #'(lambda (input) (slurp-stream-form input :path path))
+         (remove-key :path keys)))
+
+(defun* safe-read-file-form (pathname &rest keys &key (package :cl) &allow-other-keys)
+  "Reads the specified form from the top of a file using a safe standardized syntax.
+Extracts the form using READ-FILE-FORM,
+within an WITH-SAFE-IO-SYNTAX using the specified PACKAGE."
   (with-safe-io-syntax (:package package)
-    (read-first-file-form pathname :eof-error-p eof-error-p :eof-value eof-value)))
+    (apply 'read-file-form pathname (remove-key :package keys))))
 
 (defun* eval-input (input)
   "Portably read and evaluate forms from INPUT, return the last values."
diff --git a/system.lisp b/system.lisp
index 4659fad10..5e3e27bd8 100644
--- a/system.lisp
+++ b/system.lisp
@@ -7,77 +7,20 @@
   (:intern #:children #:children-by-name #:default-component-class
            #:author #:maintainer #:licence #:source-file #:defsystem-depends-on)
   (:export
-   #:child-component #:parent-component #:module #:system #:proto-system
-   #:component-children-by-name #:component-children #:compute-children-by-name
-   #:module-default-component-class
+   #:system #:proto-system
    #:system-source-file #:system-source-directory #:system-relative-pathname
    #:reset-system #:builtin-system-p
    #:system-description #:system-long-description
    #:system-author #:system-maintainer #:system-licence #:system-license
-   #:find-system #:probe-asd ;; forward-reference, methods defined in find-system
-   #:%set-system-source-file ;; For internal use only. DO NOT USE.
-   #:module-components ;; backward-compatibility. DO NOT USE.
+   #:find-system ;; forward-reference, defined in find-system
    #:system-defsystem-depends-on))
 (in-package :asdf/system)
 
 (defgeneric* find-system (system &optional error-p))
-(declaim (ftype (function (t t) t) probe-asd))
-
-;;;; Component hierarchy within a system
-;; The tree typically but not necessarily follows the filesystem hierarchy.
-
-(defclass child-component (component) ())
-
-(defclass parent-component (component)
-  ((children
-    :initform nil
-    :initarg :components
-    :reader module-components ; backward-compatibility
-    :accessor component-children)
-   (children-by-name
-    :reader module-components-by-name ; backward-compatibility
-    :accessor component-children-by-name)
-   (default-component-class
-    :initform nil
-    :initarg :default-component-class
-    :accessor module-default-component-class)))
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun* compute-children-by-name (parent &key only-if-needed-p)
-    (unless (and only-if-needed-p (slot-boundp parent 'children-by-name))
-      (let ((hash (make-hash-table :test 'equal)))
-        (setf (component-children-by-name parent) hash)
-        (loop :for c :in (component-children parent)
-              :for name = (component-name c)
-              :for previous = (gethash name hash)
-              :do (when previous (error 'duplicate-names :name name))
-                  (setf (gethash name hash) c))
-        hash))))
-
-(when-upgrade (:when (find-class 'module nil))
-  (defmethod reinitialize-instance :after ((m module) &rest initargs &key)
-    (declare (ignorable m initargs)) (values))
-  (defmethod update-instance-for-redefined-class :after
-      ((m module) added deleted plist &key)
-    (declare (ignorable m added deleted plist))
-    (when (and (member 'children added) (member 'components deleted))
-      (setf (slot-value m 'children)
-            ;; old ECLs provide an alist instead of a plist(!)
-            (if (or #+ecl (consp (first plist))) (or #+ecl (cdr (assoc 'components plist)))
-                (getf plist 'components)))
-      (compute-children-by-name m))
-    (when (typep m 'system)
-      (when (member 'source-file added)
-        (%set-system-source-file
-         (probe-asd (component-name m) (component-pathname m)) m))
-      (when (equal (component-name m) "asdf")
-        (setf (component-version m) (asdf-version))))))
-
-(defclass module (child-component parent-component)
-  ())
-
+(defgeneric* system-source-file (system)
+  (:documentation "Return the source file in which system is defined."))
 
-;;;; The system class itself
+;;;; The system class
 
 (defclass proto-system () ; slots to keep when resetting a system
   ;; To preserve identity for all objects, we'd need keep the components slots
@@ -93,7 +36,7 @@
    (maintainer :accessor system-maintainer :initarg :maintainer)
    (licence :accessor system-licence :initarg :licence
             :accessor system-license :initarg :license)
-   (source-file :initarg :source-file :writer %set-system-source-file) ; upgrade issues on CLISP, CMUCL
+   (source-file :initform nil :initarg :source-file :accessor system-source-file)
    (defsystem-depends-on :reader system-defsystem-depends-on :initarg :defsystem-depends-on)))
 
 (defun* reset-system (system &rest keys &key &allow-other-keys)
@@ -109,23 +52,14 @@
            (slot-value system 'source-file))
     (call-next-method)))
 
-(defgeneric* system-source-file (system)
-  (:documentation "Return the source file in which system is defined."))
-(defmethod system-source-file ((system system))
-  ;; might be missing when upgrading from ASDF 1 and u-i-f-r-c failed
-  (unless (slot-boundp system 'source-file)
-    (%set-system-source-file
-     (probe-asd (component-name system) (component-pathname system)) system))
-  (slot-value system 'source-file))
 (defmethod system-source-file ((system-name string))
   (system-source-file (find-system system-name)))
 (defmethod system-source-file ((system-name symbol))
   (system-source-file (find-system system-name)))
 
 (defun* system-source-directory (system-designator)
-  "Return a pathname object corresponding to the
-directory in which the system specification (.asd file) is
-located."
+  "Return a pathname object corresponding to the directory
+in which the system specification (.asd file) is located."
   (pathname-directory-pathname (system-source-file system-designator)))
 
 (defun* system-relative-pathname (system name &key type)
diff --git a/test/run-tests.sh b/test/run-tests.sh
index ebeb5b645..82904dfda 100755
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -195,9 +195,12 @@ if ! type "$command" > /dev/null ; then
 fi
 
 ASDFDIR="$(cd $(dirname $0)/.. ; /bin/pwd)"
+
+## Make sure testing remains within the confines of this filesystem tree
 export CL_SOURCE_REGISTRY="${ASDFDIR}"
 export ASDF_OUTPUT_TRANSLATIONS="(:output-translations (\"${ASDFDIR}\" (\"${ASDFDIR}/build/fasls\" :implementation)) :ignore-inherited-configuration)"
 
+
 command="$command $flags"
 if [ -z "${DEBUG_ASDF_TEST}" ] ; then
   command="$command $nodebug"
diff --git a/test/script-support.lisp b/test/script-support.lisp
index 728a0e2ac..32db7b1a0 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -158,9 +158,10 @@ Some constraints:
 (defun touch-file (file &key (offset 0) timestamp)
   (let ((timestamp (or timestamp (+ offset (get-universal-time)))))
     (multiple-value-bind (sec min hr day month year) (decode-universal-time timestamp #+gcl<2.7 -5)
-      (acall :run-shell-command
-             "touch -t ~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D ~S"
-             year month day hr min sec (namestring file))
+      (acall :run-program/
+             `("touch" "-t" ,(format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D"
+                                     year month day hr min sec)
+                       ,(namestring file)))
       (assert-equal (file-write-date file) timestamp))))
 
 (defun hash-table->alist (table)
diff --git a/upgrade.lisp b/upgrade.lisp
index 60b35c50f..ed4a23461 100644
--- a/upgrade.lisp
+++ b/upgrade.lisp
@@ -12,19 +12,19 @@
    #:asdf-version #:*upgraded-p*
    #:asdf-message #:*asdf-verbose* #:*verbose-out*
    ;; There will be no symbol left behind!
-   #:o #:c #:dep-o #:dep-c #:intern*)
+   #:intern*)
   (:import-from :asdf/package #:intern* #:find-symbol*))
 (in-package :asdf/upgrade)
 
 ;; 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)
 (eval-when (:load-toplevel :compile-toplevel :execute)
+  #+(or clisp xcl)
   (unless (let ((vs (find-symbol* 'version-satisfies :asdf nil))
                 (av (find-symbol* 'asdf-version :asdf nil)))
             (and vs av (funcall vs (funcall av) "2.26.59")))
     (if-bind (p (find-package :asdf))
-      (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))))
+             (do-symbols (s p) (when (home-package-p s p) (nuke-symbol s))))))
 
 ;;; Special magic to detect if this is an upgrade
 
@@ -45,7 +45,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.105")
+         (asdf-version "2.26.106")
          (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 224a2869e..b8f8dc9b2 100644
--- a/utility.lisp
+++ b/utility.lisp
@@ -10,15 +10,17 @@
    #:asdf-debug #:load-asdf-debug-utility #:*asdf-debug-utility*
    #:undefine-function #:undefine-functions #:defun* #:defgeneric* ;; (un)defining functions
    #:if-bind ;; basic flow control
-   #:while-collecting #:appendf #:length=n-p #:remove-keys #:remove-keyword ;; lists and plists
+   #:while-collecting #:appendf #:length=n-p #:remove-keys #:remove-key ;; lists and plists
    #:emptyp ;; sequences
    #:first-char #:last-char #:split-string ;; strings
    #:string-prefix-p #:string-enclosed-p #:string-suffix-p
    #:find-class* ;; CLOS
-   #:stamp< #:stamp<= #:earlier-stamp #:stamps-earliest #:earliest-stamp ;; stamps
+   #:stamp< #:stamps< #:stamp*< #:stamp<= ;; stamps
+   #:earlier-stamp #:stamps-earliest #:earliest-stamp
    #:later-stamp #:stamps-latest #:latest-stamp #:latest-stamp-f
    #:list-to-hash-set ;; hash-table
-   #:ensure-function #:call-function #:call-functions #:register-hook-function ;; functions
+   #:ensure-function #:sub-object ;; functions
+   #:call-function #:call-functions #:register-hook-function
    #:match-condition-p #:match-any-condition-p ;; conditions
    #:call-with-muffled-conditions #:with-muffled-conditions
    #:load-string #:load-stream
@@ -122,23 +124,26 @@ Returns two values: \(A B C\) and \(1 2 3\)."
       ((zerop i) (return (null l)))
       ((not (consp l)) (return nil)))))
 
-;;; Keyword argument lists
-(defun* remove-keys (key-names args)
-  (loop :for (name val) :on args :by #'cddr
-    :unless (member (symbol-name name) key-names
-                    :key #'symbol-name :test 'equal)
-    :append (list name val)))
-
-(defun* remove-keyword (key args)
-  (loop :for (k v) :on args :by #'cddr
+;;; remove a key from a plist, i.e. for keyword argument cleanup
+(defun* remove-key (key plist)
+  "Remove a single key from a plist"
+  (loop :for (k v) :on plist :by #'cddr
     :unless (eq k key)
     :append (list k v)))
 
+(defun* remove-keys (keys plist)
+  "Remove a list of keys from a plist"
+  (loop :for (k v) :on plist :by #'cddr
+    :unless (member k keys)
+    :append (list k v)))
+
+
 ;;; Sequences
 (defun* emptyp (x)
   "Predicate that is true for an empty sequence"
   (or (null x) (and (vectorp x) (zerop (length x)))))
 
+
 ;;; Strings
 
 (defun* first-char (s)
@@ -207,8 +212,8 @@ starting the separation from the end, e.g. when called with arguments
             (null nil)
             ((eql t) t)
             (real (< x y))))))
-;;(defun* stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y)))
-;;(defun* stamp*< (&rest list) (stamps< list))
+(defun* stamps< (list) (loop :for y :in list :for x = nil :then y :always (stamp< x y)))
+(defun* stamp*< (&rest list) (stamps< list))
 (defun* stamp<= (x y) (not (stamp< y x)))
 (defun* earlier-stamp (x y) (if (stamp< x y) x y))
 (defun* stamps-earliest (list) (reduce 'earlier-stamp list :initial-value t))
@@ -224,16 +229,45 @@ starting the separation from the end, e.g. when called with arguments
   (dolist (x list h) (setf (gethash x h) t)))
 
 
-;;; Code execution
+;;; Function designators
 (defun* ensure-function (fun &key (package :cl))
+  "Coerce the object FUN into a function.
+
+If FUN is a FUNCTION, return it.
+If the FUN is a non-sequence literal constant, return constantly that,
+i.e. for a boolean keyword character number or pathname.
+Otherwise if FUN is a non-literally constant symbol, return its FDEFINITION.
+If FUN is a CONS, return the function that applies its CAR
+to the appended list of the rest of its CDR and the arguments.
+If FUN is a string, READ a form from it in the specified PACKAGE (default: CL)
+and EVAL that in a (FUNCTION ...) context."
   (etypecase fun
+    (function fun)
     ((or boolean keyword character number pathname) (constantly fun))
     ((or function symbol) fun)
-    (cons (eval `(function ,fun)))
+    (cons #'(lambda (&rest args) (apply (car fun) (append (cdr fun) args))))
     (string (eval `(function ,(with-standard-io-syntax
                                 (let ((*package* (find-package package)))
                                   (read-from-string fun))))))))
 
+(defun* sub-object (object path)
+  "Given an OBJECT and a PATH, list of successive accessors,
+call each accessor on the result of the previous calls.
+An accessor may be an integer, meaning a call to ELT,
+a function or symbol, meaning itself,
+or a list of a function and arguments, interpreted as per ENSURE-FUNCTION.
+As a degenerate case, the PATH may be an atom of a single such accessor
+instead of a list."
+  (flet ((access (object accessor)
+           (etypecase accessor
+             (integer (elt object path))
+             ((or function symbol) (funcall accessor object))
+             (cons (funcall (ensure-function accessor) object)))))
+    (if (listp path)
+        (dolist (accessor path object)
+          (setf object (access object accessor)))
+        (access object path))))
+
 (defun* call-function (function-spec &rest arguments)
   (apply (ensure-function function-spec) arguments))
 
@@ -246,27 +280,36 @@ starting the separation from the end, e.g. when called with arguments
 
 
 ;;; Version handling
-(defun* parse-version (string &optional on-error)
-  "Parse a version string as a series of natural integers separated by dots.
-Return a (non-null) list of integers if the string is valid, NIL otherwise.
-If on-error is error, warn, or designates a function of compatible signature,
-the function is called with an explanation of what is wrong with the argument.
-NB: ignores leading zeroes, and so doesn't distinguish between 2.003 and 2.3"
+(defun* unparse-version (version-list)
+  (format nil "~{~D~^.~}" version-list))
+
+(defun* parse-version (version-string &optional on-error)
+  "Parse a VERSION-STRING as a series of natural integers separated by dots.
+Return a (non-null) list of integers if the string is valid;
+otherwise return NIL.
+
+When invalid, ON-ERROR is called as per CALL-FUNCTION before to return NIL,
+with format arguments explaining why the version is invalid.
+ON-ERROR is also called if the version is not canonical
+in that it doesn't print back to itself, but the list is returned anyway."
   (block nil
-   (unless (stringp string)
-     (call-function on-error "~S: ~S is not a string" 'parse-version string)
+   (unless (stringp version-string)
+     (call-function on-error "~S: ~S is not a string" 'parse-version version-string)
      (return))
-   (unless (loop :for prev = nil :then c :for c :across string
+   (unless (loop :for prev = nil :then c :for c :across version-string
                  :always (or (digit-char-p c)
                              (and (eql c #\.) prev (not (eql prev #\.))))
                  :finally (return (and c (digit-char-p c))))
      (call-function on-error "~S: ~S doesn't follow asdf version numbering convention"
-                    'parse-version string)
+                    'parse-version version-string)
      (return))
-   (mapcar #'parse-integer (split-string string :separator "."))))
+   (let* ((version-list
+            (mapcar #'parse-integer (split-string version-string :separator ".")))
+          (normalized-version (unparse-version version-list)))
+     (unless (equal version-string normalized-version)
+       (call-function on-error "~S: ~S contains leading zeros" 'parse-version version-string))
+     version-list)))
 
-(defun* unparse-version (version-list)
-  (format nil "~{~D~^.~}" version-list))
 
 (defun* version-compatible-p (provided-version required-version)
   "Is the provided version a compatible substitution for the required-version?
diff --git a/version.lisp-expr b/version.lisp-expr
index e1a03a91b..a8e926a0f 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -1 +1 @@
-"2.26.105"
+"2.26.106"
-- 
GitLab