;; -*- Lisp -*-
(declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0)))

;; On Windows, normalize away CRLF into jut the unixy LF.
(defun dewindowize (x)
  ;; Some buggy implementations output extra space on Windows;
  ;; Implementations that rely on shell redirection on Windows also do, as a limitation.
  (string-trim " " (remove (code-char 13) x)))

;;#+(and clisp os-windows) (ext:without-package-lock () (trace ext:run-shell-command))
(os-cond
 ((os-unix-p)
  (DBG "Testing echo ok 1 via run-program as a list")
  (assert-equal "ok 1"
                (run-program '("echo" "ok" "1") :output '(:string :stripped t))))
 ((os-windows-p)
  (DBG "Testing ipconfig /all via run-progam as a string")
  ;; Interestingly, "ipconfig /all" fails on the msys2 bash, but not on the cygwin bash.
  (nest
   #+ecl (errors parameter-error) ;; FIXME: known breakage
   (run-program "ipconfig /all"))
  (DBG "Testing ipconfig /all via run-progam as a list")
  (run-program '("ipconfig" "/all"))))

(DBG "Testing echo ok 1 via run-program as a string")
#-(and ecl os-windows)
(assert-equal "ok 1"
              (dewindowize (run-program "echo ok 1" :output '(:string :stripped t))))
#+(and ecl os-windows)
(errors parameter-error
  (dewindowize (run-program "echo ok 1" :output '(:string :stripped t))))

;;; test asdf run-shell-command function
#-(and ecl os-windows)
(progn
(setf *verbose-out* nil)
(DBG "Testing true via run-shell-command")
(assert-equal 0 (run-shell-command "exit 0"))
(DBG "Testing false via run-shell-command")
(with-expected-failure (#+clasp "clasp fails on (EXT:SYSTEM \"exec  < /dev/null >> /dev/null 2>> /dev/null ; exit 0\")")
  (assert-equal 1 (run-shell-command "exit 1")))
(DBG "Testing bad shell command via run-shell-command")
(unless (< 0 (run-shell-command "./bad-shell-command"))
  (error "Failed to capture exit status indicating shell command failure.")))
#+(and ecl os-windows)
(errors not-implemented-error
  (eql 0  (run-shell-command "exit 0")))

(chdir *test-directory*)

#+os-unix
(progn
  (DBG "Testing good shell command in current directory via run-shell-command")
  (assert-equal 0 (run-shell-command "./good-shell-command")))

(DBG "Testing exit status with :output :interactive")
;; This test checks for a problem there was in allegro -- :output :interactive
;; would try to open T as a stream for INPUT.
#-(and ecl os-windows)
(loop
   :for (program . exit-code) :in
   #+os-unix '(("true" . 0) ("false" . 1))
   #+os-windows '(("cmd /c exit 0" . 0) ("cmd /c exit 1" . 1))
   :do (loop
          :for force-shell :in '(t nil)
          :do (if (string= program "true")
                  (assert-equal `(nil nil ,exit-code)
                                (multiple-value-list
                                 (run-program program
                                              :ignore-error-status t
                                              :force-shell force-shell
                                              :output :interactive)))
                  (with-expected-failure (#+clasp "Fails for false")
                    (assert-equal `(nil nil ,exit-code)
                                  (multiple-value-list
                                   (run-program program
                                                :ignore-error-status t
                                                :force-shell force-shell
                                                :output :interactive)))))))
#+(and ecl os-windows)
(DBG "Test skipped on ECL + Windows")

#-(and ecl os-windows)
(with-expected-failure (#+clasp "Fails")
  (assert-equal
   '("foo" "bar baz" 42)
   (multiple-value-bind (o e c)
       (run-program #+os-unix "cat ; echo bar  baz >&2 ; exit 42"
                    #+os-windows "findstr \"^\" & echo bar baz >&2 & exit 42"
                    ;; On some versions of windows, findstr hangs indefinitely
                    ;; when passed input without a trailing newline
                    :input '("foo" :terpri t)
                    :output '(:string :stripped t) :error-output '(:string :stripped t)
                    :ignore-error-status t)
     (DBG "aaa" o e c)
     (list (dewindowize o) (dewindowize e) c))))
#-(and ecl os-windows)
(assert-equal
 '(("foo" "bar" "baz" "quux") nil 0)
 (multiple-value-bind (o e c)
     (run-program #+os-unix "echo foo ; echo bar >&2 ; echo baz ; echo quux >& 2"
                       #+os-windows "echo foo & echo bar >&2 & echo baz & echo quux >& 2"
                       :output :lines :error-output :output)
   (list (mapcar 'dewindowize o) e c)))

#-(and ecl os-windows)
(let ((ok1 (format nil "; $ echo ok 1~%ok 1")))
  (DBG "Testing awkward legacy output capture via run-shell-command")
  (assert-equal
   (dewindowize
    (stripln
     (with-output-to-string (s)
       (let ((*verbose-out* s))
         (run-shell-command "echo ~A 1" "ok")))))
   ok1)
  (assert-equal
   (dewindowize
    (stripln
     (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.")))))))
   ok1))

#-(and ecl os-windows)
(assert-equal '(:ok 1) (run-program "echo :ok  1" :output :forms))
#-(and ecl os-windows)
(assert-equal "ok" (dewindowize (stripln
                                 (with-output-to-string (*standard-output*)
                                   (run-program "echo ok" :output t :error-output :output)))))

;; 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 ()
  (DBG "Can we echo a simple string?")
  (assert-equal '("abcde") (run-program '("echo" "abcde") :output :lines))
  (assert-equal (nl "fghij") (run-program '("echo" "fghij") :output :string))

  (DBG "Are spaces handled properly?")
  (assert-equal '("Hello World") (run-program '("echo" "Hello World") :output :lines))
  (assert-equal (nl "Hello World") (run-program '("echo" "Hello World") :output :string))
  (assert-equal (nl "Hello World") (run-program "echo Hello World" :output :string))

  (DBG "Test that run-program fails properly with an empty program string")
  #+(or clozure (and allegro os-unix) cmucl (and lispworks os-unix) sbcl scl)
  (signals error (run-program '("") :output :lines))

  (DBG "An empty string itself is ok since it is passed to the shell.")
  (assert-equal "" (run-program "" :output :string))

  (DBG "Test that run-program fails properly with a nil program list")
  #+(or clozure (and allegro os-unix) cmucl sbcl scl)
  (signals error (run-program nil :output :lines))

  (DBG "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))

  (assert-equal '(nil nil 0) (multiple-value-list (run-program "echo ok" :output nil)))
  (assert-equal '(nil nil 0) (multiple-value-list (run-program '("echo" "ok") :output nil)))
  t)


(defun unix-only-test/run-program ()

  (DBG "Checking that spaces between arguments are collapsed by shell when and only when unquoted")
  (assert-equal '("ok 1") (run-program "echo ok  1" :output :lines))
  (assert-equal '("ok  1") (run-program '("echo" "ok  1") :output :lines))
  (assert-equal "ok  1" (run-program '("echo" "ok  1") :output '(:string :stripped t)))

  (DBG "Checking behavior on program success or failure")
  (assert-equal '(nil nil 0) (multiple-value-list (run-program "true")))
  (signals subprocess-error (run-program "false"))
  (with-expected-failure (#+clasp "Fails")
    (assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :ignore-error-status t))))

  (DBG "Tests with test-file")
  (let ((tf (native-namestring (test-source "test-file"))))

    ;; a basic smoke test
    (assert-equal '("Single")
                  (run-program `("grep" "Single" ,tf) :output :lines))

    ;; Make sure space is handled correctly
    (assert-equal '("double entry")
                  (run-program `("grep" "double entry" ,tf) :output :lines))

    ;; Make sure space is handled correctly
    (assert-equal '("triple word entry")
                  (run-program `("grep" "triple word entry" ,tf) :output :lines))

    ;; Testing special characters
    (loop :for char :across "+-_.,%@:/\\!&*(){}"
      :for str = (string char) :do
        (assert-equal (list (format nil "escape ~A" str))
                      (run-program
                       `("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 '("false") :output :lines))

    ;; Test that we can suppress the error on run-program
    (is (null (run-program '("false")
                            :output :lines :ignore-error-status t))))
  t)

(defun windows-only-test/run-program ()
  (DBG "WINDOWS-ONLY-TEST/RUN-PROGRAM")
  ;; a basic smoke test
  (assert-equal "ok" (dewindowize (run-program '("cmd" "/c" "echo" "ok") :output :line)))
  #-(and ecl os-windows)
  (assert-equal "ok 1" (dewindowize (run-program "echo ok 1" :output :line)))
  ;; clozure: beware http://trac.clozure.com/ccl/ticket/1118

  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)
