From: Stas Boukarev Date: Fri, 1 Nov 2013 12:34:27 +0000 (+0400) Subject: tests: better reports when /bin/ed is not present. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c0f9314af1b6f7aa67e6c5db523d6ddef735986c;p=sbcl.git tests: better reports when /bin/ed is not present. When /bin/ed is not present the test failed with a confusing "unhandled error". * Wrap the whole run-program-ed test into with-test, renaming it to run-program-/bin/ed. * Add before it a test named :is-/bin/ed-installed?. Making the report more self-describing: Failure: run-program.impure.lisp / IS-/BIN/ED-INSTALLED? Failure: run-program.impure.lisp / RUN-PROGRAM-/BIN/ED --- diff --git a/tests/run-program.impure.lisp b/tests/run-program.impure.lisp index 0088c56..32d7606 100644 --- a/tests/run-program.impure.lisp +++ b/tests/run-program.impure.lisp @@ -160,53 +160,47 @@ ;;; buffering of stdin and stdout depends on their TTYness, and ed isn't sufficiently ;;; agressive about flushing them. So, here's another test using :PTY. -#-win32 (progn ;; kludge: It would be nicer to disable individual test cases, - ;; but we are not using WITH-TEST yet here. - -(defparameter *tmpfile* "run-program-ed-test.tmp") - -(with-open-file (f *tmpfile* - :direction :output - :if-exists :supersede) - (write-line "bar" f)) - -(defparameter *ed* - (run-program "/bin/ed" (list *tmpfile*) :wait nil :pty t)) - -(defparameter *ed-pipe* (make-two-way-stream (process-pty *ed*) (process-pty *ed*))) -(defparameter *ed-in* (make-synonym-stream '*ed-pipe*)) -(defparameter *ed-out* (make-synonym-stream '*ed-pipe*)) - -(defun read-linish (stream) - (with-output-to-string (s) - (loop for c = (read-char stream) - while (and c (not (eq #\newline c))) - ;; Some eds like to send \r\n - do (unless (eq #\return c) - (write-char c s))))) - -(defun assert-ed (command response) - (when command - (write-line command *ed-in*) - (force-output *ed-in*)) - (when response - (let ((got (read-linish *ed-out*))) - (unless (equal response got) - (error "wanted '~A' from ed, got '~A'" response got)))) - *ed*) +#-win32 +(with-test (:name :is-/bin/ed-installed?) + (assert (probe-file "/bin/ed"))) -(unwind-protect - (with-test (:name :run-program-ed) - (assert-ed nil "4") - (assert-ed ".s/bar/baz/g" nil) - (assert-ed "w" "4") - (assert-ed "q" nil) - (process-wait *ed*) - (with-open-file (f *tmpfile*) - (assert (equal "baz" (read-line f))))) - (delete-file *tmpfile*)) +#-win32 +(progn + (defparameter *tmpfile* "run-program-ed-test.tmp") -) ;; #-win32 + (with-test (:name :run-program-/bin/ed) + (with-open-file (f *tmpfile* + :direction :output + :if-exists :supersede) + (write-line "bar" f)) + (unwind-protect + (let* ((ed (run-program "/bin/ed" (list *tmpfile*) :wait nil :pty t)) + (ed-in (process-pty ed)) + (ed-out (process-pty ed))) + (labels ((read-linish (stream) + (with-output-to-string (s) + (loop for c = (read-char stream) + while (and c (not (eq #\newline c))) + ;; Some eds like to send \r\n + do (unless (eq #\return c) + (write-char c s))))) + (assert-ed (command response) + (when command + (write-line command ed-in) + (force-output ed-in)) + (when response + (let ((got (read-linish ed-out))) + (unless (equal response got) + (error "wanted '~A' from ed, got '~A'" response got)))) + ed)) + (assert-ed nil "4") + (assert-ed ".s/bar/baz/g" nil) + (assert-ed "w" "4") + (assert-ed "q" nil) + (process-wait ed) + (with-open-file (f *tmpfile*) + (assert (equal "baz" (read-line f)))))) + (delete-file *tmpfile*)))) ;; #-win32 ;; Around 1.0.12 there was a regression when :INPUT or :OUTPUT was a ;; pathname designator. Since these use the same code, it should diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp index 68cc941..3d8c3d4 100644 --- a/tests/run-tests.lisp +++ b/tests/run-tests.lisp @@ -15,7 +15,7 @@ (defvar *all-failures* nil) (defvar *break-on-error* nil) (defvar *report-skipped-tests* nil) -(defvar *accept-files* nil) +(defvar *explicit-test-files* nil) (defun run-all () (dolist (arg (cdr *posix-argv*)) @@ -28,7 +28,7 @@ (setf *report-skipped-tests* t)) ((string= arg "--no-color")) (t - (push (truename (parse-namestring arg)) *accept-files*)))) + (push (truename (parse-namestring arg)) *explicit-test-files*)))) (pure-runner (pure-load-files) #'load-test) (pure-runner (pure-cload-files) #'cload-test) (impure-runner (impure-load-files) #'load-test) @@ -84,18 +84,18 @@ (format t "All tests succeeded~%"))))) (defun pure-runner (files test-fun) - (format t "// Running pure tests (~a)~%" test-fun) - (let ((*package* (find-package :cl-user)) - (*failures* nil)) - (setup-cl-user) - (dolist (file files) - (when (accept-test-file file) + (when files + (format t "// Running pure tests (~a)~%" test-fun) + (let ((*package* (find-package :cl-user)) + (*failures* nil)) + (setup-cl-user) + (dolist (file files) (format t "// Running ~a~%" file) (restart-case (handler-bind ((error (make-error-handler file))) (eval (funcall test-fun file))) - (skip-file ())))) - (append-failures))) + (skip-file ()))) + (append-failures)))) (defun run-in-child-sbcl (load-forms forms) ;; We used to fork() for POSIX platforms, and use this for Windows. @@ -153,11 +153,11 @@ (sb-ext:exit :code 104))))) (defun impure-runner (files test-fun) - (format t "// Running impure tests (~a)~%" test-fun) - (let ((*package* (find-package :cl-user))) - (setup-cl-user) - (dolist (file files) - (when (accept-test-file file) + (when files + (format t "// Running impure tests (~a)~%" test-fun) + (let ((*package* (find-package :cl-user))) + (setup-cl-user) + (dolist (file files) (force-output) (let ((exit-code (run-impure-in-child-sbcl file (funcall test-fun file)))) @@ -216,22 +216,24 @@ (test-util:report-test-status)) (sb-ext:exit :code (process-exit-code process)))) -(defun accept-test-file (file) - (if *accept-files* - (find (truename file) *accept-files* :test #'equalp) - t)) +(defun filter-test-files (wild-mask) + (if *explicit-test-files* + (loop for file in *explicit-test-files* + when (pathname-match-p file wild-mask) + collect file) + (directory wild-mask))) (defun pure-load-files () - (directory "*.pure.lisp")) + (filter-test-files "*.pure.lisp")) (defun pure-cload-files () - (directory "*.pure-cload.lisp")) + (filter-test-files "*.pure-cload.lisp")) (defun impure-load-files () - (directory "*.impure.lisp")) + (filter-test-files "*.impure.lisp")) (defun impure-cload-files () - (directory "*.impure-cload.lisp")) + (filter-test-files "*.impure-cload.lisp")) (defun sh-files () - (directory "*.test.sh")) + (filter-test-files "*.test.sh"))