Commit a0317bc1 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Remember failures and show them at the end.

parent 69c76bfe
...@@ -24,6 +24,7 @@ doc/asdf.vrs ...@@ -24,6 +24,7 @@ doc/asdf.vrs
doc/asdf.t2d/ doc/asdf.t2d/
doc/asdf.dvi doc/asdf.dvi
doc/version.texinfo doc/version.texinfo
doc/*.log
*.tmp *.tmp
LICENSE LICENSE
......
...@@ -16,16 +16,19 @@ version.texinfo: ../version.lisp-expr ...@@ -16,16 +16,19 @@ version.texinfo: ../version.lisp-expr
head -n 1 $^ | perl -ne 'm|\"(.*)\"|; print "\@set VERSION $$1\n"' > $@ head -n 1 $^ | perl -ne 'm|\"(.*)\"|; print "\@set VERSION $$1\n"' > $@
manual-html: asdf.texinfo version.texinfo manual-html: asdf.texinfo version.texinfo
makeinfo --html asdf.texinfo makeinfo --html asdf.texinfo \
2>&1 > manual-html.log || { echo "failed. See log in manual-html.log" ; exit 1 ;}
asdf.html: asdf.texinfo version.texinfo asdf.html: asdf.texinfo version.texinfo
makeinfo --html --no-split --no-headers -o asdf.html asdf.texinfo makeinfo --html --no-split --no-headers -o asdf.html asdf.texinfo \
2>&1 > asdf.html.log || { echo "failed. See log in asdf.html.log" ; exit 1 ;}
asdf.info: asdf.texinfo version.texinfo asdf.info: asdf.texinfo version.texinfo
makeinfo asdf.texinfo makeinfo asdf.texinfo
asdf.pdf: asdf.texinfo version.texinfo asdf.pdf: asdf.texinfo version.texinfo
texi2pdf asdf.texinfo texi2pdf asdf.texinfo \
2>&1 > asdf.pdf.log || { echo "failed. See log in asdf.pdf.log" ; exit 1 ;}
website: all website: all
rsync -lt --no-g ${webfiles} ${website} rsync -lt --no-g ${webfiles} ${website}
......
...@@ -8,16 +8,17 @@ ...@@ -8,16 +8,17 @@
(:feature :sbcl "sb-introspect")) (:feature :sbcl "sb-introspect"))
:components :components
((:file "package") ((:file "package")
(:file "main" :depends-on ("package")) (:file "failure" :depends-on ("package"))
(:file "main" :depends-on ("failure"))
(:file "pathnames" :depends-on ("package")) (:file "pathnames" :depends-on ("package"))
(:file "git" :depends-on ("package")) (:file "version" :depends-on ("failure"))
(:file "build" :depends-on ("pathnames"))
(:file "version" :depends-on ("pathnames"))
(:file "invoke-lisp" :depends-on ("package")) (:file "invoke-lisp" :depends-on ("package"))
(:file "test-environment" :depends-on ("pathnames" "invoke-lisp" "main")) (:file "test-environment" :depends-on ("pathnames" "invoke-lisp" "main"))
(:file "build" :depends-on ("test-environment"))
(:file "git" :depends-on ("test-environment"))
(:file "test-basic" :depends-on ("test-environment")) (:file "test-basic" :depends-on ("test-environment"))
(:file "test-scripts" :depends-on ("test-environment")) (:file "test-scripts" :depends-on ("test-environment"))
(:file "test-upgrade" :depends-on ("test-environment" "git")) (:file "test-upgrade" :depends-on ("test-environment" "git"))
(:file "test-all" :depends-on ("test-environment")) (:file "test-all" :depends-on ("test-environment"))
(:file "installation" :depends-on ("test-environment")) (:file "installation" :depends-on ("test-environment"))
(:file "release" :depends-on ("version" "test-environment")))) (:file "release" :depends-on ("version" "test-environment" "git"))))
(in-package :asdf-tools) (in-package :asdf-tools)
(defun build-asdf () (deftestcmd build-asdf ()
"make sure asdf.lisp is built" "make sure asdf.lisp is built"
(load-system :asdf) (load-system :asdf))
(success))
;;; Documentation ;;; Documentation
(defun doc () (deftestcmd doc ()
"build documentation in doc/ directory" "build documentation in doc/ directory"
(run '(make) :directory (pn "doc/")) (with-failure-context ("in doc/ directory")
(success)) (run* '(make) :directory (pn "doc/"))))
(defun website () (deftestcmd website ()
"publish documentation onto the public website" "publish documentation onto the public website"
(run '(make website) :directory (pn "doc/")) (with-failure-context ("in doc/ directory")
(success)) (run* '(make website) :directory (pn "doc/"))))
;;; Line counting ;;; Line counting
(defun wc () (deftestcmd wc ()
"count lines of lisp code in asdf and uiop" "count lines of lisp code in asdf and uiop"
(with-asdf-dir () (with-asdf-dir ()
(flet ((lisp-only (x) (remove "lisp" x :test-not 'equal :key 'pathname-type))) (flet ((lisp-only (x) (remove "lisp" x :test-not 'equal :key 'pathname-type)))
(let ((driver-files (mapcar #'(lambda (x) (subpathname "uiop/" x)) (lisp-only (uiop-files)))) (let ((driver-files (mapcar #'(lambda (x) (subpathname "uiop/" x)) (lisp-only (uiop-files))))
(defsystem-files (lisp-only (asdf-defsystem-files)))) (defsystem-files (lisp-only (asdf-defsystem-files))))
(run `(pipe (wc ,@driver-files) (sort -n))) (run* `(pipe (wc ,@driver-files) (sort -n)))
(terpri) (terpri)
(run `(pipe (wc header.lisp ,@defsystem-files) (sort -n))) (run* `(pipe (wc header.lisp ,@defsystem-files) (sort -n)))
(terpri) (terpri)
(run `(pipe (wc header.lisp ,@driver-files ,@defsystem-files) (tail -n 1)))))) (run* `(pipe (wc header.lisp ,@driver-files ,@defsystem-files) (tail -n 1)))))))
(success))
;;; debug the source registry that is being used to execute these tools. ;;; debug the source registry that is being used to execute these tools.
(defun list-source-registry () (deftestcmd list-source-registry ()
"Display the source-registry cache" "Display the source-registry cache"
(writeln (sort (alexandria:hash-table-alist asdf::*source-registry*) (writeln (sort (alexandria:hash-table-alist asdf::*source-registry*)
'string< :key 'car)) 'string< :key 'car)))
(success))
;;;; Useful information when failing.
(in-package :asdf-tools)
(defvar *fail-fast* nil)
(defvar *fail-verbose* nil)
(defvar *execution-context* nil) ;; context for debugging information
(defvar *failures* nil)
(defvar *failurep* nil)
;;;(defvar *failure-handler* nil)
(define-condition execution-error (error)
())
(defmethod print-object ((failure execution-error) stream)
(if *print-escape*
(print-unreadable-object (failure stream :type t :identity nil)
(let ((*print-escape* nil))
(print-object failure stream)))
(princ "FAILED" stream)))
(define-condition execution-failure (execution-error)
((context :initform nil :initarg :context :reader failure-context)
(reason :initarg :reason :reader failure-reason)))
(defmethod print-object ((failure execution-failure) stream)
(if *print-escape* (call-next-method)
(format stream "~@[In ~{~A~^, ~}: ~]~:[FAILED~;~:*~A~]"
(reverse (remove nil (failure-context failure)))
(failure-reason failure))))
(define-condition execution-failures (execution-error)
((failures :initform nil :initarg :failures :reader failure-list)))
(defmethod print-object ((failures execution-failures) stream)
(if *print-escape* (call-next-method)
(format stream "Failure~@[~P~:*~{~&~A~&~}~]"
(reverse (failure-list failures)))))
(defun make-error (&optional reason &rest arguments)
(etypecase reason
(error reason)
(string (make-condition 'simple-error
:format-control reason :format-arguments arguments))
(null (make-failures))
(symbol (apply 'make-condition reason arguments))))
(defun fail! (&rest reason-arguments)
(error (apply 'make-error reason-arguments)))
(defun success (&rest values)
"Return magic values that signal success"
(cond
((successp values) (apply 'values values))
((failurep values) (apply 'values values))
(t (apply 'values t '#:success values))))
(defun failure (&optional failures)
"Return magic values that signal failure"
(values nil '#:failure failures))
(defun successp (value-list)
(and (length>=n-p value-list 2)
(equal (subseq value-list 0 2)
(multiple-value-list (success)))))
(defun success-values (value-list)
(subseq value-list 2))
(defun failurep (value-list)
(and (length>=n-p value-list 2)
(equal (subseq value-list 0 2)
(subseq (multiple-value-list (failure)) 0 2))))
(defun failure-failures (value-list)
(third value-list))
(defun success-if (test &rest failure-args)
"If TEST, return success, otherwise, return failure with FAILURE-ARGS"
(if test
(success)
(apply 'fail! (or failure-args '("failed")))))
(defun failure-if (test &rest failure-args)
"If not TEST, return success, otherwise, return failure with FAILURE-ARGS"
(apply 'success-if (not test) failure-args))
(defun make-failure (&optional reason &rest arguments)
(if (typep reason 'execution-error)
reason
(make-condition 'execution-failure
:context *execution-context*
:reason (apply 'make-error reason arguments))))
(defun make-failures (&optional list)
(make-condition 'execution-failures :failures list))
(defmacro with-failure-context ((&optional context) &body body)
`(call-with-failure-context (lambda () ,@body) ,context))
(defun register-failures (failure)
(let ((failure (make-failure failure)))
(etypecase failure
(execution-failures
(setf *failures* (append (failure-list failure) *failures*)))
(execution-failure
(push failure *failures*)))
failure))
(defun call-with-failure-context (thunk context)
(let ((toplevel (null *execution-context*))
(*execution-context* (cons context *execution-context*))
(fail-fast *fail-fast*)
(*fail-fast* t))
(labels ((compute ()
(block nil
(handler-bind ((error (lambda (c)
(register-failures c)
(if (and fail-fast (not toplevel))
(error (make-failures))
(return (failure))))))
(funcall thunk))))
(doit ()
(let ((results (multiple-value-list (compute))))
(if (and toplevel *failures*) (failure (reverse *failures*)) (apply 'success results)))))
(if toplevel
(let ((*failures* nil)) (doit))
(doit)))))
(defmacro without-stopping (() &body body)
`(call-without-stopping ,@(mapcar (lambda (form) `(lambda () ,form)) body)))
(defun call-without-stopping (&rest thunks)
(let ((failurep nil)
(*fail-fast* nil))
(dolist (thunk thunks)
(when (failurep (multiple-value-list (with-failure-context () (funcall thunk))))
(setf failurep t)))
(failure-if failurep (make-failures))))
...@@ -4,22 +4,15 @@ ...@@ -4,22 +4,15 @@
;; Note that the debian git at git://git.debian.org/git/pkg-common-lisp/cl-asdf.git is stale, ;; 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 ;; as we currently build directly from upstream at git://common-lisp.net/projects/asdf/asdf.git
(defun run* (cmd &rest keys)
(multiple-value-bind (out err code)
(apply 'run cmd keys)
(if (eql 0 code)
(success)
(values nil out err code))))
(defun git (cmd &rest keys) (defun git (cmd &rest keys)
(with-asdf-dir () (with-asdf-dir ()
(apply 'run* (cons "git" cmd) keys))) (apply 'run* `(git ,@cmd) keys)))
(defun clean () (deftestcmd clean ()
"clean the checkout with git clean -xfd" "clean the checkout with git clean -xfd"
(git '(clean -xfd))) (git '(clean -xfd)))
(defun %push () (deftestcmd %push ()
"push git branches master and release upstream" "push git branches master and release upstream"
(dolist (x '((status) (dolist (x '((status)
(push --tags cl.net release master) (push --tags cl.net release master)
...@@ -28,7 +21,7 @@ ...@@ -28,7 +21,7 @@
(status))) (status)))
(git x))) (git x)))
(defun merge-master-into-release () (deftestcmd merge-master-into-release ()
"merge git branch master into release" "merge git branch master into release"
(dolist (x '((checkout master) (dolist (x '((checkout master)
(merge release) (merge release)
...@@ -43,17 +36,18 @@ ...@@ -43,17 +36,18 @@
"RELEASE" "STABLE" ;; These were misguided attempts for what should have been branches "RELEASE" "STABLE" ;; These were misguided attempts for what should have been branches
"README" "emp")) ;; Mistakes "README" "emp")) ;; Mistakes
(defun fix-local-git-tags () (deftestcmd fix-local-git-tags ()
"delete wrongful tags from local git repository" "delete wrongful tags from local git repository"
(dolist (tag *wrongful-tags*) (without-stopping ()
(git `(tag -d ,tag) :on-error nil))) (dolist (tag *wrongful-tags*)
(git `(tag -d ,tag) :on-error nil))))
(defun fix-remote-git-tags (&optional (remote "origin")) (deftestcmd fix-remote-git-tags ((remote "origin"))
"delete wrongful tags from remote git repository" "delete wrongful tags from remote git repository"
(dolist (tag *wrongful-tags*) (without-stopping ()
(git `(push ,remote (:refs/tags/,tag)) :on-error nil))) (dolist (tag *wrongful-tags*)
(git `(push ,remote (:refs/tags/,tag)) :on-error nil))))
(defun git-all-committed-p () (deftestcmd git-all-committed-p ()
"is your checkout clean, with all files committed?" "is your checkout clean, with all files committed?"
(null (nth-value 1 (git '(status -s) :output :lines)))) (null (nth-value 1 (git '(status -s) :output :lines))))
...@@ -30,7 +30,7 @@ Note that if you're using it with LispWorks (known to only provide ASDF 2 ...@@ -30,7 +30,7 @@ Note that if you're using it with LispWorks (known to only provide ASDF 2
as of LispWorks 6.1 in 2015), you first have to create a command-line as of LispWorks 6.1 in 2015), you first have to create a command-line
executable for LispWorks this way: executable for LispWorks this way:
echo '(hcl:save-image "lispworks" :environment nil)' > si.lisp echo '(hcl:save-image "lispworks-console" :environment nil)' > si.lisp
lispworks-6-1-0-x86-linux -siteinit - -init - -build si.lisp lispworks-6-1-0-x86-linux -siteinit - -init - -build si.lisp
|# |#
......
;;;; Generic code to interface a Lisp script to the shell command-line. ;;;; Generic code to interface a Lisp script to the shell command-line.
(in-package :asdf-tools) (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) (defun re (arg)
"Read-Eval function (the RE of REPL) "Read-Eval function (the RE of REPL)
(the Print and Loop parts are not here)" (the Print and Loop parts are not here)"
...@@ -52,7 +41,7 @@ Unless EARLYP is true, return NIL if the symbol is not fbound." ...@@ -52,7 +41,7 @@ Unless EARLYP is true, return NIL if the symbol is not fbound."
git-all-committed-p git-all-committed-p
bump-version bump ;; version bump-version bump ;; version
test-load-systems test-clean-load test-basic %load install-asdf ;; test-basic test-load-systems test-clean-load test-basic %load install-asdf ;; test-basic
%test %t test-scripts ;; test-scripts test %t test-scripts ;; test-scripts
test-upgrade u extract-tagged-asdf extract-all-tagged-asdf extract ;; test-upgrade test-upgrade u extract-tagged-asdf extract-all-tagged-asdf extract ;; test-upgrade
test-all-clean-load test-all-scripts test-all-no-upgrade test-all-upgrade ;; test-all 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 test-all-scripts-no-stop test-all-upgrade-no-stop
...@@ -99,20 +88,18 @@ based on a list of targets" ...@@ -99,20 +88,18 @@ based on a list of targets"
;;; Main entry point. ;;; Main entry point.
;;; NB: For access control, you could check that only exported symbols are used as entry points. ;;; NB: For access control, you could check that only exported symbols are used as entry points.
(defun process-arguments (args) (defun process-arguments (args)
(block nil (if-let ((fun (and args (find-command (first args)))))
(unless args (let ((results (multiple-value-list (apply fun (rest args)))))
(format t "No command provided~%") ;; Don't print anything on success for regular commands, otherwise print all values returned.
(return)) (if (failurep results)
(if-let ((fun (find-command (first args)))) (format t "~&Failure:~{~& ~A~}~&" (failure-failures results))
(let ((results (multiple-value-list (apply fun (rest args))))) (format t "~{~&~S~&~}" (if (successp results) (success-values results) results)))
;; Don't print anything on success for regular commands, otherwise print all values returned. (apply 'values results))
(cond (progn
((equal results (multiple-value-list (success)))) (if args
((equal results (multiple-value-list (failure))) (format t "~&Command failed.~%")) (format t "Command ~A not found~%" (first args))
(t (format t "~&~{~S~%~}" results))) (format t "No command provided~%"))
(return (first results)))) nil)))
(format t "Command ~A not found~%" (first args))
(return nil)))
;;; For a multi-call binary, use these cl-launch or buildapp arguments: --dispatch-entry asdf-tools/asdf-tools::main ;;; For a multi-call binary, use these cl-launch or buildapp arguments: --dispatch-entry asdf-tools/asdf-tools::main
(defun main (argv) (defun main (argv)
......
...@@ -31,39 +31,37 @@ ...@@ -31,39 +31,37 @@
(defun tarname (name) (strcat name ".tar.gz")) (defun tarname (name) (strcat name ".tar.gz"))
(defun make-tarball-from-git (name base files &key (type "tar.gz")) (deftestcmd make-tarball-from-git (name base files (type "tar.gz"))
(with-asdf-dir (base) (with-asdf-dir (base)
(let ((tarball (strcat name "." type))) (let ((tarball (strcat name "." type)))
(run `(git archive -o ,(pn "build" tarball) (git `(archive -o ,(pn "build" tarball)
:prefix (,name /) ,*version* -- ,@files) :show t))) :prefix (,name /) ,*version* -- ,@files) :show t))))
(success))
(defun make-tarball-from-git-plus (name base files &key asdf-lisp version-file) (deftestcmd make-tarball-from-git-plus (name base files asdf-lisp version-file)
;; make a tarball, then add build/asdf.lisp to it ;; make a tarball, then add build/asdf.lisp to it
(make-tarball-from-git name base files :type "tar") (make-tarball-from-git name base files "tar")
(let* ((tarball (strcat name ".tar"))) (let* ((tarball (strcat name ".tar")))
(with-asdf-dir ("build/") (with-asdf-dir ("build/")
(when asdf-lisp (when asdf-lisp
(build-asdf) (build-asdf)
(ensure-directories-exist (pn "build" name "build/")) (ensure-directories-exist (pn "build" name "build/"))
(run `(cp -a asdf.lisp (,name /build/))) (run* `(cp -a asdf.lisp (,name /build/)))
;; TODO: find which tar it is and tell --uid 0 --gid 0 to BSD tar ;; TODO: find which tar it is and tell --uid 0 --gid 0 to BSD tar
;; and --owner root --group root to GNU tar, ;; and --owner root --group root to GNU tar,
;; falling back to nothing. Sigh. ;; falling back to nothing. Sigh.
(run `(env "COPYFILE_DISABLE=1" (run* `(env "COPYFILE_DISABLE=1"
tar "-rf" ,tarball (,name /build/asdf.lisp)) :show t) tar "-rf" ,tarball (,name /build/asdf.lisp)) :show t)
(run `(rm -f (,name /build/asdf.lisp))) (run* `(rm -f (,name /build/asdf.lisp)))
(delete-empty-directory (pn "build" name "build/"))) (delete-empty-directory (pn "build" name "build/")))
(when version-file (when version-file
(ensure-directories-exist (pn "build" name "")) (ensure-directories-exist (pn "build" name ""))
(run `(cp -a ../version.lisp-expr (,name /))) (run* `(cp -a ../version.lisp-expr (,name /)))
(run `(env "COPYFILE_DISABLE=1" (run* `(env "COPYFILE_DISABLE=1"
tar "-rf" ,tarball (,name /version.lisp-expr)) :show t) tar "-rf" ,tarball (,name /version.lisp-expr)) :show t)
(run `(rm -f (,name /version.lisp-expr)))) (run* `(rm -f (,name /version.lisp-expr))))
(let ((dir (pn "build" name ""))) (let ((dir (pn "build" name "")))
(when (directory-exists-p dir) (delete-empty-directory dir))) (when (directory-exists-p dir) (delete-empty-directory dir)))
(run `(gzip -f9 ,tarball) :show t))) (run* `(gzip -f9 ,tarball) :show t))))
(success))
(defun uiop-files () (defun uiop-files ()
"list files in uiop" "list files in uiop"
...@@ -74,7 +72,7 @@ ...@@ -74,7 +72,7 @@
(make-tarball-from-git-plus (make-tarball-from-git-plus
(driver-name) "uiop/" (driver-name) "uiop/"
(remove "version.lisp-expr" (uiop-files) :test 'equal) (remove "version.lisp-expr" (uiop-files) :test 'equal)
:version-file t)) nil t))
(defun asdf-defsystem-files () (defun asdf-defsystem-files ()
...@@ -96,19 +94,17 @@ ...@@ -96,19 +94,17 @@
(defun asdf-lisp-name () (defun asdf-lisp-name ()
(format nil "asdf-~A.lisp" *version*)) (format nil "asdf-~A.lisp" *version*))
(defun make-asdf-lisp () (deftestcmd make-asdf-lisp ()
(build-asdf) (build-asdf)
(concatenate-files (list (pn "build/asdf.lisp")) (concatenate-files (list (pn "build/asdf.lisp"))
(pn "build/" (asdf-lisp-name))) (pn "build/" (asdf-lisp-name))))
(success))
(defun make-archive () (deftestcmd make-archive ()
"build tarballs for release" "build tarballs for release"
(make-driver-tarball) (make-driver-tarball)
(make-asdf-defsystem-tarball) (make-asdf-defsystem-tarball)
(make-git-tarball) (make-git-tarball)
(make-asdf-lisp) (make-asdf-lisp))
(success))
;;; Publishing tarballs onto the public repository ;;; Publishing tarballs onto the public repository
...@@ -117,32 +113,30 @@ ...@@ -117,32 +113,30 @@
(defvar *clnet-asdf-public* "/project/asdf/public_html/") (defvar *clnet-asdf-public* "/project/asdf/public_html/")
(defun public-path (x) (strcat *clnet-asdf-public* x)) (defun public-path (x) (strcat *clnet-asdf-public* x))
(defun publish-archive () (deftestcmd publish-archive ()
"publish tarballs to the website" "publish tarballs to the website"
(let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name))))) (let ((tarballs (mapcar 'tarname (list (driver-name) (asdf-defsystem-name) (asdf-git-name)))))
(run `(rsync "--times" "--chmod=a+rX,ug+w" (run* `(rsync "--times" "--chmod=a+rX,ug+w"
,@tarballs ,(asdf-lisp-name) (,*clnet* ":" ,(public-path "archives/"))) ,@tarballs ,(asdf-lisp-name) (,*clnet* ":" ,(public-path "archives/")))
:show t :directory (pn "build/"))) :show t :directory (pn "build/")))
(format t "~&To download the tarballs, point your browser at:~% (format t "~&To download the tarballs, point your browser at:~%
http://common-lisp.net/project/asdf/archives/ http://common-lisp.net/project/asdf/archives/
~%") ~%"))
(success))
(defun link-archive () (deftestcmd link-archive ()
"symlink new tarballs on the website" "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" (run* (format nil "ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S ; ln -sf ~S ~S"
(tarname (driver-name)) (tarname (driver-name))
(public-path "archives/uiop.tar.gz") (public-path "archives/uiop.tar.gz")
(tarname (asdf-defsystem-name)) (tarname (asdf-defsystem-name))
(public-path "archives/asdf-defsystem.tar.gz") (public-path "archives/asdf-defsystem.tar.gz")
(tarname (asdf-git-name)) (tarname (asdf-git-name))
(public-path "archives/asdf.tar.gz") (public-path "archives/asdf.tar.gz")
(asdf-lisp-name) (asdf-lisp-name)
(public-path "archives/asdf.lisp")) (public-path "archives/asdf.lisp"))
:show t :host *clnet*) :show t :host *clnet*))
(success))
(deftestcmd make-and-publish-archive ()
(defun make-and-publish-archive ()
"make and publish tarballs" "make and publish tarballs"
(make-archive) (make-archive)
(publish-archive) (publish-archive)
...@@ -153,7 +147,7 @@ ...@@ -153,7 +147,7 @@