Commit b62a0b1e authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

More Windows tweaks to test-run-program.

parent 14253178
;; -*- 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 '(:string :stripped t)))
;; On Windows, normalize away CRLF into jut the unixy LF.
(defun dewindowize (x)
(block ()
(setf x (remove (code-char 13) x))
#+(and sbcl windows) ;; buggy implementations output extra space on Windows. Also old CCL.
(when (eql #\space (last-char x))
(return (subseq x 0 (1- (length x)))))
(defun space-bugged (x) ;; some implementations are broken and output extra space on Windows
#.(or #+(and sbcl windows) '(strcat x " ") 'x))
(DBG "Testing echo ok 1 via run-program as a list")
(assert-equal "ok 1"
(dewindowize (run-program '("echo" "ok" "1") :output '(:string :stripped t))))
(DBG "Testing echo ok 1 via run-program as a string")
(assert-equal (space-bugged "ok 1")
(run-program "echo ok 1" :output '(:string :stripped t)))
(assert-equal "ok 1"
(dewindowize (run-program "echo ok 1" :output '(:string :stripped t))))
;;; test asdf run-shell-command function
(setf *verbose-out* nil)
......@@ -48,39 +55,37 @@
#+(and sbcl os-windows)
(leave-test "SBCL run-program is a big fail on windows")
;; 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~%~A~%" (space-bugged "ok 1"))))
(let ((ok1 (format nil "; $ echo ok 1~%ok 1")))
(with-output-to-string (s)
(let ((*verbose-out* s))
(run-shell-command "echo ~A 1" "ok"))))
(run-shell-command "echo ~A 1" "ok")))))
(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."))))))
(error "Didn't get good exit status.")))))))
;; 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 (space-bugged "ok 1") (run-program '("echo" "ok 1") :output :line))
(assert-equal "ok 1" (dewindowize (run-program '("echo" "ok 1") :output :line)))
(assert-equal "ok 1" (dewindowize (run-program '("echo" "ok 1") :output '(:string :stripped t))))
(assert-equal '(:ok 1) (run-program '("echo" ":ok 1") :output :forms))
(assert-equal (format nil "~A~%" (space-bugged "ok 1"))
(remove-cr (run-program '("echo" "ok 1") :output :string)))
(assert-equal (format nil "~A~%" (space-bugged "ok"))
(remove-cr (with-output-to-string (*standard-output*)
(run-program "echo ok" :output t :error-output :output))))
(assert-equal "ok" (dewindowize (stripln
(with-output-to-string (*standard-output*)
(run-program "echo ok" :output t :error-output :output)))))
;;#+allegro (trace excl:run-shell-command sys:reap-os-subprocess)
;;#+lispworks (trace system:run-shell-command system:pid-exit-status)
......@@ -199,7 +204,7 @@ Testing run-program
(defun unix-only-test/run-program ()
(assert-equal (list (space-bugged "ok 1")) (run-program "echo ok 1" :output :lines))
(assert-equal '("ok 1") (run-program "echo ok 1" :output :lines))
(assert-equal '(nil nil 0) (multiple-value-list (run-program "true")))
(signals subprocess-error (run-program "false"))
......@@ -239,10 +244,9 @@ Testing run-program
(defun windows-only-test/run-program ()
;; a basic smoke test
(assert-equal (run-program '("cmd" "/c" "echo" "ok") :output :lines)
(list (space-bugged "ok")))
(assert-equal "ok" (dewindowize (run-program '("cmd" "/c" "echo" "ok") :output :line)))
(assert-equal "ok 1" (dewindowize (run-program "echo ok 1" :output :line)))
(assert-equal (list (space-bugged "ok 1")) (run-program "echo ok 1" :output :lines))
(deftest 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