Skip to content
Snippets Groups Projects
Commit d18e1ffc authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Get tests passing on SBCL/Windows

Punt on making rename-file-overwriting-target atomic.
Punt on trying to run cmd with anything that SBCL would escape.
parent 2de39aa3
No related branches found
No related tags found
No related merge requests found
......@@ -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*
......
......@@ -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*)
......
;;; -*- 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")))
......
......@@ -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))
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment