From db16661bb680c2cb446dc32d5bfed7c63441e76f Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Sat, 17 May 2014 01:47:29 +0200
Subject: [PATCH] Move most Makefile stuff to CL in bin/asdf-builder!

---
 Makefile         | 269 ++----------------
 bin/asdf-builder | 695 ++++++++++++++++++++++++++++++++++++-----------
 2 files changed, 558 insertions(+), 406 deletions(-)

diff --git a/Makefile b/Makefile
index fb76b2d27..b93243034 100644
--- a/Makefile
+++ b/Makefile
@@ -1,267 +1,42 @@
-system	 	:= "asdf"
-webhome_private := common-lisp.net:/project/asdf/public_html/
-webhome_public	:= "http://common-lisp.net/project/asdf/"
-clnet_home      := "/project/asdf/public_html/"
-sourceDirectory := $(shell pwd)
+# -*- Makefile -*- This minimal Makefile delegates most work to the meta-asdf script
 
-#### Common Lisp implementations available for testing.
-## export ASDF_TEST_LISPS to override the default list of such implementations,
-## or specify a lisps= argument at the make command-line
-defaultLisps = ccl clisp sbcl ecl ecl_bytecodes cmucl abcl scl allegro lispworks allegromodern gcl xcl mkcl
-ifdef ASDF_TEST_LISPS
-lisps ?= ${ASDF_TEST_LISPS}
-else
-lisps ?= ${defaultLisps}
-endif
-ifdef ASDF_UPGRADE_TEST_LISPS
-  ulisps ?= ${ASDF_UPGRADE_TEST_LISPS}
-else
-  ifdef ASDF_TEST_LISPS
-    ulisps ?= ${ASDF_TEST_LISPS}
-  else
-    ulisps ?= ${defaultLisps}
-  endif
-endif
-
-
-## grep for #+/#- features in the test/ directory to see plenty of disabled tests on some platforms
-## NOT SUPPORTED BY OUR AUTOMATED TESTS:
-##	cormancl genera lispworks-personal-edition rmcl
-## Some are manually tested once in a while.
-ifdef ASDF_TEST_SYSTEMS
-s ?= ${ASDF_TEST_SYSTEMS}
-endif
-
-ifdef ASDF_DEVEL_SOURCE_REGISTRY
-export CL_SOURCE_REGISTRY = ${ASDF_DEVEL_SOURCE_REGISTRY}
-endif
+# Users, all you need to do is:
+#   make
+# Other targets are for the maintainer to use.
+#
+# Vendors, you may want to test your implementation with:
+#   make test l=sbcl
+#
 
-l ?= sbcl
 
-ABCL ?= abcl
-ALLEGRO ?= alisp
-ALLEGROMODERN ?= mlisp
-CCL ?= ccl
-CLISP ?= clisp
-CMUCL ?= cmucl
-ECL ?= ecl
-GCL ?= gcl
-LISPWORKS ?= lispworks
-MKCL ?= mkcl
-SBCL ?= sbcl
-SCL ?= scl
-XCL ?= xcl
+# Default action: bootstrap asdf.lisp
+# That's the only thing that we really need before we may invoke asdf-builder.
+all: build/asdf.lisp
+	@: # This dummy action is necessary so the all target does not invoke the fallback action.
 
 header_lisp := header.lisp
 driver_lisp := uiop/package.lisp uiop/common-lisp.lisp uiop/utility.lisp uiop/os.lisp uiop/pathname.lisp uiop/filesystem.lisp uiop/stream.lisp uiop/image.lisp uiop/run-program.lisp uiop/lisp-build.lisp uiop/configuration.lisp uiop/backward-driver.lisp uiop/driver.lisp
 defsystem_lisp := upgrade.lisp component.lisp system.lisp cache.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 parse-defsystem.lisp bundle.lisp concatenate-source.lisp backward-interface.lisp package-inferred-system.lisp interface.lisp user.lisp footer.lisp
-all_lisp := $(header_lisp) $(driver_lisp) $(defsystem_lisp)
 
 # Making ASDF itself should be our first, default, target:
-build/asdf.lisp: $(all_lisp)
+build/asdf.lisp: $(header_lisp) $(driver_lisp) $(defsystem_lisp)
 	mkdir -p build
 	rm -f $@
-	cat $(all_lisp) > $@
-
-# This quickly locates such mistakes as unbalanced parentheses:
-load: build/asdf.lisp
-	./test/run-tests.sh -t $l $(all_lisp)
-
-install: archive
-
-bump: bump-version
-	git commit -a -m "Bump version to $$(eval a=$$(cat version.lisp-expr) ; echo $$a)"
-	temp=$$(cat version.lisp-expr); temp="$${temp%\"}"; temp="$${temp#\"}"; git tag $$temp
-
-bump-version: build/asdf.lisp
-	./bin/asdf-builder bump-version ${v}
+	cat $^ > $@
 
+# These targets are used during tests to ensure the Makefile is in synch with the .asd files.
 driver-files:
 	@echo $(driver_lisp)
 
 defsystem-files:
 	@echo $(defsystem_lisp)
 
-archive: build/asdf.lisp
-	./bin/asdf-builder make-and-publish-archive
-
-### Count lines separately for asdf-driver and asdf itself:
-wc:
-	@wc $(driver_lisp) | sort -n ; echo ; \
-	wc $(header_lisp) $(defsystem_lisp) | sort -n ; \
-	echo ; \
-	wc $(header_lisp) $(driver_lisp) $(defsystem_lisp) | tail -n 1
-
-push:
-	git status
-	git push --tags cl.net release master
-	git push --tags github release master
-	git fetch
-	git status
-
-doc:
-	${MAKE} -C doc
-
-website:
-	${MAKE} -C doc website
-
-clean_dirs = $(sourceDirectory)
-clean_extensions = fasl dfsl cfsl fasl fas lib dx32fsl lx64fsl lx32fsl ufasl o bak x86f vbin amd64f sparcf sparc64f hpf hp64f
-
-clean:
-	@for dir in $(clean_dirs); do \
-	     if test -d $$dir; then \
-	     	 echo Cleaning $$dir; \
-		 for ext in $(clean_extensions); do \
-		     find $$dir \( -name "*.$$ext" \) \
-	     	    -and -not -path \""*/.git/*"\" \
-		     	  -and -not -path \""*/_darcs/*"\" \
-	     		  -and -not -path \""*/tags/*"\" -print -delete; \
-		done; \
-	     fi; \
-	done
-	rm -rf build/ LICENSE test/try-reloading-dependency.asd test/hello-world-example asdf.lisp
-	rm -rf test/hello-world-example.exe test/mkcl_*.dll # needed only on MS-Windows
-	rm -rf .pc/ build-stamp debian/patches/ debian/debhelper.log debian/cl-asdf/ # debian crap
-	${MAKE} -C doc clean
-
-mrproper:
-	git clean -xfd
-
-test-upgrade: build/asdf.lisp
-	./test/run-tests.sh -u ${l}
-u: test-upgrade
-
-test-clean-load: build/asdf.lisp
-	./test/run-tests.sh -c ${l}
-
-# test-glob has been replaced by t, and lisp by l, easier to type
-test-lisp: build/asdf.lisp
-	@cd test; ./run-tests.sh ${l} ${t}
-t: test-lisp
-
-test: test-lisp test-clean-load test-load-systems doc
-
-test-load-systems: build/asdf.lisp
-	./test/run-tests.sh -l ${l} ${s}
-
-test-all-lisps: test-load-systems test-all-clean-load test-all-lisp test-all-upgrade
-
-test-all-clean-load:
-	@for lisp in ${lisps} ; do ${MAKE} test-clean-load l=$$lisp || exit 1 ; done
+### exclude source files from fallback rule.
+%.lisp:
+Makefile:
 
-test-all-lisp:
-	@for lisp in ${lisps} ; do ${MAKE} test-lisp l=$$lisp || exit 1 ; done
+### Default fall back rule: delegate to asdf-builder.
+%: build/asdf.lisp
+	@echo "Delegating $@ to asdf-builder" ; ./bin/asdf-builder $@
 
-test-all-upgrade:
-	@for lisp in ${ulisps} ; do ${MAKE} test-upgrade l=$$lisp || exit 1 ; done
-
-test-all-no-upgrade: doc test-load-systems test-all-clean-load test-all-lisp
-
-test-all: test-all-no-upgrade test-all-upgrade
-
-test-all-lisp-no-stop:
-	@for lisp in ${lisps} ; do ${MAKE} test-lisp l=$$lisp ; done ; :
-
-test-all-upgrade-no-stop:
-	@for lisp in ${ulisps} ; do ${MAKE} test-upgrade l=$$lisp ; done ; :
-
-test-all-no-upgrade-no-stop: doc test-load-systems test-all-clean-load test-all-lisp-no-stop
-	make --quiet check-all-test-results
-
-test-all-no-stop: doc test-load-systems test-all-clean-load test-all-lisp-no-stop test-all-upgrade-no-stop
-	make --quiet check-all-results
-
-check-all-test-results:
-	@A="`grep -L '[5-9][0-9] passing and 0 failing' build/results/*-test.text`" ; \
-	if [ -n "$$A" ] ; then \
-		echo "Unexpected test failures on these implementations:" ; \
-		echo "$$A" ; \
-		exit 1 ; \
-	fi
-
-check-all-upgrade-results:
-	@A="`grep -L 'Upgrade test succeeded for ' build/results/*-upgrade.text`" ; \
-	if [ -n "$$A" ] ; then \
-		echo "Unexpected upgrade failures on these implementations:" ; \
-		echo "$$A" ; \
-		exit 1 ; \
-	fi
-
-check-all-results:
-	@r=0 ; \
-	make --quiet check-all-test-results || r=1 ; \
-	make --quiet check-all-upgrade-results || r=1 ; \
-	exit $r
-
-extract: extract-all-tagged-asdf
-extract-all-tagged-asdf: build/asdf.lisp
-	./test/run-tests.sh -H
-
-# Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale,
-# as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git
-debian-package:
-	./bin/asdf-builder debian-package release
-
-debian-package-from-master:
-	./bin/asdf-builder debian-package master
-
-
-# Replace SBCL's ASDF with the current one. -- NOT recommended now that SBCL has ASDF2.
-# for casual users, just use (asdf:load-system :asdf)
-replace-sbcl-asdf: build/asdf.lisp
-	${SBCL} --eval '(compile-file "$<" :output-file (format nil "~Aasdf/asdf.fasl" (sb-int:sbcl-homedir-pathname)))' --eval '(quit)'
-
-# Replace CCL's ASDF with the current one. -- NOT recommended now that CCL has ASDF2.
-# for casual users, just use (asdf:load-system :asdf)
-replace-ccl-asdf: build/asdf.lisp
-	${CCL} --eval '(progn(compile-file "$<" :output-file (compile-file-pathname (format nil "~Atools/asdf.lisp" (ccl::ccl-directory))))(quit))'
-
-WRONGFUL_TAGS := 1.37 1.1720 README RELEASE STABLE emp # It's not 1.37, it's 1.85! 1.37 is for the README.
-# Delete wrongful tags from local repository
-fix-local-git-tags:
-	for i in ${WRONGFUL_TAGS} ; do git tag -d $$i ; done
-
-# Delete wrongful tags from remote repository
-fix-remote-git-tags:
-	for i in ${WRONGFUL_TAGS} ; do git push $${REMOTE:-cl.net} :refs/tags/$$i ; done
-
-release-push:
-	git checkout master
-	git merge release
-	git checkout release
-	git merge master
-	git checkout master
-
-TODO:
-	exit 2
-
-release: TODO test-all test-on-other-machines-too debian-changelog debian-package send-mail-to-mailing-lists
-
-.PHONY: install archive push doc website clean mrproper \
-	test-forward-references test test-lisp test-upgrade test-forward-references \
-	test-all test-all-lisps test-all-no-upgrade \
-	debian-package release \
-	replace-sbcl-asdf replace-ccl-asdf \
-	fix-local-git-tags fix-remote-git-tags wc wc-driver wc-asdf
-
-# RELEASE or PUSH checklist:
-# make test-all
-# make test-load-systems s=fare-all
-# make bump v=3.0
-# edit debian/changelog # RELEASE only...
-# git commit
-# git tag 3.0 # for example ...
-# make debian-package
-# git push
-# git push origin 3.0 # for example...
-# everything from here for RELEASE only
-# make release-push archive website debian-package
-# dput mentors ../*.changes
-# send debian mentors request
-# send announcement to asdf-announce, asdf-devel, etc.
-# Move all fixed bugs from Fix Committed -> Fix Released on launchpad
-#
-## Users don't release as above, only maintainers do.
-## Users, all you need to do is: make
-## Vendors, you may want to test your implementation with: make test l=sbcl
+.PHONY: all driver-files defsystem-files
diff --git a/bin/asdf-builder b/bin/asdf-builder
index 4f410e5f5..4f9346d0a 100755
--- a/bin/asdf-builder
+++ b/bin/asdf-builder
@@ -2,6 +2,11 @@
 ;;;;; Really runs on any decent Common Lisp implementation
 ;;;;; Can also be invoked by cl-launch 4: cl-launch "$0" "$@"
 
+;;;; This file is conceptually in several parts:
+;;;; 1- a header that loads ASDF, even when the implementation might or might not provide it.
+;;;; 2- a body that defines various functions used to build and release ASDF
+;;;; 3- a footer that makes these Lisp functions available from the shell command-line
+
 ;;; The code below exemplifies how to load and configure ASDF
 ;;; as part of your own deterministic build.
 ;;; See "User-configurable parts" for where you'd customize it to suit your build.
@@ -13,7 +18,7 @@
 ;;; To use the user-configured ASDF rather than a deterministic self-contained project build,
 ;;; see instead how cl-launch 4.0.4 loads ASDF.
 
-(in-package :cl-user) ;; That's may be default, but let's make double sure and tell SLIME.
+(in-package :cl-user) ;; That may be default, but let's make double sure and tell SLIME.
 
 ;; Do everything in eval-when, so this works
 ;; whether this file is being loaded directly or compiled first.
@@ -87,10 +92,11 @@
                         ;;     :want-absolute t :ensure-directory t)
                         (subpath (here-directory) :directory '(:back)))
                       (source-registry
-                        `(:source-registry
-                          (:tree ,source-directory)
-                          ;; In a fully controlled build, you'd :ignore-inherited-configuration instead:
-                          :inherit-configuration))
+                        (or (asdf-call 'getenv "ASDF_DEVEL_SOURCE_REGISTRY")
+                            `(:source-registry
+                              (:tree ,source-directory)
+                              ;; In a fully controlled build, you'd :ignore-inherited-configuration instead:
+                              :inherit-configuration)))
                       (output-directory
                         ;; There again, you might want to use some getenv variant.
                         ;; Also, "fasls" might be redundant for your project.
@@ -120,27 +126,23 @@
       ;; Load and configure ASDF
       (load-and-configure-asdf))))
 
-(in-package :asdf)
-
+;;; ASDF3 is loaded, now use it!
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (load-systems :cl-ppcre :fare-utils :inferior-shell))
-
-(unless (featurep :cl-launch) (restore-image))
+  (unless (uiop:featurep :cl-launch) (uiop:restore-image))
+  (asdf:load-systems :cl-ppcre :fare-utils :inferior-shell))
 
 (defpackage :asdf-builder
-  (:use :cl :uiop :asdf/operate :asdf :fare-utils :inferior-shell)
-  (:shadow #:DBG))
+  (:use :cl :uiop :asdf :cl-ppcre :fare-utils :inferior-shell))
 
 (in-package :asdf-builder)
 
-(uiop-debug)
+;;(uiop-debug)
 
 (defun build-asdf ()
   "Make sure asdf.lisp is built"
   (load-system :asdf)
   (values))
 
-
 ;;; ASDF directory
 (defvar *asdf-dir*
   (ensure-pathname (system-relative-pathname :asdf/defsystem ())
@@ -151,18 +153,207 @@
 (defun nn (&rest x)
   (native-namestring (apply 'pn x)))
 
-;;; UIOP directory
-(defvar *uiop-dir* (pn "uiop/"))
+(defun call-with-asdf-dir (thunk &rest subs)
+  (with-current-directory ((apply 'pn subs))
+    (funcall thunk)))
+
+(defmacro with-asdf-dir ((&rest subs) &body body)
+  `(call-with-asdf-dir (lambda () ,@body) ,@subs))
+
+
+;;; Using git
+;; Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale,
+;; as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git
+
+(defun git (cmd &rest args)
+  (with-asdf-dir ()
+    (apply 'run (cons "git" cmd) args)))
+
+(defun clean ()
+  (git '(clean -xfd))
+  (values))
+
+(defun %push ()
+  "Push git branches master and release to cl.net and master"
+  (with-asdf-dir ()
+    (dolist (x '((git status)
+                 (git push --tags cl.net release master)
+                 (git push --tags github release master)
+                 (git fetch)
+                 (git status)))
+      (run x))))
+
+(defun merge-master-into-release ()
+  "Merge master into release"
+  (with-asdf-dir ()
+    (dolist (x '((git checkout master)
+                 (git merge release)
+                 (git checkout release)
+                 (git merge master)
+                 (git checkout master)))
+      (run x))))
+
+(defparameter *wrongful-tags*
+  '("1.37" ;; It's not asdf.lisp 1.37, it's asdf.lisp 1.85! 1.37 was the CVS version of the README.
+    "1.1720" ;; That was a typo for 1.720
+    "RELEASE" "STABLE" ;; These were misguided attempts for what should have been branches
+    "README" "emp")) ;; Mistakes
+
+(defun fix-local-git-tags ()
+  "Delete wrongful tags from local repository"
+  (dolist (tag *wrongful-tags*)
+    (git `(tag -d ,tag) :on-error t)))
+
+(defun fix-remote-git-tags (&optional (remote "origin"))
+  "Delete wrongful tags from remote repository"
+  (dolist (tag *wrongful-tags*)
+    (git `(push ,remote (:refs/tags/,tag)) :on-error t)))
+
+(defun git-all-committed-p ()
+  "Is your checkout clean, with all files committed?"
+  (null (git '(status -s) :output :lines)))
+
+(defun check-git-all-committed ()
+  (or (git-all-committed-p)
+      (die 2 "Your git checkout isn't clean and all committed:~%~A~%"
+           (git '(status) :output :string))))
+
+
+;;; Documentation
+(defun doc ()
+  (run '(make) :directory (pn "doc/")))
+
+(defun website ()
+  (run '(make website) :directory (pn "doc/")))
+
+
+;;; Extracting version information
+
+(defparameter *version-tag-glob* "[0-9][.][0-9]*")
+
+(defun version-from-tag (&optional commit)
+  (git `(describe --tags --match ,*version-tag-glob*)
+       :output :line :directory (pn)))
+
+(defun version-from-file (&optional commit)
+  (if commit
+      (git `(show (,commit":version.lisp-expr")) :output :form)
+      (safe-read-file-form (pn "version.lisp-expr"))))
+
+(defun debian-version-from-file (&optional commit)
+  (let ((line
+          (if commit
+              (git `(show (,commit":debian/changelog")) :output :line)
+              (read-file-line (pn "debian/changelog")))))
+    (cl-ppcre:register-groups-bind (ver) ("^cl-asdf [(]([0-9.:-]+)[)] " line)
+      ver)))
+
+(defparameter *version* (version-from-file))
+
+
+
+;;; Bumping the version of ASDF
+
+(defparameter *versioned-files*
+  '(("version.lisp-expr" "\"" "\"")
+    ("asdf.asd" "  :version \"" "\" ;; to be automatically updated by make bump-version")
+    ("header.lisp" "This is ASDF " ": Another System Definition Facility.")
+    ("upgrade.lisp" "   (asdf-version \"" "\")")))
+
+(defparameter *old-version* nil)
+(defparameter *new-version* nil)
+
+(defun next-version (v)
+  (let ((pv (parse-version v 'error)))
+    (assert (first pv))
+    (assert (second pv))
+    (unless (third pv) (appendf pv (list 0)))
+    (unless (fourth pv) (appendf pv (list 0)))
+    (incf (car (last pv)))
+    (unparse-version pv)))
+
+(defun versions-from-args (&optional v1 v2)
+  (labels ((check (old new)
+             (parse-version old 'error)
+             (parse-version new 'error)
+             (values old new)))
+    (cond
+      ((and v1 v2) (check v1 v2))
+      (v1 (check (version-from-file) v1))
+      (t (let ((old (version-from-file)))
+           (check old (next-version old)))))))
+
+(deftype byte-vector () '(array (unsigned-byte 8) (*)))
+
+(defun maybe-replace-file (file transformer
+                           &key (reader 'read-file-string)
+                             (writer nil) (comparator 'equalp)
+                             (external-format *utf-8-external-format*))
+  (format t "Transforming file ~A... " (file-namestring file))
+  (let* ((old-contents (funcall reader file))
+         (new-contents (funcall transformer old-contents)))
+    (if (funcall comparator old-contents new-contents)
+        (format t "no changes needed!~%")
+        (let ((written-contents
+                (if writer
+                    (with-output (s ())
+                      (funcall writer s new-contents))
+                    new-contents)))
+          (check-type written-contents (or string (byte-vector)))
+          (clobber-file-with-vector file written-contents :external-format external-format)
+          (format t "done.~%")))))
+
+(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))
+         (regex (strcat "(" qprefix ")(" versionrx ")(" qsuffix ")"))
+         (replacement
+           (constantly (strcat prefix new-version suffix))))
+    (lambda (text)
+      (multiple-value-bind (new-text foundp)
+          (cl-ppcre:regex-replace regex text replacement)
+        (unless (or foundp dont-warn)
+          (warn "Missing version in ~A" (file-namestring file)))
+        (values new-text foundp)))))
+
+(defun transform-file (new-version file prefix suffix)
+  (maybe-replace-file (pn file) (version-transformer new-version file prefix suffix)))
+
+(defun transform-files (new-version)
+  (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f)))
+
+(defun test-transform-file (new-version file prefix suffix)
+  (let ((lines (read-file-lines (pn 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 t) l)
+        (when foundp
+          (format t "Found a match:~%  ==> ~A~%Replacing with~%  ==> ~A~%~%"
+                  l new-text)
+          (return t))))))
+
+(defun test-transform (new-version)
+  (apply 'test-transform-file new-version (first *versioned-files*)))
 
-;;; build directory
-(defparameter *build-dir* (pn "build/"))
-(defparameter /build-dir/ (nn "build/"))
-(defun bpath (x &rest keys) (apply 'subpathname *build-dir* x keys))
+(defun bump-version (&optional v1 v2)
+  (with-asdf-dir ()
+    (multiple-value-bind (old-version new-version)
+        (versions-from-args v1 v2)
+      (a "Bumping ASDF version from " old-version " to " new-version)
+      (transform-files new-version)
+      (a "Rebuilding ASDF with bumped version")
+      (build-asdf)
+      new-version)))
 
-(defparameter *version-file*
-  (pn "version.lisp-expr"))
+(defun bump (&optional v1 v2)
+  (let ((v (bump-version v1 v2)))
+    (git `(commit -a -m ("Bump version to ",v)))
+    (git `(tag ,v))
+    v))
 
-(defparameter *version* (safe-read-file-form *version-file*))
+
+;;; Getting a list of source files in a system
 
 (defun enough-namestring! (base pathname)
   (let ((e (enough-namestring base pathname)))
@@ -174,20 +365,23 @@
         :for p :in pathnames
         :collect (enough-namestring! p b)))
 
-(defun system-source-files (system)
+(defun system-source-files (system &key monolithic)
   (let* ((sys (find-system system))
+         (components
+           (required-components system
+                                :other-systems monolithic
+                                :goal-operation 'load-op
+                                :keep-operation 'load-op
+                                :keep-component 'file-component))
          (dir (ensure-pathname
                (system-source-directory sys)
                :want-absolute t :want-directory t))
-         (components
-           (required-components
-            sys :other-systems nil
-            :goal-operation 'load-op
-            :keep-operation 'load-op
-            :keep-component 'file-component))
          (pathnames (mapcar 'component-pathname components)))
     (enough-namestrings dir pathnames)))
 
+
+;;; Making release tarballs for asdf, asdf/defsystem, uiop.
+
 (defun tarname (name) (strcat name ".tar.gz"))
 
 (defun make-tarball-under-build (name base files)
@@ -203,13 +397,13 @@
          (destination
            (ensure-pathname
             name
-            :defaults *build-dir*
+            :defaults (pn "build/")
             :want-relative t :ensure-absolute t
             :ensure-subpath t :ensure-directory t))
          (tarball
            (ensure-pathname
             (tarname name)
-            :defaults *build-dir*
+            :defaults (pn "build/")
             :want-relative t :ensure-absolute t
             :ensure-subpath t :want-file t
             :ensure-directories-exist t)))
@@ -219,7 +413,7 @@
              destination))
     (ensure-directories-exist destination)
     (run `(cp "-pHux" --parents ,@files ,destination) :directory base :show t)
-    (run `(tar "zcfC" ,tarball ,*build-dir* (,name /)) :show t)
+    (run `(tar "zcfC" ,tarball ,(pn "build/") (,name /)) :show t)
     (delete-directory-tree destination :validate (lambda (x) (equal x destination)))
     (values)))
 
@@ -228,7 +422,7 @@
 (defun driver-name ()
   (format nil "uiop-~A" *version*))
 (defun make-driver-tarball ()
-  (make-tarball-under-build (driver-name) *uiop-dir* (driver-files)))
+  (make-tarball-under-build (driver-name) (pn "uiop/") (driver-files)))
 
 (defun asdf-defsystem-files ()
   (list* "asdf.asd" "build/asdf.lisp" "version.lisp-expr" "header.lisp"
@@ -237,13 +431,14 @@
   (format nil "asdf-defsystem-~A" *version*))
 (defun make-asdf-defsystem-tarball ()
   (build-asdf)
-  (make-tarball-under-build (asdf-defsystem-name) *asdf-dir* (asdf-defsystem-files)))
+  (make-tarball-under-build (asdf-defsystem-name) (pn) (asdf-defsystem-files)))
 
 (defun asdf-git-name ()
   (strcat "asdf-" *version*))
+
 (defun make-git-tarball ()
   (build-asdf)
-  (with-current-directory ((pn))
+  (with-asdf-dir ()
     (run `(tar zcf ("build/" ,(asdf-git-name) ".tar.gz") build/asdf.lisp ,@(run/lines '(git ls-files)))
          (asdf-git-name)) :show t)
   (values))
@@ -263,14 +458,17 @@
   (make-asdf-lisp)
   (values))
 
+
+;;; Publishing tarballs onto the public repository
+
 (defvar *clnet* "common-lisp.net")
 (defvar *clnet-asdf-public* "/project/asdf/public_html/")
 (defun public-path (x) (strcat *clnet-asdf-public* x))
 
 (defun publish-archive ()
   (let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name)))))
-    (run (format nil "cd ~S && rsync ~{~S ~}~S common-lisp.net:/project/asdf/public_html/archives/"
-                 /build-dir/ tarballs (asdf-lisp-name)) :show t))
+    (run `(rsync ,@tarballs ,(asdf-lisp-name) (,*clnet* ":" ,(public-path "archives/")))
+         :show t :directory (pn "build/")))
   (format t "~&To download the tarballs, point your browser at:~%
         http://common-lisp.net/project/asdf/archives/
 ~%")
@@ -294,122 +492,11 @@
   (publish-archive)
   (link-archive))
 
-(defparameter *versioned-files*
-  '(("version.lisp-expr" "\"" "\"")
-    ("asdf.asd" "  :version \"" "\" ;; to be automatically updated by make bump-version")
-    ("header.lisp" "This is ASDF " ": Another System Definition Facility.")
-    ("upgrade.lisp" "   (asdf-version \"" "\")")))
-
-(defparameter *old-version* nil)
-(defparameter *new-version* nil)
-
-(defun next-version (v)
-  (let ((pv (parse-version v 'error)))
-    (assert (first pv))
-    (assert (second pv))
-    (unless (third pv) (appendf pv (list 0)))
-    (unless (fourth pv) (appendf pv (list 0)))
-    (incf (car (last pv)))
-    (unparse-version pv)))
-
-(defun version-from-file ()
-  (safe-read-file-form *version-file*))
-
-(defun versions-from-args (&optional v1 v2)
-  (labels ((check (old new)
-             (parse-version old 'error)
-             (parse-version new 'error)
-             (values old new)))
-    (cond
-      ((and v1 v2) (check v1 v2))
-      (v1 (check (version-from-file) v1))
-      (t (let ((old (version-from-file)))
-           (check old (next-version old)))))))
-
-(deftype byte-vector () '(array (unsigned-byte 8) (*)))
+(defun archive () "alias for make-and-publish-archive" (make-and-publish-archive))
+(defun install () "alias for make-and-publish-archive" (make-and-publish-archive))
 
-(defun maybe-replace-file (file transformer
-                           &key (reader 'read-file-string)
-                             (writer nil) (comparator 'equalp)
-                             (external-format *utf-8-external-format*))
-  (format t "Transforming file ~A... " (file-namestring file))
-  (let* ((old-contents (funcall reader file))
-         (new-contents (funcall transformer old-contents)))
-    (if (funcall comparator old-contents new-contents)
-        (format t "no changes needed!~%")
-        (let ((written-contents
-                (if writer
-                    (with-output (s ())
-                      (funcall writer s new-contents))
-                    new-contents)))
-          (check-type written-contents (or string (byte-vector)))
-          (clobber-file-with-vector file written-contents :external-format external-format)
-          (format t "done.~%")))))
-
-(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))
-         (regex (strcat "(" qprefix ")(" versionrx ")(" qsuffix ")"))
-         (replacement
-           (constantly (strcat prefix new-version suffix))))
-    (lambda (text)
-      (multiple-value-bind (new-text foundp)
-          (cl-ppcre:regex-replace regex text replacement)
-        (unless (or foundp dont-warn)
-          (warn "Missing version in ~A" (file-namestring file)))
-        (values new-text foundp)))))
-
-(defun transform-file (new-version file prefix suffix)
-  (maybe-replace-file (pn file) (version-transformer new-version file prefix suffix)))
-
-(defun transform-files (new-version)
-  (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f)))
-
-(defun test-transform-file (new-version file prefix suffix)
-  (let ((lines (read-file-lines (pn 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 t) l)
-        (when foundp
-          (format t "Found a match:~%  ==> ~A~%Replacing with~%  ==> ~A~%~%"
-                  l new-text)
-          (return t))))))
-
-(defun test-transform (new-version)
-  (apply 'test-transform-file new-version (first *versioned-files*)))
-
-(defun bump-version (&optional v1 v2)
-  (multiple-value-bind (old-version new-version)
-      (versions-from-args v1 v2)
-    (a "Bumping ASDF version from " old-version " to " new-version)
-    (transform-files new-version)
-    (a "Rebuilding ASDF with bumped version")
-    (build-asdf)))
-
-(defparameter *version-tag-glob* "[0-9][.][0-9]*")
-
-(defun version-from-tag (&optional commit)
-  (first (run/lines `("git" "describe" "--tags" "--match" ,*version-tag-glob*) :show t)))
-
-(defun version-from-file (&optional commit)
-  (if commit
-      (run `("git" "show" (,commit":version.lisp-expr")) :output :form)
-      (read-file-form *version-file*)))
-
-(defun debian-version-from-file (&optional commit)
-  (let ((line
-          (if commit
-              (run `("git" "show" (,commit":debian/changelog")) :output :line)
-              (read-file-line "debian/changelog"))))
-    (cl-ppcre:register-groups-bind (ver) ("^cl-asdf [(]([0-9.:-]+)[)] " line)
-      ver)))
-
-(defun clean ()
-  (with-current-directory ((pn))
-    (run '(git clean -xfd)))
-  (values))
 
+;;; Making a debian package
 (defun debian-package (&optional (release "release"))
   (let* ((debian-version (debian-version-from-file release))
          (version (version-from-file release)))
@@ -432,19 +519,309 @@
            --git-ignore-branch)
          :directory (pn) :show t)))
 
+(defun release ()
+  "Release the code (not implemented)"
+  #| RELEASE or PUSH checklist:
+make test-all
+make test-load-systems s=fare-all
+make bump v=3.0
+edit debian/changelog # RELEASE only...
+git commit
+git tag 3.0 # for example ...
+make debian-package
+git push
+git push origin 3.0 # for example...
+everything from here for RELEASE only
+make release-push archive website debian-package
+dput mentors ../*.changes
+send debian mentors request
+send announcement to asdf-announce, asdf-devel, etc.
+Move all fixed bugs from Fix Committed -> Fix Released on launchpad
+  |#
+  (die 42 "release is not implemented yet"))
+
+
+;;; Line counting
+(defun wc ()
+  (with-asdf-dir ()
+    (run `(pipe (wc ,@(driver-files)) (sort -n)))
+    (terpri)
+    (run `(pipe (wc header.lisp ,@(asdf-defsystem-files)) (sort -n)))
+    (terpri)
+    (run `(pipe (wc header.lisp ,@(driver-files) ,@(asdf-defsystem-files)) (tail -n 1)))))
+
+
+;;; Testing
+
+(defun ensure-keyword (x)
+  (etypecase x
+    ((or null keyword) x)
+    ((or string symbol) (intern (string-upcase x) :keyword))))
+
+(defun ensure-list-of-keywords (x)
+  (mapcar 'ensure-keyword
+          (remove nil
+                  (etypecase x
+                    (string (uiop:split-string (string-upcase x) :separator " "))
+                    (list x)))))
+
+(defparameter *default-test-lisps*
+  '(:ccl :clisp :sbcl :ecl :ecl_bytecodes :cmucl :abcl :scl :allegro
+    :lispworks :allegromodern :gcl :xcl :mkcl)
+  ;; NOT SUPPORTED BY OUR AUTOMATED TESTS:
+  ;; :cormancl :genera :lispworks-personal-edition :mcl
+  ;; Also, grep for #+/#- features in the test/ directory
+  ;; to see plenty of disabled tests on some platforms
+  "Default Lisp implementations for tests")
+
+(defparameter *test-lisps* *default-test-lisps*
+  "The list of lisp implementations to use for tests")
+
+(defparameter *upgrade-test-lisps* *default-test-lisps*
+  "The list of lisp implementations to use for upgrade tests")
+
+(defparameter *test-systems*
+  (ensure-list-of-keywords (getenvp "ASDF_TEST_SYSTEMS")))
+
+(defparameter *test-scripts* ()) ;; TODO: use :all instead of NIL (?)
+
+(defparameter *environment-variable-table* nil)
+
+(defparameter *environment-variable-specs*
+  '((*test-lisps* ensure-list-of-keywords *default-test-lisps*
+     "ASDF_TEST_LISPS" "l")
+    (*upgrade-test-lisps* ensure-list-of-keywords *default-test-lisps*
+     "ASDF_UPGRADE_TEST_LISPS" "u")
+    (*test-systems* ensure-list-of-keywords ()
+     "ASDF_TEST_SYSTEMS" "s")
+    (*test-scripts* ensure-list-of-keywords ()
+     "ASDF_TESTS" "t")))
+
+(defun initialize-environment ()
+  (let ((h (make-hash-table :test 'equal)))
+    (setf *environment-variable-table* h)
+    (loop :for (variable transformer defaults envvar short) :in *environment-variable-specs*
+          :for x = (list variable transformer)
+          :do (setf (symbol-value variable)
+                    (if-let (x (getenvp envvar)) (funcall transformer x) defaults))
+              (setf (gethash envvar h) x)
+              (setf (gethash short h) x))))
+
+(defparameter *extra-environment-definitions* ())
+
+(defun test-lisp/k () (first *test-lisps*))
+(defun test-lisp/s () (string-downcase (first *test-lisps*)))
+
+(defun test-definition (def)
+  (block ()
+    (cl-ppcre:register-groups-bind (var val) ("^([^=]+)=(.*)$" def)
+      (if-let (x (gethash var *environment-variable-table*))
+        (destructuring-bind (var transformer default) x
+          (declare (ignore default))
+          (setf (symbol-value var) (funcall transformer val))
+          (return))))
+    (push def *extra-environment-definitions*)))
+
+(defun test-environment (env)
+  (loop :for def :in env :do (test-definition def)))
+
+(defun run-tests (args)
+  (with-asdf-dir ()
+    (run `(./test/run-tests.sh ,@args) :output :interactive)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun decl-or-docstring-p (form)
+    (or (stringp form)
+        (and (consp form) (eq 'declare (car form)))))
+
+  (defun decl-and-body (decl-and-body)
+    (let ((p (position-if-not 'decl-or-docstring-p decl-and-body)))
+      (values (subseq decl-and-body 0 p)
+              (nthcdr p decl-and-body)))))
+
+(defmacro deftestcmd (name args &rest decl-and-body)
+  (let ((env (gensym "ENV")))
+    (multiple-value-bind (decl body) (decl-and-body decl-and-body)
+      `(defun ,name (,@args &rest ,env)
+         ,@decl
+         (test-environment ,env)
+         ,@body))))
+
+(deftestcmd %load () ;; load would be a clash, so use %load instead
+  "make load will start a Lisp and load ASDF from individual source files.
+This is great to quickly locate compilation errors and interactively debug ASDF."
+  ;; Try this instead?
+  '(with-asdf-dir ()
+    (run `(rlwrap ,@(lisp-invocation-arglist :implementation (test-lisp/k) :eval (format nil "(or'#.(load(string'|test/script-support.lisp|))#.(asdf-test:interactive-test'(~{~A~^ ~})))" (system-source-files :asdf/defsystem :monolithic t))))
+     :output :interactive))
+  (run-tests `(-t ,(test-lisp/s) ,@(system-source-files :asdf/defsystem :monolithic t))))
+
+(deftestcmd test-basic ()
+  "basic smoke test"
+  (doc)
+  (test-load-systems))
+
+(deftestcmd test-lisp ()
+  "run test scripts with the preferred lisp implementation"
+  (with-asdf-dir ("test/")
+    (run `("./run-tests.sh" ,(test-lisp/s) ,@*test-scripts*))))
+(deftestcmd %t () "alias for test-lisp" (test-lisp))
+
+(deftestcmd test-upgrade ()
+  "run upgrade tests with the preferred lisp implementation"
+  (run-tests `("-u" ,(test-lisp/s))))
+(deftestcmd u () "alias for test-upgrade" (test-upgrade))
+
+(deftestcmd test-clean-load ()
+  "test that the preferred lisp implementation can load asdf cleanly without any output message"
+  (run-tests `("-c" ,(test-lisp/s))))
+
+(deftestcmd test-load-systems ()
+  "test that the preferred lisp implementation can load your favorite systems without error"
+  (run-tests `(-l ,(test-lisp/s) ,@*test-systems*)))
+
+(deftestcmd %test ()
+  "run all normal tests (excluding upgrade tests) with the preferred lisp implementation"
+  (test-lisp)
+  (test-clean-load)
+  (test-basic))
+
+(defun call-with-all-lisps (thunk &optional (lisps *test-lisps*))
+  (dolist (lisp lisps)
+    (let ((*test-lisps* (list lisp)))
+      (funcall thunk))))
+
+(defmacro with-all-lisps ((&rest maybe-lisps) &body body)
+  `(call-with-all-lisps (lambda () ,@body) ,@maybe-lisps))
+
+(deftestcmd test-all-clean-load ()
+  "test that all lisp implementations can load asdf cleanly without any output message"
+  (with-all-lisps () (test-clean-load)))
+
+(deftestcmd test-all-lisp ()
+  "test that all lisp implementations pass all asdf test scripts"
+  (with-all-lisps () (test-lisp)))
+
+(deftestcmd test-all-no-upgrade ()
+  "test that all lisp implementations pass all normal asdf; also test-basic"
+  (test-basic)
+  (test-all-clean-load)
+  (test-all-lisp))
+
+(deftestcmd test-all-upgrade ()
+  "test that all lisp implementations pass all asdf upgrade tests"
+  (with-all-lisps (*upgrade-test-lisps*) (test-upgrade)))
+
+(deftestcmd test-all-lisps ()
+  "test that all lisp implementations pass all asdf tests"
+  (test-all-no-upgrade)
+  (test-all-upgrade))
+(deftestcmd test-all () "alias for test-all-lisps" (test-all-lisps))
+
+(deftestcmd test-all-lisp-no-stop ()
+  "test that all lisp implementations pass all asdf test scripts, but don't stop on error"
+  (with-all-lisps ()
+    (ignore-errors (test-lisp))))
+
+(deftestcmd test-all-upgrade-no-stop ()
+  "test that all lisp implementations pass all asdf upgrade tests, but don't stop on error"
+  (with-all-lisps (*upgrade-test-lisps*)
+    (ignore-errors (test-upgrade))))
+
+(deftestcmd test-all-no-upgrade-no-stop ()
+  "test that all lisp implementations pass all normal asdf tests (no upgrade), but don't stop on error."
+  (test-basic)
+  (test-all-clean-load)
+  (test-all-lisp-no-stop)
+  (check-all-test-results))
+
+(deftestcmd test-all-no-stop ()
+  "test that all lisp implementations pass all asdf tests (including upgrade), but don't stop on error."
+  (test-basic)
+  (test-all-clean-load)
+  (test-all-lisp-no-stop)
+  (test-all-upgrade-no-stop)
+  (check-all-results))
+
+(deftestcmd test-all-test-results ()
+  "were there errors in test scripts?"
+  (with-asdf-dir ()
+    (let ((a (run/lines
+              `(grep "-L" "[5-9][0-9] passing and 0 failing"
+                     ,(mapcar (lambda (l) (format nil "build/results/~(~A~)-test.text" l))
+                              *test-lisps*)))))
+      (or (null a)
+          (progn
+            (format! *error-output* "Unexpected test failures on these implementations:~%~{~A~%~}" a)
+            nil)))))
+
+(deftestcmd check-all-test-results ()
+  "check that there were no errors in test scripts"
+  (or (test-all-test-results) (die 1 "")))
+
+(deftestcmd test-all-upgrade-results ()
+  "were there upgrade tests failures?"
+  (with-asdf-dir ()
+    (let ((a (run/lines
+              `(grep "-L" "Upgrade test succeeded for "
+                     ,(mapcar (lambda (l) (format nil "build/results/~(~A~)-upgrade.text" l))
+                              *upgrade-test-lisps*)))))
+      (or (null a)
+          (progn
+            (format! *error-output* "Unexpected upgrade failures on these implementations:~%~{~A~%~}" a)
+            nil)))))
+
+(deftestcmd check-all-upgrade-results ()
+  "check that there were no errors in upgrade tests"
+  (or (test-all-upgrade-results) (die 1 "")))
+
+(deftestcmd check-all-results ()
+  "check that there were no errors in either test scripts or upgrade tests"
+  (or (and (test-all-test-results) (test-all-upgrade-results)) (die 1 "")))
+
+
+;;; Extract old asdf versions
+(defun extract-all-tagged-asdf ()
+  (with-asdf-dir () (run `(./test/run-tests.sh "-H"))))
+(defun extract () "alias for extract-all-tagged-asdf" (extract-all-tagged-asdf))
+
+
+;;;; Generic code to interface a Lisp script to the shell command-line.
+
+;;; Read-Eval function (the RE of REPL; the Print and Loop parts are not here)
 (defun re (arg)
   (eval (read-from-string arg)))
 
-;;;; Main entry point
+(defun find-command (x)
+  "Find the function for an asdf-builder command by name"
+  (block nil
+    (flet ((try (x)
+             (multiple-value-bind (sym foundp)
+                 (find-symbol* (string-upcase x) :asdf-builder nil)
+               (when (and sym (eq foundp :internal) (fboundp sym))
+                 (return (fdefinition sym))))))
+      (try x)
+      (try (strcat "%" x))))) ;; so that you may use load, t, etc., as targets
+
+;;; Main entry point.
+;;; NB: For access control, you could check that only exported symbols are used as entry points.
 (defun main (args)
   (block nil
     (unless args
       (format t "No command provided~%")
       (return))
-    (if-let (sym (find-symbol* (string-upcase (first args)) :asdf-builder nil))
-      (let ((results (multiple-value-list (apply sym (rest args)))))
+    (if-let ((fun (find-command (first args))))
+      (let ((results
+              (progn
+                (initialize-environment)
+                (multiple-value-list (apply fun (rest args))))))
         (when results
-          (format t "~&Results:~%~{  ~S~%~}" results)))
-      (format t "Command ~A not found~%" (first args)))))
-
-(main *command-line-arguments*)
+          (format t "~&Results:~%~{  ~S~%~}" results))
+        (return t)))
+    (format t "Command ~A not found~%" (first args))
+    (return)))
+
+;;; Actually run the stuff!
+(setf *lisp-interaction* nil)
+(uiop:with-fatal-condition-handler ()
+  (main *command-line-arguments*))
-- 
GitLab