Commit 111b9742 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Import the run-program tests from xcvb-driver.

parent bf7fb395
;;; -*- 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)
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