2
(declaim (optimize (debug 3) (safety 3)))
4
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
7
(leave-test "The rest of this test is only supposed to work on Unix"))
9
;;; test asdf run-shell-command function
10
(setf *verbose-out* nil)
11
(assert-equal 1 (run-shell-command "false"))
12
(assert-equal 0 (run-shell-command "true"))
13
(unless (< 0 (run-shell-command "./bad-shell-command"))
14
(error "Failed to capture exit status indicating shell command failure."))
15
(unless (equal 0 (run-shell-command "./good-shell-command"))
16
(error "Failed to capture exit status indicating shell command failure."))
17
(let ((ok1 (format nil "; $ echo ok 1~%ok 1~%")))
19
(with-output-to-string (s)
20
(let ((*verbose-out* s))
21
(run-shell-command "echo ~A 1" "ok")))
25
(with-output-to-string (s)
26
(let ((*verbose-out* t)
27
(*standard-output* s))
28
(run-shell-command "echo ok ~D" 1)))
30
;; NB1: run-shell-command is deprecated. Use run-program instead.
31
;; NB2: we do NOT support stderr capture to *verbose-out* anymore in run-shell-command.
32
;; If you want 2>&1 redirection, you know where to find it.
33
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
34
(assert-equal "ok 1" (run-program '("echo" "ok 1") :output :line))
35
(assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms))
36
(assert-equal (format nil "ok 1~%") (run-program '("echo" "ok 1") :output :string))
37
;; this test checks for a problem there was in allegro -- :output :interactive
38
;; would try to open T as a stream for INPUT.
39
(assert-equal 0 (run-program "true" :force-shell t :output :interactive))
40
(assert-equal 0 (run-program "true" :force-shell nil :output :interactive))
41
(assert-equal 1 (run-program "false" :force-shell t :output :interactive :ignore-error-status t))
42
(assert-equal 1 (run-program "false" :force-shell nil :output :interactive :ignore-error-status t))
45
;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess)
46
;;#+lispworks (trace system:run-shell-command system:pid-exit-status)
48
;; Poor man's test suite, lacking stefil.
49
(defmacro deftest (name formals &body body)
50
`(defun ,name ,formals ,@body))
53
(format! *error-output* "~&Checking whether ~S~%" ',x)
55
(defmacro signals (condition sexp)
57
(format! *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition)
62
(error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition))
64
(error "Expression ~S fails to raise condition ~S" ',sexp ',condition)))))
70
;; We add a newline to the end of a string and return it.
71
;; We do it in this specific manner so that under unix, windows and macos,
72
;; format will choose the correct type of newline delimiters
74
(format nil "~A~%" str))
77
;; Convert the input format to a string stream, read it into a string,
78
;; and see if they match.
79
(defun slurp-stream-string/check (input-string &key (test #'string=))
80
(let ((input-string (format nil input-string)))
81
(with-open-stream (s (make-string-input-stream input-string))
82
(is (funcall test input-string (slurp-stream-string s))))))
84
;; Call with a bunch of strings to call the above function upon.
85
(defun slurp-stream-string/checks (&rest input-string-list)
86
(dolist (input-string input-string-list)
87
(funcall #'slurp-stream-string/check input-string)))
89
;; Check to see if the input-string ins converted correctly to the
91
(defun slurp-stream-lines/check (input-string output-form &key (test #'equal))
92
(let ((input-string (format nil input-string)))
93
(with-open-stream (s (make-string-input-stream input-string))
94
(is (funcall test output-form (slurp-stream-lines s))))))
96
;; Check to see if the individual input/output lists passed into this
97
;; function are correct.
98
(defun slurp-stream-lines/checks (&rest control-forms)
99
(dolist (form control-forms)
100
(destructuring-bind (input-string output-form) form
101
(funcall #'slurp-stream-lines/check input-string output-form))))
103
(deftest test/slurp-stream-string ()
104
;; Check to make sure the string is exactly what it is when read
105
;; back through a stream. This is a format specifier so we can
106
;; portably test newline processing.
107
(slurp-stream-string/checks
113
"one~%two~%three~%~%four"
115
"one two~%three four")
117
;; Check some boundary cases on the types passed.
118
(signals error (slurp-stream-string nil))
119
(signals error (slurp-stream-string 42))
120
(signals error (slurp-stream-string "not valid"))
123
(deftest test/slurp-stream-lines ()
124
(slurp-stream-lines/checks
125
;; input-string first, then expected output-form after its parsing
130
'("~%~%~%" ("" "" ""))
132
'("~%foo" ("" "foo"))
133
'("~%foo~%" ("" "foo")) ; consumes last newline!
134
'("one~%two~%~%three" ("one" "two" "" "three"))
135
'("one~%two~%~%three~%" ("one" "two" "" "three"))
136
'("one two three four" ("one two three four"))
137
'("one two~%three four~%" ("one two" "three four")))
139
;; Check some boundary cases on the types passed.
140
;; NOTE: NIL is ok since it means read from stdin!
141
(signals error (slurp-stream-lines 42))
142
(signals error (slurp-stream-lines "not valid"))
145
(defun common-test/run-program ()
146
;; Can we echo a simple string?
147
(is (equal '("abcde")
148
(run-program '("echo" "abcde") :output :lines)))
149
(is (equal (nl "fghij")
150
(run-program '("echo" "fghij") :output :string)))
152
;; Are spaces handled properly?
153
(is (equal '("Hello World")
154
(run-program '("echo" "Hello World") :output :lines)))
155
(is (equal (nl "Hello World")
156
(run-program '("echo" "Hello World") :output :string)))
157
(is (equal (nl "Hello World")
158
(run-program "echo Hello World" :output :string)))
160
;; Test that run-program fails properly with an
161
;; empty program string
162
#+(or clozure (and allegro os-unix) cmu (and lispworks os-unix) sbcl scl)
163
(signals error (run-program '("") :output :lines))
165
;; An empty string itself is ok since it is passed to the shell.
166
(is (equal "" (run-program "" :output :string)))
168
;; Test that run-program fails properly with a
170
#+(or clozure (and allegro os-unix) cmu sbcl scl)
171
(signals error (run-program nil :output :lines))
173
;; Test that run-program fails properly when the
174
;; executable doesn't exist.
175
(signals error (run-program '("does-not-exist") :output :lines))
176
(signals error (run-program "does-not-exist" :output :lines))
178
(is (equal 0 (run-program "echo ok" :output nil)))
179
(is (equal 0 (run-program '("echo" "ok") :output nil)))
183
(defun unix-only-test/run-program ()
185
(is (equal 0 (run-program "true")))
186
(signals subprocess-error (run-program "false"))
187
(is (equal 1 (run-program "false" :ignore-error-status t)))
189
(let ((tf (native-namestring (test-source "test-file"))))
191
;; a basic smoke test
192
(is (equal '("Single")
193
(run-program `("grep" "Single" ,tf) :output :lines)))
195
;; Make sure space is handled correctly
196
(is (equal '("double entry")
197
(run-program `("grep" "double entry" ,tf) :output :lines)))
199
;; Make sure space is handled correctly
200
(is (equal '("triple word entry")
201
(run-program `("grep" "triple word entry" ,tf) :output :lines)))
203
;; Testing special characters
204
(loop :for char :across "+-_.,%@:/\\!&*(){}"
205
:for str = (string char) :do
206
(is (equal (list (format nil "escape ~A" str))
208
`("grep" ,(format nil "[~A]" str) ,tf)
211
;; Test that run-program signals an error
212
;; with an executable that doesn't return 0
213
(signals subprocess-error (run-program '("false") :output :lines))
215
;; Test that we can suppress the error on run-program
216
(is (null (run-program '("false")
217
:output :lines :ignore-error-status t))))
220
(defun windows-only-test/run-program ()
222
;; a basic smoke test
223
(is (equal (run-program '("cmd" "/c" "echo" "ok") :output :lines)
228
(deftest test/run-program ()
229
#+os-unix (common-test/run-program)
230
#+os-unix (unix-only-test/run-program)
231
#+os-windows (windows-only-test/run-program)
added
removed
test/test-run-program.script
