Commit a4fdf6f9 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Adopt for XCL same chdir pseudo-implementation as for ABCL.

parent 1ba453f8
......@@ -7,14 +7,12 @@
:output '(:string :stripped t))
:ensure-directory t))
(with-expected-failure (#+xcl "chdir unsupported")
(chdir *asdf-directory*)
(assert (pathname-equal *asdf-directory* (getcwd)))
(assert (pathname-equal *asdf-directory* (getcwd-from-run-program)))
(assert (probe-file* "asdf.asd")))
(with-expected-failure (#+xcl "chdir unsupported")
(chdir *test-directory*))
(chdir *asdf-directory*)
(assert (pathname-equal *asdf-directory* (getcwd)))
(assert (pathname-equal *asdf-directory* (getcwd-from-run-program)))
(assert (probe-file* "asdf.asd"))
(chdir *test-directory*)
(assert (pathname-equal *test-directory* (getcwd)))
(assert (pathname-equal *test-directory* (getcwd-from-run-program)))
(assert (probe-file* "test-utilities.script"))
......
......@@ -271,7 +271,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(defun getcwd ()
"Get the current working directory as per POSIX getcwd(3), as a pathname object"
(or #+(or abcl genera) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
(or #+(or abcl genera xcl) (truename *default-pathname-defaults*) ;; d-p-d is canonical!
#+allegro (excl::current-directory)
#+clisp (ext:default-directory)
#+clozure (ccl:current-directory)
......@@ -289,7 +289,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
(defun chdir (x)
"Change current directory, as per POSIX chdir(2), to a given pathname object"
(if-let (x (pathname x))
#+(or abcl genera) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
#+(or abcl genera xcl) (setf *default-pathname-defaults* (truename x)) ;; d-p-d is canonical!
#+allegro (excl:chdir x)
#+clisp (ext:cd x)
#+clozure (setf (ccl:current-directory) x)
......@@ -301,7 +301,7 @@ suitable for use as a directory name to segregate Lisp FASLs, C dynamic librarie
#+lispworks (hcl:change-directory x)
#+mkcl (mk-ext:chdir x)
#+sbcl (progn (require :sb-posix) (symbol-call :sb-posix :chdir (sb-ext:native-namestring x)))
#-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mkcl sbcl scl)
#-(or abcl allegro clasp clisp clozure cmu cormanlisp ecl gcl genera lispworks mkcl sbcl scl xcl)
(error "chdir not supported on your implementation"))))
......
......@@ -204,10 +204,10 @@ when merging, making or parsing pathnames")
(defmacro with-pathname-defaults ((&optional defaults) &body body)
"Execute BODY in a context where the *DEFAULT-PATHNAME-DEFAULTS* is as specified,
where leaving the defaults NIL or unspecified means a (NIL-PATHNAME), except on ABCL and Genera,
where it remains unchanged for it doubles as current-directory."
where leaving the defaults NIL or unspecified means a (NIL-PATHNAME), except
on ABCL, Genera and XCL, where it remains unchanged for it doubles as current-directory."
`(let ((*default-pathname-defaults*
,(or defaults #-(or abcl genera) '*nil-pathname* #+(or abcl genera) '*default-pathname-defaults*)))
,(or defaults #-(or abcl genera xcl) '*nil-pathname* #+(or abcl genera) '*default-pathname-defaults*)))
,@body)))
......
......@@ -758,7 +758,7 @@ It returns a process-info plist with possible keys:
(escape-shell-token (native-namestring pathname)))))))
(let* ((redirections (append (redirect in " <") (redirect out " >") (redirect err " 2>")))
(normalized (%normalize-system-command command))
(directory (or directory #+abcl (getcwd)))
(directory (or directory #+(or abcl xcl) (getcwd)))
(chdir (when directory
(let ((dir-arg (escape-shell-token (native-namestring directory))))
(os-cond
......
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