(defparameter *cat-out* (make-synonym-stream '*cat-out-pipe*))
(with-test (:name :run-program-cat-2)
- (let ((cat (run-program "/bin/cat" nil :input *cat-in* :output *cat-out*
+ (let ((cat (run-program "/bin/cat" nil :input *cat-in* :output *cat-out*
:wait nil)))
- (dolist (test '("This is a test!"
- "This is another test!"
+ (dolist (test '("This is a test!"
+ "This is another test!"
"This is the last test...."))
(write-line test *cat-in*)
(assert (equal test (read-line *cat-out*))))
;;; The above test used to use ed, but there were buffering issues: on some platforms
;;; 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.
+;;; agressive about flushing them. So, here's another test using :PTY.
(defparameter *tmpfile* "run-program-ed-test.tmp")
*ed*)
(unwind-protect
- (with-test (:name :run-program-ed)
+ (with-test (:name :run-program-ed)
(assert-ed nil "4")
(assert-ed ".s/bar/baz/g" "")
(assert-ed "w" "4")
(with-open-file (f *tmpfile*)
(assert (equal "baz" (read-line f)))))
(delete-file *tmpfile*))
+
+;; Around 1.0.12 there was a regression when :INPUT or :OUTPUT was a
+;; pathname designator. Since these use the same code, it should
+;; suffice to test just :INPUT.
+(let ((file))
+ (unwind-protect
+ (progn (with-open-file (f "run-program-test.tmp" :direction :output)
+ (setf file (truename f))
+ (write-line "Foo" f))
+ (assert (run-program "cat" ()
+ :input file :output t
+ :search t :wait t)))
+ (when file
+ (delete-file file))))
+
+;;; This used to crash on Darwin and trigger recursive lock errors on
+;;; every platform.
+(with-test (:name (:run-program :stress))
+ ;; Do it a hundred times in batches of 10 so that with a low limit
+ ;; of the number of processes the test can have a chance to pass.
+ (loop
+ repeat 10 do
+ (map nil
+ #'sb-ext:process-wait
+ (loop repeat 10
+ collect
+ (sb-ext:run-program "/bin/echo" '
+ ("It would be nice if this didn't crash.")
+ :wait nil :output nil)))))
+
+(with-test (:name (:run-program :pty-stream))
+ (assert (equal "OK"
+ (subseq
+ (with-output-to-string (s)
+ (assert (= 42 (process-exit-code
+ (run-program "/bin/sh" '("-c" "echo OK; exit 42") :wait t
+ :pty s))))
+ s)
+ 0
+ 2))))