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

More Windows tweaks to test-run-program.

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