diff --git a/test/test-run-program.script b/test/test-run-program.script index c8d03cb81cc7ce1f9859228fbbedf0296683cf84..250a3c6bd027dd4c9785da65c5fd49c7cabd4673 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -1,23 +1,219 @@ -;;; -*- Lisp -*- +#+xcvb -;;; TODO: write tests for run-program instead -- and/or -;;; import those from the original xcvb-driver-test +(declaim (optimize (debug 3) (safety 3))) + +(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines)) + +(unless (os-unix-p) + (leave-test "The rest of this test is only supposed to work on Unix")) ;;; test asdf run-shell-command function -(when (asdf::os-unix-p) - (setf asdf::*verbose-out* nil) - (assert-equal 1 (run-shell-command "false")) - (assert-equal 0 (run-shell-command "true")) - (unless (< 0 (asdf:run-shell-command "./bad-shell-command")) - (error "Failed to capture exit status indicating shell command failure.")) - (unless (equal 0 (run-shell-command "./good-shell-command")) - (error "Failed to capture exit status indicating shell command failure.")) - ;; NB1: run-shell-command is deprecated. Use run-program instead. - ;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command. - ;; If you want 2>&1 redirection, you know where to find it. - (assert-equal '("ok 1") (run-program "echo ok 1" :output :lines)) - (assert-equal "ok 1" (run-program '("echo" "ok 1") :output :line)) - (assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms)) - (assert-equal (format nil "ok 1~%") (run-program '("echo" "ok 1") :output :string)) +(setf *verbose-out* nil) +(assert-equal 1 (run-shell-command "false")) +(assert-equal 0 (run-shell-command "true")) +(unless (< 0 (run-shell-command "./bad-shell-command")) + (error "Failed to capture exit status indicating shell command failure.")) +(unless (equal 0 (run-shell-command "./good-shell-command")) + (error "Failed to capture exit status indicating shell command failure.")) +;; NB1: run-shell-command is deprecated. Use run-program instead. +;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command. +;; If you want 2>&1 redirection, you know where to find it. +(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines)) +(assert-equal "ok 1" (run-program '("echo" "ok 1") :output :line)) +(assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms)) +(assert-equal (format nil "ok 1~%") (run-program '("echo" "ok 1") :output :string)) + + +;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess) +;;#+lispworks (trace system:run-shell-command system:pid-exit-status) + +;; Poor man's test suite, lacking stefil. +(defmacro deftest (name formals &body body) + `(defun ,name ,formals ,@body)) +(defmacro is (x) + `(progn + (format! *error-output* "~&Checking whether ~S~%" ',x) + (assert ,x))) +(defmacro signals (condition sexp) + `(progn + (format! *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition) + (handler-case + ,sexp + (,condition () t) + (t (c) + (error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition)) + (:no-error () + (error "Expression ~S fails to raise condition ~S" ',sexp ',condition))))) + +#| +Testing run-program +|# + +;; We add a newline to the end of a string and return it. +;; We do it in this specific manner so that under unix, windows and macos, +;; format will choose the correct type of newline delimiters +(defun nl (str) + (format nil "~A~%" str)) + + +;; Convert the input format to a string stream, read it into a string, +;; and see if they match. +(defun slurp-stream-string/check (input-string &key (test #'string=)) + (let ((input-string (format nil input-string))) + (with-open-stream (s (make-string-input-stream input-string)) + (is (funcall test input-string (slurp-stream-string s)))))) + +;; Call with a bunch of strings to call the above function upon. +(defun slurp-stream-string/checks (&rest input-string-list) + (dolist (input-string input-string-list) + (funcall #'slurp-stream-string/check input-string))) + +;; Check to see if the input-string ins converted correctly to the +;; output-form +(defun slurp-stream-lines/check (input-string output-form &key (test #'equal)) + (let ((input-string (format nil input-string))) + (with-open-stream (s (make-string-input-stream input-string)) + (is (funcall test output-form (slurp-stream-lines s)))))) + +;; Check to see if the individual input/output lists passed into this +;; function are correct. +(defun slurp-stream-lines/checks (&rest control-forms) + (dolist (form control-forms) + (destructuring-bind (input-string output-form) form + (funcall #'slurp-stream-lines/check input-string output-form)))) + +(deftest test/slurp-stream-string () + ;; Check to make sure the string is exactly what it is when read + ;; back through a stream. This is a format specifier so we can + ;; portably test newline processing. + (slurp-stream-string/checks + "" + " " + "~%" + "~%~%" + "~%~%~%" + "one~%two~%three~%~%four" + "one two three four" + "one two~%three four") + + ;; Check some boundary cases on the types passed. + (signals error (slurp-stream-string nil)) + (signals error (slurp-stream-string 42)) + (signals error (slurp-stream-string "not valid")) + t) + +(deftest test/slurp-stream-lines () + (slurp-stream-lines/checks + ;; input-string first, then expected output-form after its parsing + '("" nil) + '(" " (" ")) + '("~%" ("")) + '("~%~%" ("" "")) + '("~%~%~%" ("" "" "")) + '("foo" ("foo")) + '("~%foo" ("" "foo")) + '("~%foo~%" ("" "foo")) ; consumes last newline! + '("one~%two~%~%three" ("one" "two" "" "three")) + '("one~%two~%~%three~%" ("one" "two" "" "three")) + '("one two three four" ("one two three four")) + '("one two~%three four~%" ("one two" "three four"))) + + ;; Check some boundary cases on the types passed. + ;; NOTE: NIL is ok since it means read from stdin! + (signals error (slurp-stream-lines 42)) + (signals error (slurp-stream-lines "not valid")) + t) + +(defun common-test/run-program () + ;; Can we echo a simple string? + (is (equal '("abcde") + (run-program '("echo" "abcde") :output :lines))) + (is (equal (nl "fghij") + (run-program '("echo" "fghij") :output :string))) + + ;; Are spaces handled properly? + (is (equal '("Hello World") + (run-program '("echo" "Hello World") :output :lines))) + (is (equal (nl "Hello World") + (run-program '("echo" "Hello World") :output :string))) + (is (equal (nl "Hello World") + (run-program "echo Hello World" :output :string))) + + ;; Test that run-program fails properly with an + ;; empty program string + #+(or clozure (and allegro os-unix) cmu (and lispworks os-unix) sbcl scl) + (signals error (run-program '("") :output :lines)) + + ;; An empty string itself is ok since it is passed to the shell. + (is (equal "" (run-program "" :output :string))) + + ;; Test that run-program fails properly with a + ;; nil program list + #+(or clozure (and allegro os-unix) cmu sbcl scl) + (signals error (run-program nil :output :lines)) + + ;; Test that run-program fails properly when the + ;; executable doesn't exist. + (signals error (run-program '("does-not-exist") :output :lines)) + (signals error (run-program "does-not-exist" :output :lines)) + + (is (equal 0 (run-program "echo ok" :output nil))) + (is (equal 0 (run-program '("echo" "ok") :output nil))) + t) + + +(defun unix-only-test/run-program () + + (is (equal 0 (run-program "true"))) + (signals subprocess-error (run-program "false")) + (is (equal 1 (run-program "false" :ignore-error-status t))) + + (let ((tf (native-namestring (test-source "test-file")))) + + ;; a basic smoke test + (is (equal '("Single") + (run-program `("/bin/grep" "Single" ,tf) :output :lines))) + + ;; Make sure space is handled correctly + (is (equal '("double entry") + (run-program `("/bin/grep" "double entry" ,tf) :output :lines))) + + ;; Make sure space is handled correctly + (is (equal '("triple word entry") + (run-program `("/bin/grep" "triple word entry" ,tf) :output :lines))) + + ;; Testing special characters + (loop :for char :across "+-_.,%@:/\\!&*(){}" + :for str = (string char) :do + (is (equal (list (format nil "escape ~A" str)) + (run-program + `("/bin/grep" ,(format nil "[~A]" str) ,tf) + :output :lines)))) + + ;; Test that run-program signals an error + ;; with an executable that doesn't return 0 + (signals subprocess-error (run-program '("/bin/false") :output :lines)) + + ;; Test that we can suppress the error on run-program + (is (null (run-program '("/bin/false") + :output :lines :ignore-error-status t)))) + t) + +(defun windows-only-test/run-program () + + ;; a basic smoke test + (is (equal (run-program '("cmd" "/c" "echo" "ok") :output :lines) + '(("ok")))) t) + +(deftest test/run-program () + #+os-unix (common-test/run-program) + #+os-unix (unix-only-test/run-program) + #+os-windows (windows-only-test/run-program) + (terpri) + t) + + +(test/run-program) +