Commit 40a89c19 authored by Robert Goldman's avatar Robert Goldman
Browse files

Merge branch 'run-program-windows' into 'master'

Run program windows

Various fixes for Windows.

See merge request !52
parents 58968bce ea467d96
Loading
Loading
Loading
Loading
+1 −1
Original line number Diff line number Diff line
@@ -109,7 +109,7 @@ as in for instance:

Or you can make that your local default (assuming GNU make) using:

    ln -s Makefile-lisp-scripting GNUmakefile
    echo "include Makefile-lisp-scripting" > GNUmakefile

These Lisp tools by default use Clozure Common Lisp (CCL) to build and run a binary
`build/asdf-tools` that will orchestrate the tests.
+5 −1
Original line number Diff line number Diff line
@@ -155,6 +155,7 @@ output to *VERBOSE-OUT*. Returns the shell's exit code.
PLEASE DO NOT USE.
Deprecated function, for backward-compatibility only.
Please use UIOP:RUN-PROGRAM instead."
    #-(and ecl os-windows)
    (let ((command (apply 'format nil control-string args)))
      (asdf-message "; $ ~A~%" command)
      (let ((exit-code
@@ -163,7 +164,10 @@ Please use UIOP:RUN-PROGRAM instead."
                                                 :output *verbose-out*)))))
        (typecase exit-code
          ((integer 0 255) exit-code)
          (t 255))))))
          (t 255))))
    #+(and ecl os-windows)
    (not-implemented-error "run-shell-command" "for ECL on Windows.")
    ))


(with-upgradability ()
+6 −6
Original line number Diff line number Diff line
@@ -8,7 +8,7 @@ set driver_lisp=uiop\package.lisp + uiop\common-lisp.lisp + uiop\utility.lisp +
set defsystem_lisp=upgrade.lisp + cache.lisp + component.lisp + system.lisp + find-system.lisp + find-component.lisp + operation.lisp + action.lisp + lisp-action.lisp + plan.lisp + operate.lisp + parse-defsystem.lisp + bundle.lisp + concatenate-source.lisp + output-translations.lisp + source-registry.lisp + package-inferred-system.lisp + backward-interface.lisp + backward-internals.lisp + interface.lisp + user.lisp + footer.lisp

%~d0
cd %~p0
cd "%~p0"

if "%~1"=="" goto all
if "%~1"=="all" goto all
@@ -19,8 +19,8 @@ if "%~1"=="noext" goto noext
if "%~1"=="driver_files" goto driver_files
if "%~1"=="defsystem_files" goto defsystem_files

call %0 build_asdf_tools
%here%\build\asdf-tools.exe env %*
call "%0" build_asdf_tools
"%here%\build\asdf-tools.exe" env %*
goto end


@@ -40,9 +40,9 @@ goto end

:build_asdf_tools
:: Building a binary for asdf-tools
 if exists build\asdf-tools.exe goto end
 call %0 build_asdf
 %here%\tools\asdf-tools.bat build-asdf-tools
 if exist build\asdf-tools.exe goto end
 call "%0" build_asdf
 "%here%\tools\asdf-tools.bat" build-asdf-tools
 goto end

:clobber
+7 −6
Original line number Diff line number Diff line
;;; -*- Lisp -*-
(in-package :asdf-test)

(eval-when (:compile-toplevel :load-toplevel :execute)
  #-(or xcl gcl) (push :asdf-test-logical-pathname *features*)
@@ -469,9 +470,9 @@
(test-pathname-parsing)

;;; test for CMUCL issue with search lists versus pathnames
#+os-unix
(progn
  (DBG "Checking CMUCL user-homedir-pathname issue.")
(assert
 (multiple-value-bind (value error)
     (ignore-errors
      (pathname-match-p (uiop::user-homedir-pathname) (uiop:getenv "HOME")))
   (null error)))
  (assert-pathname-equal
   (uiop/common-lisp:user-homedir-pathname)
   (getenv-pathname "HOME" :want-directory t)))
+84 −52
Original line number Diff line number Diff line
@@ -3,66 +3,99 @@

;; On Windows, normalize away CRLF into jut the unixy LF.
(defun dewindowize (x)
  (block ()
    (setf x (remove (code-char 13) x))
  ;; Some buggy implementations output extra space on Windows;
  ;; Implementations that rely on shell redirection on Windows also do, as a limitation.
    (when (eql #\space (last-char x))
      (return (subseq x 0 (1- (length x)))))
    x))

  (string-trim " " (remove (code-char 13) x)))

(os-cond
 ((os-unix-p)
  (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))))

#+(and sbcl os-windows)
(leave-test "SBCL won't let us pass unquoted arguments to cmd.exe" 0)
                (run-program '("echo" "ok" "1") :output '(:string :stripped t))))
 ((os-windows-p)
  (DBG "Testing ipconfig /all via run-progam as a string")
  ;;; FIXME: known breakage
  #+(and ecl os-windows)
  (errors parameter-error
          (run-program "ipconfig /all"))
  #-(and ecl os-windows)
  (run-program "ipconfig /all")
  (DBG "Testing ipconfig /all via run-progam as a list")
  (run-program '("ipconfig" "/all"))))

#-(and sbcl os-windows)
(progn
(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)))))
              (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 "true"))
(assert-equal 0 (run-shell-command "exit 0"))
(DBG "Testing false via run-shell-command")
(assert-equal 1 (run-shell-command "false"))
(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."))
  (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")))

#+os-unix
(progn
(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"))
  (assert-equal 0 (run-shell-command "./good-shell-command")))

  ;; this test checks for a problem there was in allegro -- :output :interactive
(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.
  (assert-equal '(nil nil 0) (multiple-value-list (run-program "true" :force-shell t :output :interactive)))
  (assert-equal '(nil nil 0) (multiple-value-list (run-program "true" :force-shell nil :output :interactive)))
  (assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :force-shell t :output :interactive :ignore-error-status t)))
  (assert-equal '(nil nil 1) (multiple-value-list (run-program "false" :force-shell nil :output :interactive :ignore-error-status t)))
#-(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 (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)
(assert-equal
 '("foo" "bar baz" 42)
   (multiple-value-list
    (run-program "cat ; echo bar  baz >&2 ; exit 42"
                 :input '("foo") :output :string :error-output '(:string :stripped t)
                 :ignore-error-status t)))
 (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-list
    (run-program "echo foo ; echo bar >&2 ; echo baz ; echo quux >& 2"
                 :output :lines :error-output :output))))
 (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 sbcl os-windows)
#-(and ecl os-windows)
(let ((ok1 (format nil "; $ echo ok 1~%ok 1")))
  (untrace)
  (DBG "Testing awkward legacy output capture via run-shell-command")
  (assert-equal
   (dewindowize
@@ -82,15 +115,13 @@
             (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)))))

#|
Testing run-program
|#

;; 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
@@ -241,9 +272,10 @@ Testing run-program
  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

Loading