Commit b5d92fbc authored by Francois-Rene Rideau's avatar Francois-Rene Rideau Committed by Robert P. Goldman
Browse files

Some fixes to CLISP on Windows: use ext:probe-pathname, not posix:file-stat;

use ext:run-program, not ext:shell.
parent fdd34378
;; -*- Lisp -*- ;; -*- Lisp -*-
(declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0))) (declaim (optimize (debug 3) (safety #-gcl 3 #+gcl 0)))
#+(and clisp os-windows)
(ext:without-package-lock ()
(trace uiop:run-program uiop/run-program::%run-program uiop/run-program::%system
ext:shell ext:run-shell-command ext:run-program))
;; On Windows, normalize away CRLF into jut the unixy LF. ;; On Windows, normalize away CRLF into jut the unixy LF.
(defun dewindowize (x) (defun dewindowize (x)
(block () (block ()
......
...@@ -116,7 +116,7 @@ or the original (parsed) pathname if it is false (the default)." ...@@ -116,7 +116,7 @@ or the original (parsed) pathname if it is false (the default)."
(cond (cond
(truename foundtrue) (truename foundtrue)
(foundtrue p))))) (foundtrue p)))))
(let* ((fs (find-symbol* '#:file-stat :posix nil)) (let* ((fs (or #-os-windows (find-symbol* '#:file-stat :posix nil)))
(pp (find-symbol* '#:probe-pathname :ext nil)) (pp (find-symbol* '#:probe-pathname :ext nil))
(resolve (if pp (resolve (if pp
`(ignore-errors (,pp p)) `(ignore-errors (,pp p))
......
...@@ -410,7 +410,7 @@ It returns a process-info plist with possible keys: ...@@ -410,7 +410,7 @@ It returns a process-info plist with possible keys:
;; NB: these implementations have unix vs windows set at compile-time. ;; NB: these implementations have unix vs windows set at compile-time.
(declare (ignorable if-input-does-not-exist if-output-exists if-error-output-exists)) (declare (ignorable if-input-does-not-exist if-output-exists if-error-output-exists))
(assert (not (and wait (member :stream (list input output error-output))))) (assert (not (and wait (member :stream (list input output error-output)))))
#-(or allegro clozure cmu (and lispworks os-unix) sbcl scl) #-(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl)
(progn command keys directory (progn command keys directory
(error "run-program not available")) (error "run-program not available"))
#+(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl) #+(or allegro clisp clozure cmu (and lispworks os-unix) sbcl scl)
...@@ -435,10 +435,10 @@ It returns a process-info plist with possible keys: ...@@ -435,10 +435,10 @@ It returns a process-info plist with possible keys:
#-allegro #-allegro
(with-current-directory (#-sbcl directory) (with-current-directory (#-sbcl directory)
#+clisp #+clisp
(flet ((run (f &rest args) (flet ((run (f x &rest args)
(multiple-value-list (multiple-value-list
(apply f :input %input :output %output (apply f x :input %input :output %output
:allow-other-keys t `(,@args ,@keys))))) :allow-other-keys t `(,@args ,@keys)))))
(assert (eq %error-output :terminal)) (assert (eq %error-output :terminal))
;;; since we now always return a code, we can't use this code path, anyway! ;;; since we now always return a code, we can't use this code path, anyway!
(etypecase %command (etypecase %command
...@@ -769,14 +769,17 @@ It returns a process-info plist with possible keys: ...@@ -769,14 +769,17 @@ It returns a process-info plist with possible keys:
#+(or allegro clozure cmu (and lispworks os-unix) sbcl scl) #+(or allegro clozure cmu (and lispworks os-unix) sbcl scl)
(%wait-process-result (%wait-process-result
(apply '%run-program (%normalize-system-command command) :wait t keys)) (apply '%run-program (%normalize-system-command command) :wait t keys))
#+(or abcl clisp cormanlisp ecl gcl (and lispworks os-windows) mkcl xcl) #+(or abcl cormanlisp clisp ecl gcl (and lispworks os-windows) mkcl xcl)
(let ((%command (%redirected-system-command command input output error-output directory))) (let ((%command (%redirected-system-command command input output error-output directory)))
#+(and lispworks os-windows) #+(and lispworks os-windows)
(system:call-system %command :current-directory directory :wait t) (system:call-system %command :current-directory directory :wait t)
#-(and lispworks os-windows) #+clisp
(%wait-process-result
(apply '%run-program %command :wait t
:input :interactive :output :interactive :error-output :interactive keys))
#-(or clisp (and lispworks os-windows))
(with-current-directory ((unless (os-unix-p) directory)) (with-current-directory ((unless (os-unix-p) directory))
#+abcl (ext:run-shell-command %command) #+abcl (ext:run-shell-command %command)
#+clisp (clisp-exit-code (ext:shell %command))
#+cormanlisp (win32:system %command) #+cormanlisp (win32:system %command)
#+ecl (let ((*standard-input* *stdin*) #+ecl (let ((*standard-input* *stdin*)
(*standard-output* *stdout*) (*standard-output* *stdout*)
......
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