diff --git a/Makefile b/Makefile index 035478bb0763cd1b8424206ac3a6a3e6ac03416f..b303d62bf5889b31ad68a3e00bc4cba05293ebf6 100644 --- a/Makefile +++ b/Makefile @@ -3,18 +3,17 @@ # End-Users, all you need to do is: # make # -# If you want a list of all of the new targets, use -# make help -# # Vendors, you may want to test your implementation with: # make test l=sbcl -# BUT you first need have installed the development-time external dependencies of ASDF, -# which will be done automatically if you are using quicklisp, -# which you can do manually with your favorite tools (e.g. clbuild or git), or -# which you can do using `git submodule update` which is also available as: +# BUT you first need have installed the development-time external dependencies of ASDF; +# this will be done automatically if you are using quicklisp; +# you can do it manually with your favorite tools (e.g. clbuild or git); +# or you can do it using `git submodule update` which is also available as: # make ext +# To undo the `git submodule update` you can use: `make noext` # -# Other targets are for maintainer use only. +# Other targets are for maintainer use only. If you want a list of all of the targets, use +# make help # # Default action: bootstrap asdf.lisp diff --git a/tools/build.lisp b/tools/build.lisp index 3a9e781c562dc923b52a626cce22cc1a167afb3d..48f9780c3b581744137baa4d1810209a9b07079f 100644 --- a/tools/build.lisp +++ b/tools/build.lisp @@ -3,18 +3,18 @@ (defun build-asdf () "make sure asdf.lisp is built" (load-system :asdf) - (values)) + (success)) ;;; Documentation (defun doc () "build documentation in doc/ directory" (run '(make) :directory (pn "doc/")) - (values)) + (success)) (defun website () "publish documentation onto the public website" (run '(make website) :directory (pn "doc/")) - (values)) + (success)) ;;; Line counting @@ -29,11 +29,12 @@ (run `(pipe (wc header.lisp ,@defsystem-files) (sort -n))) (terpri) (run `(pipe (wc header.lisp ,@driver-files ,@defsystem-files) (tail -n 1)))))) - (values)) + (success)) ;;; debug the source registry that is being used to execute these tools. (defun list-source-registry () "Display the source-registry cache" (writeln (sort (alexandria:hash-table-alist asdf::*source-registry*) - 'string< :key 'car))) + 'string< :key 'car)) + (success)) diff --git a/tools/git.lisp b/tools/git.lisp index e177f4c8295eaffca3051f60b61ea2a4bc590581..3c55892a4c906b313f64726c173f6c749b1272a7 100644 --- a/tools/git.lisp +++ b/tools/git.lisp @@ -7,7 +7,9 @@ (defun run* (cmd &rest keys) (multiple-value-bind (out err code) (apply 'run cmd keys) - (values (eql 0 code) out err code))) + (if (eql 0 code) + (success) + (values nil out err code)))) (defun git (cmd &rest keys) (with-asdf-dir () diff --git a/tools/invoke-lisp.lisp b/tools/invoke-lisp.lisp index ae07a104e25d5f8dd67b8ba017f0858ae019089e..eccb1efd3b6410a723452c70e5e21fc4b5b539c4 100644 --- a/tools/invoke-lisp.lisp +++ b/tools/invoke-lisp.lisp @@ -222,4 +222,3 @@ a preformatted string, or a LIST that specifies a program." (typecase x (string x) (t (write-to-string x)))) forms))))))) - diff --git a/tools/main.lisp b/tools/main.lisp index 4415156b80d9a4418699bb7114082b5e39ae4668..23e79c7ca45d078b284cfd1cb7f76f2b7957f0af 100644 --- a/tools/main.lisp +++ b/tools/main.lisp @@ -1,23 +1,36 @@ ;;;; Generic code to interface a Lisp script to the shell command-line. (in-package :asdf-tools) +(defun success (&optional (success t)) + "Return magic values that signal success (default), or failure depending on SUCCESS" + (if success + (values t '#:success) + (values nil '#:failure))) + +(defun failure () + "Return magic values that signal failure" + (success nil)) + + (defun re (arg) "Read-Eval function (the RE of REPL) (the Print and Loop parts are not here)" (eval (read-from-string arg))) -(defun find-command (x &optional earlyp) - "Find the function for an asdf-tools command by name" +(defun find-command (name &optional earlyp) + "Given a string NAME, find the symbol for the function that implements the command, or else NIL. +Unless EARLYP is true, return NIL if the symbol is not fbound." (block nil (flet ((try (x) (multiple-value-bind (sym foundp) (find-symbol* (string-upcase x) :asdf-tools nil) (when (and sym (or earlyp (and foundp (fboundp sym)))) (return sym))))) - (try (strcat "%" (string x))) ;; so that you may use load, t, etc., as targets - (try x)))) + (try (strcat "%" (string name))) ;; so that you may use load, t, etc., as targets + (try name)))) (defun command-name (x &optional earlyp) + "Given a command designator as per FIND-COMMAND, return the unix-y name for it, as a string" (let ((c (find-command x earlyp))) (when c (let ((s (string-downcase c))) @@ -55,7 +68,7 @@ (defun show-commands () "print the (sorted list of) names of all the public commands of asdf-tools." (format t "~{~A~^ ~}~%" (public-command-strings)) - (values)) + (success)) (defun makefile-targets () "print declaration for the public commands of asdf-tools as as many Makefile targets @@ -64,7 +77,7 @@ based on a list of targets" (let ((c (public-command-strings))) (format t ".PHONY: ~{~A~^ ~}~%~%~{~A~^ ~}: force ./tools/asdf-tools env l='$l' L='$L' u='$u' U='$u' v='$v' s='$s' t='$t' $@~%" c c)) - (values)) + (success)) (defun help (&optional x) "help about a command, or list of commands" @@ -73,7 +86,7 @@ based on a list of targets" (loop :for x :in (public-command-strings) :do (format t "~(~27A~)~@[ ~A~]~%" x (short-function-description x))) - (values)) + (success)) (t (let ((x (find-command x))) (when x @@ -81,7 +94,7 @@ based on a list of targets" (command-name x) (or ()) ;; TODO: remember the arguments to deftestcmd, translate to v=, etc (documentation x 'function)) - (values)))))) + (success)))))) ;;; Main entry point. ;;; NB: For access control, you could check that only exported symbols are used as entry points. @@ -91,13 +104,15 @@ based on a list of targets" (format t "No command provided~%") (return)) (if-let ((fun (find-command (first args)))) - (let ((results - (multiple-value-list (apply fun (rest args))))) - (when results - (format t "~&~{~S~%~}" results)) - (return (or (null results) (first results))))) ;; Trick: (values) counts as T, not NIL. + (let ((results (multiple-value-list (apply fun (rest args))))) + ;; Don't print anything on success for regular commands, otherwise print all values returned. + (cond + ((equal results (multiple-value-list (success)))) + ((equal results (multiple-value-list (failure))) (format t "~&Command failed.~%")) + (t (format t "~&~{~S~%~}" results))) + (return (first results)))) (format t "Command ~A not found~%" (first args)) - (return))) + (return nil))) ;;; For a multi-call binary, use these cl-launch or buildapp arguments: --dispatch-entry asdf-tools/asdf-tools::main (defun main (argv) diff --git a/tools/release.lisp b/tools/release.lisp index d16ba67bb1fd51ffd34c9073cc22a9ad78a2ad38..3d954b2bba7f9153cca1c0080db4d7a59a3464b1 100644 --- a/tools/release.lisp +++ b/tools/release.lisp @@ -36,7 +36,7 @@ (let ((tarball (strcat name "." type))) (run `(git archive -o ,(pn "build" tarball) :prefix (,name /) ,*version* -- ,@files) :show t))) - (values)) + (success)) (defun make-tarball-from-git-plus (name base files &key asdf-lisp version-file) ;; make a tarball, then add build/asdf.lisp to it @@ -63,7 +63,7 @@ (let ((dir (pn "build" name ""))) (when (directory-exists-p dir) (delete-empty-directory dir))) (run `(gzip -f9 ,tarball) :show t))) - (values)) + (success)) (defun uiop-files () "list files in uiop" @@ -99,7 +99,8 @@ (defun make-asdf-lisp () (build-asdf) (concatenate-files (list (pn "build/asdf.lisp")) - (pn "build/" (asdf-lisp-name)))) + (pn "build/" (asdf-lisp-name))) + (success)) (defun make-archive () "build tarballs for release" @@ -107,7 +108,7 @@ (make-asdf-defsystem-tarball) (make-git-tarball) (make-asdf-lisp) - t) + (success)) ;;; Publishing tarballs onto the public repository @@ -125,7 +126,7 @@ (format t "~&To download the tarballs, point your browser at:~% http://common-lisp.net/project/asdf/archives/ ~%") - t) + (success)) (defun link-archive () "symlink new tarballs on the website" @@ -139,7 +140,7 @@ (asdf-lisp-name) (public-path "archives/asdf.lisp")) :show t :host *clnet*) - t) + (success)) (defun make-and-publish-archive () "make and publish tarballs" @@ -170,7 +171,8 @@ ;; --git-no-pristine-tar --git-force-create --git-ignore-branch) - :directory (pn) :show t))) + :directory (pn) :show t)) + (success)) (defun debian-architecture () (run/ss `(dpkg --print-architecture))) @@ -182,7 +184,7 @@ (run* `(dput mentors ,(pn "../" changes))))) (deftestcmd release (new-version lisps scripts systems) - "all steps to release the code (not implemented)" + "all steps to release the code (NOT YET IMPLEMENTED)" (break) ;; for each function, offer to do it or not (?) (with-asdf-dir () (let ((log (newlogfile "release" "all")) @@ -212,4 +214,5 @@ (when releasep (log! log t "Don't forget to send a debian mentors request!")) (log! log "Don't forget to send announcement to asdf-announce, asdf-devel, etc.") - (log! log "Don't forget to move all fixed bugs from Fix Committed -> Fix Released on launchpad"))))) + (log! log "Don't forget to move all fixed bugs from Fix Committed -> Fix Released on launchpad")))) + (success)) diff --git a/tools/test-all.lisp b/tools/test-all.lisp index 0140bf81ebec91a3ca7827578fa05ffbbf8ddc93..adbf2ddd3949e89a2c61e3c003789428c0545b67 100644 --- a/tools/test-all.lisp +++ b/tools/test-all.lisp @@ -2,41 +2,39 @@ (defun call-with-all-lisps (thunk &optional (lisps *test-lisps*)) (apply 'all-pass - (loop :for lisp :in lisps - :collect (let ((*test-lisps* (list lisp))) (funcall thunk))))) + (loop :for lisp :in (get-lisps lisps) + :collect (funcall thunk lisp)))) -(defmacro with-all-lisps ((&rest maybe-lisps) &body body) - `(call-with-all-lisps (lambda () ,@body) ,@maybe-lisps)) +(defmacro with-all-lisps ((&optional (lisp-var 'lisp) (lisps '*test-lisps*)) &body body) + `(call-with-all-lisps (lambda (,lisp-var) ,@body) ,lisps)) -(deftestcmd test-all-clean-load () +(deftestcmd test-all-clean-load (lisps) "test-clean-load on all lisps" - (with-all-lisps () (test-clean-load))) + (with-all-lisps (l lisps) (test-clean-load l))) -(deftestcmd test-all-scripts () +(deftestcmd test-all-scripts (lisps) "test-scripts on all lisps" - (with-all-lisps () (test-scripts))) + (with-all-lisps (l lisps) (test-scripts l))) (deftestcmd test-all-no-upgrade () "test-basic, and test-all-script" (all-pass (test-basic) (test-all-scripts))) -(deftestcmd test-all-upgrade () +(deftestcmd test-all-upgrade (upgrade-lisps) "test-upgrade on all lisps" - (with-all-lisps (*upgrade-test-lisps*) (test-upgrade))) + (with-all-lisps (l upgrade-lisps) (test-upgrade l))) (deftestcmd test-all () "all tests" (all-pass (test-all-no-upgrade) (test-all-upgrade))) -(deftestcmd test-all-scripts-no-stop () +(deftestcmd test-all-scripts-no-stop (lisps) "test-scripts on all lisps, no stop" - (with-all-lisps () - (ignore-errors (test-scripts)))) + (with-all-lisps (l lisps) (ignore-errors (test-scripts l)))) -(deftestcmd test-all-upgrade-no-stop () +(deftestcmd test-all-upgrade-no-stop (upgrade-lisps) "test-upgrade on all lisps, no stop" - (with-all-lisps (*upgrade-test-lisps*) - (ignore-errors (test-upgrade)))) + (with-all-lisps (l upgrade-lisps) (ignore-errors (test-upgrade l)))) (deftestcmd test-all-no-upgrade-no-stop () "all tests but upgrade on all lisps, no stop" @@ -62,7 +60,7 @@ `(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) + (if (null a) (success) (progn (format! *error-output* "Unexpected test failures on these implementations:~%~{~A~%~}" a) nil))))) @@ -74,7 +72,7 @@ `(grep "-L" "Upgrade test succeeded for " ,(mapcar (lambda (l) (format nil "build/results/~(~A~)-upgrade.text" l)) *upgrade-test-lisps*))))) - (or (null a) + (if (null a) (success) (progn (format t "Unexpected upgrade failures on these implementations:~%~{~A~%~}~%" a) nil))))) diff --git a/tools/test-basic.lisp b/tools/test-basic.lisp index 62722214860e1b5f940b76d29f7e261db1abbb9e..be7f69791b0855076a7a159533c82c1c35c8469d 100644 --- a/tools/test-basic.lisp +++ b/tools/test-basic.lisp @@ -49,13 +49,14 @@ Use your preferred lisp implementation and check that asdf is loaded without any :output :interactive :error-output :output :input nil)) (progn (log! log "GOOD: Loading ASDF on ~(~A~) produces no message" lisp) - (return t)) + (return (success))) (progn (log! log "BAD: Loading ASDF on ~(~A~) produces messages" lisp) (return nil)))))) (deftestcmd test-basic (lisp systems) "basic test: doc, clean-load, load-systems" - (doc) - (test-clean-load lisp) - (test-load-systems lisp systems)) + (all-pass + (doc) + (test-clean-load lisp) + (test-load-systems lisp systems))) diff --git a/tools/test-environment.lisp b/tools/test-environment.lisp index e0091bf0fef46d30a7fd37789fe9306f24754a56..734a689ccf6966d3ecacea428433d0babd764539 100644 --- a/tools/test-environment.lisp +++ b/tools/test-environment.lisp @@ -70,7 +70,7 @@ (loop :for variable-name :in (mapcar 'first *environment-variable-specs*) :do (format t "~T~S = ~S~%" variable-name (symbol-value variable-name)))) - (values)) + (success)) (defun test-definition (def) (block () @@ -88,7 +88,7 @@ (defun show-environment () (loop :for (v) :in *environment-variable-specs* :do (format t "~A = ~S~%" v (symbol-value v))) - (values)) + (success)) (defun env (&rest env) (loop :for (first . rest) :on env @@ -114,6 +114,8 @@ (setf lisp (get-lisp lisp))) (lisps ((lisps *test-lisps*)) (setf lisps (get-lisps lisps))) + (upgrade-lisps ((lisps *upgrade-test-lisps*)) + (setf upgrade-lisps (get-upgrade-lisps lisps))) (systems ((systems *test-systems*))) (test-scripts ((test-scripts *test-scripts*)) (setf test-scripts (get-test-scripts test-scripts))) @@ -136,7 +138,7 @@ ,@body))))) (defun all-pass (&rest tests) - (every 'identity tests)) + (success (every 'identity tests))) (defmacro defalias (name real) `(defun ,name (&rest args) @@ -162,6 +164,9 @@ (defun get-lisp (&optional (lisp *test-lisps*)) (if (and (keywordp lisp) (not (eq lisp :default))) lisp (first (get-lisps lisp)))) +(defun get-upgrade-lisps (&optional (x *upgrade-test-lisps*)) + (if (eq x :default) (get-lisps) x)) + (defun date-string (&optional (date (get-universal-time))) (multiple-value-bind (second minute hour date month year weekday daylight-savings-p timezone) (decode-universal-time date) @@ -186,7 +191,7 @@ ;; re-open every time because we're interleaved with inferior process writing to the log, ;; and on e.g. Windows there might be a locking conflict if we keep it open. (format s "~&~A~&" msg)))) - (values)) + (success)) ;; TODO: When composing a form to evaluate in the test lisp implementation, ;; our shell script went through great lengths to avoid a double-quote #\" in the command line, @@ -222,4 +227,4 @@ then copy/paste: (print-process-spec command nil) (print-process-spec (interactive-command) nil) (compose-copy-paste-string forms))) - (values okp out err code)))) + (if okp (success) (values nil out err code))))) diff --git a/tools/test-scripts.lisp b/tools/test-scripts.lisp index a20fe82696ed612cf45b550a28ca94335f71f93f..ac21c8d0e3e141a3cccc5eb9443113537a0a5d0c 100644 --- a/tools/test-scripts.lisp +++ b/tools/test-scripts.lisp @@ -63,20 +63,20 @@ Use the preferred lisp implementation" (progn (incf test-fail) (push i failed-list))) - :finally - (let ((okp (zerop test-fail))) - (log! log "~ + :finally) + (let ((okp (zerop test-fail))) + (log! log "~ -#--------------------------------------- Using ~A Ran ~D tests, ~D passed, ~D failed~ ~:[~%All tests apparently successful.~;:~:*~{~% ~A~}~] -#---------------------------------------~%" - lisp - n-tests test-pass test-fail (reverse failed-list)) - (unless okp - (log! log "To view full results and failures, try the following command: + lisp + n-tests test-pass test-fail (reverse failed-list)) + (unless okp + (log! log "To view full results and failures, try the following command: less -p ABORTED ~A" (enough-namestring log (pn)))) - (return okp))))) + (return (success okp))))) (deftestcmd %test (lisp test-scripts) "run all normal tests but upgrade tests diff --git a/tools/test-upgrade.lisp b/tools/test-upgrade.lisp index 1d1a26bda6719487d94e033532a6d895efff44eb..989b8d20465cd799c2f15bb33adbbe68c7617f1c 100644 --- a/tools/test-upgrade.lisp +++ b/tools/test-upgrade.lisp @@ -2,9 +2,6 @@ ;;; Upgrade tests -(defun get-upgrade-lisps (&optional (x *upgrade-test-lisps*)) - (if (eq x :default) (get-lisps) x)) - (defparameter *default-upgrade-test-tags* ;; We return a list of entries in reverse chronological order, ;; which should also be more or less the order of decreasing relevance. @@ -63,11 +60,13 @@ Use at a given tag, put it under build/asdf-${tag}.lisp" (ensure-directories-exist (pn "build/old/build/")) (run `(pipe (git archive ,tag) (tar "xfC" - ,(pn "build/old/")))) (run `(make) :directory (pn "build/old/")) - (rename-file-overwriting-target (pn "build/old/build/asdf.lisp") file)))))))) + (rename-file-overwriting-target (pn "build/old/build/asdf.lisp") file))))))) + (success)) (deftestcmd extract-all-tagged-asdf (upgrade-tags) "extract all asdf tags used for upgrade" - (map () 'extract-tagged-asdf upgrade-tags)) + (map () 'extract-tagged-asdf upgrade-tags) + (success)) (defalias extract extract-all-tagged-asdf) @@ -142,14 +141,17 @@ Use the preferred lisp implementation" (loop :for tag :in upgrade-tags :do (loop :for method :in upgrade-methods :when (valid-upgrade-test-p lisp tag method) :do - (extract-tagged-asdf tag) - (run-test-lisp - (format nil "Testing ASDF upgrade on ~(~A~) from ~A to ~A using method ~(~{~A~^:~}~)" - lisp tag *version* method) - `((load "test/script-support.lisp") - (asdf-test::test-upgrade ,@method ,tag)) - :lisp lisp :log log)) - :finally (log! log "Upgrade test succeeded for ~(~A~)" lisp)))) + (unless (and + (extract-tagged-asdf tag) + (run-test-lisp + (format nil "Testing ASDF upgrade on ~(~A~) from ~A to ~A using method ~(~{~A~^:~}~)" + lisp tag *version* method) + `((load "test/script-support.lisp") + (asdf-test::test-upgrade ,@method ,tag)) + :lisp lisp :log log)) + (return-from test-upgrade nil))) + :finally (log! log "Upgrade test succeeded for ~(~A~)" lisp)) + (return (success)))) (defalias u test-upgrade) diff --git a/tools/version.lisp b/tools/version.lisp index 71fac8440d08007062273e035051d66224027c21..6e798e067e48c17d065ff756e150a4d775af13b9 100644 --- a/tools/version.lisp +++ b/tools/version.lisp @@ -88,7 +88,8 @@ new-contents))) (check-type written-contents (or string (byte-vector))) (clobber-file-with-vector file written-contents :external-format external-format) - (format t "done.~%"))))) + (format t "done.~%")))) + (success)) (defun version-transformer (new-version file prefix suffix &optional dont-warn) (let* ((qprefix (cl-ppcre:quote-meta-chars prefix)) @@ -108,7 +109,8 @@ (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))) + (loop :for f :in *versioned-files* :do (apply 'transform-file new-version f)) + (success)) (defun test-transform-file (new-version file prefix suffix) (let ((lines (read-file-lines (pn file)))) @@ -118,7 +120,7 @@ (when foundp (format t "Found a match:~% ==> ~A~%Replacing with~% ==> ~A~%~%" l new-text) - (return t)))))) + (return (success))))))) (defun test-transform (new-version) (apply 'test-transform-file new-version (first *versioned-files*)))