;; -*- Lisp -*- (declaim (optimize (debug 3) (safety 3))) (DBG "Testing echo ok 1 via run-program as a list") (assert-equal '("ok 1") (run-program '("echo" "ok" "1") :output :lines)) (DBG "Testing echo ok 1 via run-program as a string") (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 (setf *verbose-out* nil) (DBG "Testing true via run-shell-command") (assert-equal 0 (run-shell-command "true")) (DBG "Testing false via run-shell-command") (assert-equal 1 (run-shell-command "false")) (DBG "Testing bad shell command via run-shell-command") (unless (< 0 (run-shell-command "./bad-shell-command")) (error "Failed to capture exit status indicating shell command failure.")) #+os-unix (progn (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.")) ;; this test checks for a problem there was in allegro -- :output :interactive ;; would try to open T as a stream for INPUT. (assert-equal '(nil nil 0) (multiple-value-list (run-program "true" :force-shell t :output :interactive))) (assert-equal '(nil nil 0) (multiple-value-list (run-program "true" :force-shell nil :output :interactive))) (assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :force-shell t :output :interactive :ignore-error-status t))) (assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :force-shell nil :output :interactive :ignore-error-status t))) (assert-equal '("foo" "bar baz" 42) (multiple-value-list (run-program "cat ; echo bar baz >&2 ; exit 42" :input '("foo") :output :string :error-output '(:string :stripped t) :ignore-error-status t))) #-abcl (assert-equal '(("foo" "bar" "baz" "quux") nil 0) (multiple-value-list (run-program "echo foo ; echo bar >&2 ; echo baz ; echo quux >& 2" :output :lines :error-output :output)))) ;; On Windows, normalize away CRLF into jut the unixy LF. (defun remove-cr (x) (remove (code-char 13) x)) (DBG "Testing awkward legacy output capture via run-shell-command") (let ((ok1 (format nil "; $ echo ok 1~%ok 1~%"))) (assert-equal (remove-cr (with-output-to-string (s) (let ((*verbose-out* s)) (run-shell-command "echo ~A 1" "ok")))) ok1) #-ecl (assert-equal (remove-cr (with-output-to-string (s) (let ((*verbose-out* t) (*standard-output* s)) (let ((status (run-shell-command "echo ok ~D" 1))) (unless (zerop status) (error "Didn't get good exit status.")))))) ok1)) ;; 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~%") (remove-cr (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 '(nil nil 0) (multiple-value-list (run-program "echo ok" :output nil)))) (is (equal '(nil nil 0) (multiple-value-list (run-program '("echo" "ok") :output nil)))) t) (defun unix-only-test/run-program () (is (equal '(nil nil 0) (multiple-value-list (run-program "true")))) (signals subprocess-error (run-program "false")) (is (equal '(nil nil 1) (multiple-value-list (run-program "false" :ignore-error-status t)))) (let ((tf (native-namestring (test-source "test-file")))) ;; a basic smoke test (is (equal '("Single") (run-program `("grep" "Single" ,tf) :output :lines))) ;; Make sure space is handled correctly (is (equal '("double entry") (run-program `("grep" "double entry" ,tf) :output :lines))) ;; Make sure space is handled correctly (is (equal '("triple word entry") (run-program `("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 `("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 '("false") :output :lines)) ;; Test that we can suppress the error on run-program (is (null (run-program '("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)