Commit 8bf30436 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix various asdf-tools issues.

Don't pipe into tee, as it squashes errors.
Fix error handling by test-scripts. Fix wc. Fix some test logging.
Make tests runnable from any directory, and run from the asdf directory (not the test directory).
parent 7367a78e
......@@ -2,8 +2,7 @@
;;; test to check that the cache doesn't upset error signaling from FIND-SYSTEM
(in-package asdf-test)
(in-package :asdf-test)
(defparameter *all-systems*
(list
......
;;; -*- Lisp -*-
;;; Testing that defclass module doesn't interfere with use of :module in defsystem.
(in-package :cl-user)
(asdf-test::with-test ()
(defun module () 1)
(load "test-package.asd")
(defclass module () ())
(load "test-package.asd"))
(defun module () 1)
(asdf::load-asd (asdf-test:test-source "test-package.asd"))
(defclass module () ())
(asdf::load-asd (asdf-test:test-source "test-package.asd"))
;;; -*- Lisp -*-
;; NB: this test does some evil side-effects in the test source directory itself. UGH!
;;; test asdf:try-recompiling restart
(defvar *caught-error* nil)
(delete-file-if-exists "try-reloading-dependency.asd")
(delete-file-if-exists (test-source "try-reloading-dependency.asd"))
(with-asdf-cache (:override t)
(handler-bind
((error #'(lambda (c)
(format t "~&Caught error ~s" c)
(assert (not *caught-error*) () "Déjà vu")
(setf *caught-error* t)
(concatenate-files '("try-reloading-dependency.hidden") "try-reloading-dependency.asd")
;; Evil side-effect: create a .asd file from .hidden file.
(concatenate-files (list (test-source "try-reloading-dependency.hidden"))
(test-source "try-reloading-dependency.asd"))
(DBG "trlc1 5")
(multiple-value-bind (name mode) (find-symbol* :retry :asdf)
(assert (eq mode :external) () "Mode of ~s was not external" name)
......
......@@ -37,9 +37,10 @@
#+os-unix
(progn
(chdir *test-directory*)
(DBG "Testing good shell command in current directory via run-shell-command")
(unless (equal 0 (run-shell-command "./good-shell-command"))
(error "Failed to capture exit status indicating shell command success."))
(assert-equal 0 (run-shell-command "./good-shell-command"))
;; this test checks for a problem there was in allegro -- :output :interactive
;; would try to open T as a stream for INPUT.
......@@ -263,4 +264,3 @@ Testing run-program
(test/run-program)
;;; -*- Lisp -*-
(chdir *asdf-directory*)
(assert (pathname-equal *asdf-directory* (getcwd)))
(chdir *test-directory*)
(assert (pathname-equal *test-directory* (getcwd)))
(assert
(every #'directory-pathname-p
(list
......
......@@ -37,7 +37,7 @@
(def-test-system :versioned-system-file-line
:defsystem-depends-on ((:version :test-asdf/2 "2.1"))
:pathname #.*test-directory*
:version (:read-file-line "version.lisp-expr" :at 1))
:version (:read-file-line #.(test-source "version.lisp-expr") :at 1))
(defun vtest (name v &optional (true t))
(or (eq true (version-satisfies (find-system name) v))
......
......@@ -19,9 +19,12 @@
(defun wc ()
"count lines of lisp code in asdf and uiop"
(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)))))
(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))))
(defsystem-files (lisp-only (asdf-defsystem-files))))
(run `(pipe (wc ,@driver-files) (sort -n)))
(terpri)
(run `(pipe (wc header.lisp ,@defsystem-files) (sort -n)))
(terpri)
(run `(pipe (wc header.lisp ,@driver-files ,@defsystem-files) (tail -n 1))))))
(values))
......@@ -216,7 +216,10 @@ a preformatted string, or a LIST that specifies a program."
(string (output-string forms s))
(list (format s "~{~A~%~}"
(with-standard-io-syntax
(let ((*package* (find-package :cl)))
(mapcar (lambda (x) (typecase x (string x) (t (write x :stream s :case :downcase))))
(let ((*package* (find-package :cl))
(*print-case* :downcase))
(mapcar (lambda (x)
(typecase x (string x)
(t (write-to-string x))))
forms)))))))
......@@ -187,7 +187,7 @@
(defun run-test-lisp (activity forms &key (output t) log lisp debugger)
;; Activity is of the form "compiling ASDF", "running this test", etc.
(format t "~&Now ~A...~%" activity)
(format t "~&Now ~A...~@[ (log in ~A)~]~%" activity log)
(let* ((eval (compose-eval-string forms))
(command (lisp-invocation-arglist :implementation-type (get-lisp lisp)
:eval eval :debugger debugger))
......@@ -196,8 +196,8 @@
(output (if (eq output *stdout*) :interactive output)))
(log! log "~A" (print-process-spec command nil))
(multiple-value-bind (okp out err code)
(run* `(pipe ((>& 2 1) ,@(when interactive '(rlwrap)) ,@command)
,@(when log `((tee -a ,log))))
(run* `((>& 2 1) ,@(when interactive '(rlwrap)) ,@command
,@(when log `((>> ,log)))) ;; unhappily, | tee -a log eats error codes :-(
:input interactive :output output :error-output (or interactive :output) :on-error nil)
(unless interactive
(log! log (if okp
......@@ -208,7 +208,9 @@ You can retry ~A with:
or more interactively, start with:
~A~%(rlwrap is optional; don't use it when in emacs; skip if not installed.)
then copy/paste:
~A")
activity activity (print-process-spec command nil)
(interactive-command) (compose-copy-paste-string forms)))
~@< ~@;~A~@:>~&")
activity activity
(print-process-spec command nil)
(print-process-spec (interactive-command) nil)
(compose-copy-paste-string forms)))
(values okp out err code))))
......@@ -31,53 +31,52 @@
"run test scripts
Use the preferred lisp implementation"
(nest
(with-asdf-dir ("test/"))
(let* ((log (newlogfile "test" lisp)))
(log! log "Running the following ~D ASDF test scripts on ~(~A~):~%~{ ~A~%~}"
(length test-scripts) lisp test-scripts)
(and
(run-test-lisp
"compiling ASDF"
'((load "script-support.lisp") (asdf-test::compile-asdf-script))
:lisp lisp :log log)
(loop
:with n-tests = (length test-scripts)
:with test-pass = 0
:with test-fail = 0
:with failed-list = ()
:for i :in test-scripts
:for ni = (native-namestring i)
:for test-count :from 0
:do
;; TODO: do we want to delete the output file cache?
;; If so, we need to do it in the inferior lisp,
;; because only it knows for sure its output configuration.
;; Or we could do it in a more heavy handed way.
(if (run-test-lisp
(format nil "testing ~A on ~(~A~)" i lisp)
`((load "script-support.lisp")
(asdf-test::load-asdf)
(asdf-test::frob-packages)
(asdf-test::run-test-script ,ni))
:lisp lisp :log log)
(incf test-pass)
(progn
(incf test-fail)
(push i failed-list)))
:finally
(let ((okp (zerop test-fail)))
(format t "~
(length test-scripts) lisp test-scripts))
(and
(run-test-lisp
"compiling ASDF"
'((load "test/script-support.lisp") (asdf-test::compile-asdf-script))
:lisp lisp :log log))
(loop
:with n-tests = (length test-scripts)
:with test-pass = 0
:with test-fail = 0
:with failed-list = ()
:for i :in test-scripts
:for ni = (native-namestring (subpathname "test/" i))
:for test-count :from 0
:do
;; TODO: do we want to delete the output file cache?
;; If so, we need to do it in the inferior lisp,
;; because only it knows for sure its output configuration.
;; Or we could do it in a more heavy handed way.
(if (run-test-lisp
(format nil "testing ~A on ~(~A~)" i lisp)
`((load "test/script-support.lisp")
(asdf-test::load-asdf)
(asdf-test::frob-packages)
(asdf-test::run-test-script ,ni))
:lisp lisp :log log)
(incf test-pass)
(progn
(incf test-fail)
(push i failed-list)))
:finally
(let ((okp (zerop test-fail)))
(log! log "~
-#---------------------------------------
Using ~A
Ran ~D tests, ~D passed, ~D failed
~:[All tests apparently successful.~;:~:*~{~% ~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 okp)))))
(deftestcmd %test (lisp test-scripts)
"run all normal tests but upgrade tests
......
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