From 8bf304364d6925fa3e3e368fe801d7cadbe642ad Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <tunes@google.com> Date: Mon, 11 Aug 2014 12:28:00 -0400 Subject: [PATCH] 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). --- test/test-cache.script | 3 +- test/test-package.script | 12 ++-- test/test-retry-loading-component-1.script | 8 ++- test/test-run-program.script | 6 +- test/test-utilities.script | 5 ++ test/test-version.script | 2 +- tools/build.lisp | 15 ++-- tools/invoke-lisp.lisp | 7 +- tools/test-environment.lisp | 14 ++-- tools/test-scripts.lisp | 81 +++++++++++----------- 10 files changed, 84 insertions(+), 69 deletions(-) diff --git a/test/test-cache.script b/test/test-cache.script index 81e8ff727..4ac015f71 100644 --- a/test/test-cache.script +++ b/test/test-cache.script @@ -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 diff --git a/test/test-package.script b/test/test-package.script index b8c1b686b..136c87b2a 100644 --- a/test/test-package.script +++ b/test/test-package.script @@ -1,9 +1,9 @@ ;;; -*- 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")) diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script index 2097ce06e..35a8c13ba 100644 --- a/test/test-retry-loading-component-1.script +++ b/test/test-retry-loading-component-1.script @@ -1,16 +1,20 @@ ;;; -*- 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) diff --git a/test/test-run-program.script b/test/test-run-program.script index 39abbe493..227b1f536 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -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) - diff --git a/test/test-utilities.script b/test/test-utilities.script index ec02a68fd..d4a70dc30 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -1,5 +1,10 @@ ;;; -*- 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 diff --git a/test/test-version.script b/test/test-version.script index 092387caf..295e108a7 100644 --- a/test/test-version.script +++ b/test/test-version.script @@ -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)) diff --git a/tools/build.lisp b/tools/build.lisp index 0dc396825..ec54a1f0b 100644 --- a/tools/build.lisp +++ b/tools/build.lisp @@ -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)) diff --git a/tools/invoke-lisp.lisp b/tools/invoke-lisp.lisp index 203b0372e..ae07a104e 100644 --- a/tools/invoke-lisp.lisp +++ b/tools/invoke-lisp.lisp @@ -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))))))) diff --git a/tools/test-environment.lisp b/tools/test-environment.lisp index 458238830..36f7a4167 100644 --- a/tools/test-environment.lisp +++ b/tools/test-environment.lisp @@ -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)))) diff --git a/tools/test-scripts.lisp b/tools/test-scripts.lisp index 57cc931da..a20fe8269 100644 --- a/tools/test-scripts.lisp +++ b/tools/test-scripts.lisp @@ -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 -- GitLab