Commit 2fd31ee0 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Update docstrings for better make help

parent 61c470b1
......@@ -7,15 +7,15 @@
(:feature :sbcl "sb-introspect"))
:components
((:file "package")
(:file "main" :depends-on ("package"))
(:file "pathnames" :depends-on ("package"))
(:file "git" :depends-on ("package"))
(:file "build" :depends-on ("pathnames"))
(:file "version" :depends-on ("pathnames"))
(:file "invoke-lisp" :depends-on ("package"))
(:file "test-environment" :depends-on ("pathnames" "invoke-lisp"))
(:file "test-environment" :depends-on ("pathnames" "invoke-lisp" "main"))
(:file "test-basic" :depends-on ("test-environment"))
(:file "test-scripts" :depends-on ("test-environment"))
(:file "test-upgrade" :depends-on ("test-environment" "git"))
(:file "test-all" :depends-on ("test-environment"))
(:file "release" :depends-on ("version" "test-environment"))
(:file "main" :depends-on ("package"))))
(:file "release" :depends-on ("version" "test-environment"))))
(in-package :asdf-tools)
(defun build-asdf ()
"Make sure asdf.lisp is built"
"make sure asdf.lisp is built"
(load-system :asdf)
(values))
;;; Documentation
(defun doc ()
"build documentation in doc/ directory"
(run '(make) :directory (pn "doc/")))
(defun website ()
"publish documentation onto the public website"
(run '(make website) :directory (pn "doc/")))
;;; Line counting
(defun wc ()
"count lines of lisp code in asdf and uiop"
(with-asdf-dir ()
(run `(pipe (wc ,@(driver-files)) (sort -n)))
(terpri)
......
......@@ -14,11 +14,11 @@
(apply 'run* (cons "git" cmd) keys)))
(defun clean ()
(git '(clean -xfd))
t)
"clean the checkout with git clean -xfd"
(git '(clean -xfd)))
(defun %push ()
"Push git branches master and release to cl.net and master"
"push git branches master and release upstream"
(dolist (x '((status)
(push --tags cl.net release master)
(push --tags github release master)
......@@ -27,7 +27,7 @@
(apply 'git x)))
(defun merge-master-into-release ()
"Merge master into release"
"merge git branch master into release"
(dolist (x '((checkout master)
(merge release)
(checkout release)
......@@ -42,20 +42,16 @@
"README" "emp")) ;; Mistakes
(defun fix-local-git-tags ()
"Delete wrongful tags from local repository"
"delete wrongful tags from local git 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"
"delete wrongful tags from remote git 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?"
"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))))
......@@ -3,22 +3,23 @@
(in-package :asdf-tools)
(defun re (arg)
"Read-Eval function (the RE of REPL; the Print and Loop parts are not here)"
"Read-Eval function (the RE of REPL)
(the Print and Loop parts are not here)"
(eval (read-from-string arg)))
(defun find-command (x)
(defun find-command (x &optional earlyp)
"Find the function for an asdf-tools command by name"
(block nil
(flet ((try (x)
(multiple-value-bind (sym foundp)
(find-symbol* (string-upcase x) :asdf-tools nil)
(when (and sym foundp (fboundp sym))
(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))))
(defun command-name (x)
(let ((c (find-command x)))
(defun command-name (x &optional earlyp)
(let ((c (find-command x earlyp)))
(when c
(let ((s (string-downcase c)))
(if (eql (first-char s) #\%) (subseq s 1) s)))))
......@@ -31,7 +32,7 @@
(len (length first-line)))
(if (>= len 50) (strcat (subseq first-line 0 49) "…") first-line))))
(defun find-commands ()
(defun public-commands ()
;;(loop :for x :being :the :external-symbols :of :asdf-tools
;; :when (and (eq x (find-command x)) (documentation x 'function)) :collect x)
'(build-asdf doc website wc ;; build
......@@ -41,30 +42,31 @@
test-load-systems test-clean-load test-basic %load install-asdf ;; test-basic
%test %t test-scripts ;; test-scripts
test-upgrade u extract-tagged-asdf extract-all-tagged-asdf extract ;; test-upgrade
test-all-clean-load test-all-lisp test-all-no-upgrade test-all-upgrade ;; test-all
test-all-scripts test-all test-all-scripts-no-stop test-all-upgrade-no-stop
test-all-clean-load test-all-scripts test-all-no-upgrade test-all-upgrade ;; test-all
test-all test-all-scripts-no-stop test-all-upgrade-no-stop
test-all-no-upgrade-no-stop test-all-no-stop
check-all-scripts-results check-all-upgrade-results check-all-results
driver-files asdf-defsystem-files ;; release
make-archive publish-archive link-archive archive install
debian-package debian-architecture publish-debian-package
make-archive publish-archive link-archive archive install ;; release
debian-package publish-debian-package
re help)) ;; main
(defun help (&optional x)
"List available commands, or the docstring of a given command"
"help about a command, or list of commands"
(cond
((null x)
(loop :for x :in (sort (find-commands) 'string< :key 'find-command)
(loop :for x :in (sort (public-commands) 'string< :key 'command-name)
:do (format t "~(~27A~)~@[ ~A~]~%"
(command-name x) (short-function-description x))))
(command-name x) (short-function-description x)))
t)
(t
(let ((x (find-command x)))
(when x
(format t "~A~@[ ~A~]~%~@[~A~]~&"
(command-name x)
(or ()) ;; TODO: remember the arguments to deftestcmd, translate to v=, etc
(documentation x 'function)))))))
(documentation x 'function))
t)))))
;;; Main entry point.
;;; NB: For access control, you could check that only exported symbols are used as entry points.
......
......@@ -65,6 +65,7 @@
(values)))
(defun driver-files ()
"list files in uiop"
(list* "README" "uiop.asd" "asdf-driver.asd" (system-source-files :uiop)))
(defun driver-name ()
(format nil "uiop-~A" *version*))
......@@ -72,6 +73,7 @@
(make-tarball-under-build (driver-name) (pn "uiop/") (driver-files)))
(defun asdf-defsystem-files ()
"list files in asdf/defsystem"
(list* "asdf.asd" "build/asdf.lisp" "version.lisp-expr" "header.lisp"
(system-source-files :asdf/defsystem)))
(defun asdf-defsystem-name ()
......@@ -99,6 +101,7 @@
(pn "build/" (asdf-lisp-name))))
(defun make-archive ()
"build tarballs for release"
(make-driver-tarball)
(make-asdf-defsystem-tarball)
(make-git-tarball)
......@@ -113,6 +116,7 @@
(defun public-path (x) (strcat *clnet-asdf-public* x))
(defun publish-archive ()
"publish tarballs to the website"
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name)))))
(run `(rsync ,@tarballs ,(asdf-lisp-name) (,*clnet* ":" ,(public-path "archives/")))
:show t :directory (pn "build/")))
......@@ -122,6 +126,7 @@
t)
(defun link-archive ()
"symlink new tarballs on the website"
(run (format nil "ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S"
(tarname (driver-name))
(public-path "archives/uiop.tar.gz")
......@@ -135,16 +140,18 @@
t)
(defun make-and-publish-archive ()
"make and publish tarballs"
(make-archive)
(publish-archive)
(link-archive))
(defun archive () "alias for make-and-publish-archive" (make-and-publish-archive))
(defun install () "alias for make-and-publish-archive" (make-and-publish-archive))
(defalias archive make-and-publish-archive)
(defalias install make-and-publish-archive)
;;; Making a debian package
(defun debian-package (&optional (release "release"))
"build a debian package"
(let* ((debian-version (debian-version-from-file release))
(version (version-from-file release)))
(unless (equal version (parse-debian-version debian-version))
......@@ -167,12 +174,13 @@
(run/ss `(dpkg --print-architecture)))
(defun publish-debian-package (&optional release)
"publish a debian package"
(let ((changes (strcat "cl-asdf_" (debian-version-from-file release)
"_" (debian-architecture) ".changes")))
(run* `(dput mentors ,(pn "../" changes)))))
(deftestcmd release (new-version lisps scripts systems)
"Release the code (not implemented)"
"all steps to release the code (not implemented)"
(break) ;; for each function, offer to do it or not (?)
(with-asdf-dir ()
(let ((log (newlogfile "release" "all"))
......@@ -184,9 +192,10 @@
new-version)))
(when (nth-value 1 (run '(parse-changelog debian/changelog) :output nil :error-output :lines))
(error "Malformed debian/changelog entry")))
scripts ;; TODO: needs to be passed as argument!
(and ;; need a better combinator, that tells us about progress, etc.
(git-all-committed-p)
(test-all-no-stop) ;; NEED ARGUMENTS!
(test-all-no-stop) ;; TODO: NEED ARGUMENTS!
(test-load-systems lisps systems)
(bump new-version)
(when releasep
......
......@@ -9,48 +9,47 @@
`(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"
"test-clean-load on all lisps"
(with-all-lisps () (test-clean-load)))
(deftestcmd test-all-lisp ()
"test that all lisp implementations pass all asdf test scripts"
(deftestcmd test-all-scripts ()
"test-scripts on all lisps"
(with-all-lisps () (test-scripts)))
(deftestcmd test-all-no-upgrade ()
"test that all lisp implementations pass all normal asdf; also test-basic"
(all-pass (test-basic) (test-all-lisp)))
"test-basic, and test-all-script"
(all-pass (test-basic) (test-all-scripts)))
(deftestcmd test-all-upgrade ()
"test that all lisp implementations pass all asdf upgrade tests"
"test-upgrade on all lisps"
(with-all-lisps (*upgrade-test-lisps*) (test-upgrade)))
(deftestcmd test-all-scripts ()
"test that all lisp implementations pass all asdf tests"
(deftestcmd test-all ()
"all tests"
(all-pass (test-all-no-upgrade) (test-all-upgrade)))
(defalias test-all test-all-scripts)
(deftestcmd test-all-scripts-no-stop ()
"test that all lisp implementations pass all asdf test scripts, but don't stop on error"
"test-scripts on all lisps, no stop"
(with-all-lisps ()
(ignore-errors (test-scripts))))
(deftestcmd test-all-upgrade-no-stop ()
"test that all lisp implementations pass all asdf upgrade tests, but don't stop on error"
"test-upgrade on all lisps, no stop"
(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."
"all tests but upgrade on all lisps, no stop"
(all-pass
(test-basic)
(doc) (test-load-systems)
(test-all-clean-load)
(test-all-scripts-no-stop)
(check-all-scripts-results)))
(deftestcmd test-all-no-stop () ;; TODO: pass arguments!
"test that all lisp implementations pass all asdf tests (including upgrade), but don't stop on error."
"all tests on all lisps, no stop"
(all-pass
(test-basic)
(doc) (test-load-systems)
(test-all-clean-load)
(test-all-scripts-no-stop)
(test-all-upgrade-no-stop)
......@@ -69,7 +68,7 @@
nil)))))
(deftestcmd check-all-upgrade-results ()
"were there upgrade tests failures?"
"were there upgrade test failures?"
(with-asdf-dir ()
(let ((a (run/lines
`(grep "-L" "Upgrade test succeeded for "
......@@ -81,6 +80,6 @@
nil)))))
(deftestcmd check-all-results ()
"check that there were no errors in either test scripts or upgrade tests"
"were there failures in any scripts or upgrade?"
(all-pass (check-all-scripts-results) (check-all-upgrade-results)))
(in-package :asdf-tools)
(deftestcmd %load (lisp) ;; 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."
"load asdf into an interactive Lisp for debugging
load from individual source files, to make it easier to quickly locate
compilation errors and to interactively debug ASDF."
(with-asdf-dir ()
(run-test-lisp
(format nil "loading ASDF into an interactive ~(~A~)" lisp)
......@@ -12,7 +13,8 @@ This is great to quickly locate compilation errors and interactively debug ASDF.
:lisp lisp :debugger t :output :interactive)))
(deftestcmd test-load-systems (lisp systems)
"test that the preferred lisp implementation can load your favorite systems without error"
"test loading of your favorite systems
Use your preferred Lisp implementation"
(with-asdf-dir ()
(let* ((log (newlogfile "systems" lisp)))
(log! log "Loading all these systems on ~(~A~):~{~% ~A~}~%~%" lisp systems)
......@@ -23,7 +25,8 @@ This is great to quickly locate compilation errors and interactively debug ASDF.
:lisp lisp :log log))))
(deftestcmd test-clean-load (lisp log)
"test that the preferred lisp implementation can load asdf cleanly without any output message"
"test that asdf load cleanly
Use your preferred lisp implementation and check that asdf is loaded without any output message"
(nest
(block ()
(case lisp ((:gcl :cmucl) (return t)))) ;; These are hopeless
......@@ -52,6 +55,7 @@ This is great to quickly locate compilation errors and interactively debug ASDF.
;;; BONUS: install asdf as module for your favorite Lisp implementation.
(deftestcmd install-asdf (lisp)
"install asdf as a module on specified Lisp"
(flet ((doit ()
(with-asdf-dir ()
(run-test-lisp
......@@ -73,7 +77,7 @@ If you care, go hack the implementation.~%" lisp))
(error "Unknown implementation ~(~A~)" lisp))))))
(deftestcmd test-basic (lisp systems)
"basic smoke test"
"basic test: doc, clean-load, load-systems"
(doc)
(test-clean-load lisp)
(test-load-systems lisp systems))
......@@ -126,7 +126,9 @@
(every 'identity tests))
(defmacro defalias (name real)
`(defun ,name (&rest args) ,(format nil "alias for ~S" real) (apply ',real args)))
`(defun ,name (&rest args)
,(format nil "alias for command ~A" (command-name real t))
(apply ',real args)))
(deftestcmd interactive-command (lisp)
(let* ((command (lisp-invocation-arglist :implementation-type lisp :debugger t)))
......@@ -159,7 +161,7 @@
(if-let (date (safe-file-write-date log))
(rename-file-overwriting-target
log (add-pathname-suffix log (strcat "-" (date-string date)))))
(with-output-file (s log)) ;; create the file
(with-output-file (s log) s) ;; create the file
;;(format t "Logging results to ~A" log)
log))
......
......@@ -26,7 +26,8 @@
|#
(deftestcmd test-scripts (lisp test-scripts)
"run test scripts with the preferred lisp implementation"
"run test scripts
Use the preferred lisp implementation"
(nest
(with-asdf-dir ("test/"))
(let* ((log (newlogfile "test" lisp))
......@@ -78,7 +79,8 @@ Ran ~D tests, ~D passed, ~D failed
(return okp)))))))
(deftestcmd %test (lisp test-scripts)
"run all normal tests (excluding upgrade tests) with the preferred lisp implementation"
"run all normal tests but upgrade tests
Use the preferred lisp implementation"
(all-pass (test-scripts lisp test-scripts) (doc) (test-clean-load lisp)))
(defalias %t %test)
......@@ -48,7 +48,8 @@
(if (eq x :default) *default-upgrade-test-tags* x))
(defun extract-tagged-asdf (tag)
"Extract an ASDF version at a given tag from git under build/asdf-${tag}.lisp"
"extract an asdf version from git
Use at a given tag, put it under build/asdf-${tag}.lisp"
(with-asdf-dir ()
(ensure-directories-exist (pn "build/"))
(unless (string-equal tag "REQUIRE")
......@@ -64,7 +65,9 @@
(rename-file-overwriting-target (pn "build/old/build/asdf.lisp") file))))))))
(deftestcmd extract-all-tagged-asdf (upgrade-tags)
"extract all asdf tags used for upgrade"
(map () 'extract-tagged-asdf upgrade-tags))
(defalias extract extract-all-tagged-asdf)
(defparameter *upgrade-test-methods* :default)
......@@ -123,7 +126,8 @@
((:allegro :lispworks :sbcl :scl) t))))
(deftestcmd test-upgrade (lisp upgrade-tags upgrade-methods)
"run upgrade tests with the preferred lisp implementation"
"run upgrade tests
Use the preferred lisp implementation"
(nest
(with-asdf-dir ())
(let ((log (newlogfile "upgrade" lisp)))
......
......@@ -117,7 +117,7 @@
(apply 'test-transform-file new-version (first *versioned-files*)))
(defun bump-version (&optional v1 v2)
"bump version of ASDF to specified version or next development version (do not commit)."
"bump asdf version, do not commit"
(with-asdf-dir ()
(multiple-value-bind (old-version new-version)
(versions-from-args v1 v2)
......@@ -128,7 +128,7 @@
new-version)))
(defun bump (&optional v1 v2)
"bump version of ASDF to specified version or next development version, then commit and tag."
"bump asdf version, then commit and tag"
(let ((v (bump-version v1 v2)))
(git `(commit -a -m ("Bump version to ",v)))
(git `(tag ,v))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment