diff --git a/test/test-program.script b/test/test-program.script index 0448e66ac8cdf9087fbb0c9cad66ff21816dd7cc..b7f4b964e3094408bfe9af62a7764f7ea1689532 100644 --- a/test/test-program.script +++ b/test/test-program.script @@ -7,7 +7,7 @@ (assert (find-system :hello-world-example)) -(trace run-program) +(trace run-program #+(and sbcl os-windows) sb-ext:run-program) #+allegro (defparameter *lisp* diff --git a/test/test-run-program.script b/test/test-run-program.script index d10b62f8bc6ae44330e15942ea8fbdeaf6ce162c..f59137f60408806c643a9be690ef331ce14a7563 100644 --- a/test/test-run-program.script +++ b/test/test-run-program.script @@ -6,6 +6,8 @@ (trace uiop:run-program uiop/run-program::%run-program uiop/run-program::%system ext:shell ext:run-shell-command ext:run-program)) +#+(and sbcl os-windows) (trace sb-ext:run-program) + ;; On Windows, normalize away CRLF into jut the unixy LF. (defun dewindowize (x) (block () @@ -21,9 +23,14 @@ (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 "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) + +#-(and sbcl os-windows) +(progn + (DBG "Testing echo ok 1 via run-program as a string") + (assert-equal "ok 1" + (dewindowize (run-program "echo ok 1" :output '(:string :stripped t))))) ;;; test asdf run-shell-command function (setf *verbose-out* nil) @@ -81,9 +88,6 @@ (error "Didn't get good exit status."))))))) ok1)) -;; 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 '(:ok 1) (run-program "echo :ok 1" :output :forms)) (assert-equal "ok" (dewindowize (stripln (with-output-to-string (*standard-output*) diff --git a/test/test-utilities.script b/test/test-utilities.script old mode 100644 new mode 100755 index ae9456ecbb86d6caff56d8e293e88cf538f0df14..e0008b2af8152d9b43f1fec02c89852cec5d3155 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -1,24 +1,30 @@ ;;; -*- Lisp -*- +#+(and sbcl os-windows) (trace sb-ext:run-program) + (defun getcwd-from-run-program () (uiop:parse-native-namestring (nest ;; TODO: fix run-program to use POWERSHELL.EXE rather than CMD, and remove this kluge. #+os-windows (string-trim " ") (run-program - (os-cond ((os-unix-p) '("pwd" "-P")) ((os-windows-p) "echo %cd%")) + (os-cond + ((os-unix-p) '("pwd" "-P")) + ((os-windows-p) "cd")) :output '(:string :stripped t))) :ensure-directory t)) (let ((asdf-directory (truename *asdf-directory*))) (chdir asdf-directory) (assert-pathname-equal asdf-directory (getcwd)) + #-(and sbcl os-windows) (assert-pathname-equal asdf-directory (getcwd-from-run-program)) (assert (probe-file* "asdf.asd"))) (let ((test-directory (truename *test-directory*))) (chdir test-directory) (assert-pathname-equal test-directory (getcwd)) + #-(and sbcl os-windows) (assert-pathname-equal test-directory (getcwd-from-run-program)) (assert (probe-file* "test-utilities.script"))) diff --git a/uiop/filesystem.lisp b/uiop/filesystem.lisp index 1ce4d1a1682fb93adb8656a45c447b19474ae29c..d7b36549a8353e20db83495876285acae40f557b 100644 --- a/uiop/filesystem.lisp +++ b/uiop/filesystem.lisp @@ -584,6 +584,7 @@ in an atomic way if the implementation allows." #+clisp ;; in recent enough versions of CLISP, :if-exists :overwrite would make it atomic (progn (funcall 'require "syscalls") (symbol-call :posix :copy-file source target :method :rename)) + #+(and sbcl os-windows) (delete-file-if-exists target) ;; not atomic #-clisp (rename-file source target #+(or clasp clozure ecl) :if-exists #+clozure :rename-and-delete #+(or clasp ecl) t)) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index a480cb03d9c4ed38e027be600d879eb6b83fa13c..6f09c31c42fa6b6a64936e6c4b7295de522260be 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -332,6 +332,15 @@ Programmers are encouraged to define their own methods for this generic function (subprocess-error-command condition) (subprocess-error-code condition))))) + ;;; find CMD.exe on windows + (defun %cmd-shell-pathname () + (os-cond + ((os-windows-p) + (strcat (native-namestring (getenv-absolute-directory "WINDIR")) + "System32\\cmd.exe")) + (t + (error "CMD.EXE is not the command shell for this OS.")))) + ;;; Internal helpers for run-program (defun %normalize-command (command) "Given a COMMAND as a list or string, transform it in a format suitable @@ -341,17 +350,18 @@ for the implementation's underlying run-program function" #+os-unix (list command) #+os-windows (string - #+mkcl (list "cmd" '#:/c command) + #+mkcl (list "cmd" "/c" command) ;; NB: We do NOT add cmd /c here. You might want to. #+(or allegro clisp) command ;; On ClozureCL for Windows, we assume you are using ;; r15398 or later in 1.9 or later, ;; so that bug 858 is fixed http://trac.clozure.com/ccl/ticket/858 #+clozure (cons "cmd" (strcat "/c " command)) + #+sbcl (list (%cmd-shell-pathname) "/c" command) ;; NB: On other Windows implementations, this is utterly bogus ;; except in the most trivial cases where no quoting is needed. ;; Use at your own risk. - #-(or allegro clisp clozure mkcl) (list "cmd" "/c" command)) + #-(or allegro clisp clozure mkcl sbcl) (list "cmd" "/c" command)) #+os-windows (list #+allegro (escape-windows-command command) @@ -735,23 +745,14 @@ It returns a process-info plist with possible keys: :ignore-error-status ignore-error-status)))))))) (values output-result error-output-result exit-code))) - ;; find CMD.exe on windows - (defun %cmd-shell-pathname () - (os-cond - ((os-windows-p) - (concatenate 'string (namestring (getenv-absolute-directory "WINDIR")) - "System32\\cmd")) - (t - (error "CMD.EXE is not the command shell for this OS.")))) - (defun %normalize-system-command (command) ;; helper for %USE-SYSTEM (etypecase command (string (os-cond ((os-windows-p) - #+(or allegro clisp sbcl) - (concatenate 'string (%cmd-shell-pathname) " /c " command) - #-(or allegro sbcl clisp) command) + #+(or allegro clisp) + (strcat (%cmd-shell-pathname) " /c " command) + #-(or allegro clisp) command) (t command))) (list (escape-shell-command (os-cond