diff --git a/test/test-utilities.script b/test/test-utilities.script index 2e0f0bfdf295c7d91d51fd6dcdff5da7c0c470dd..310451d35793dd584df3d4af355a723845e2ce02 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -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")) diff --git a/uiop/os.lisp b/uiop/os.lisp index 66d6fc6f038a5cddb54953cf7a645853ae10838a..bc36d918e3887ca6279a065660d03453673d915b 100644 --- a/uiop/os.lisp +++ b/uiop/os.lisp @@ -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")))) diff --git a/uiop/pathname.lisp b/uiop/pathname.lisp index debc5c69e444a59bf3b4ea25a734ba9b329ff979..d8f7ce5e5c824c28ef81369c7dff115a2b1f1321 100644 --- a/uiop/pathname.lisp +++ b/uiop/pathname.lisp @@ -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))) diff --git a/uiop/run-program.lisp b/uiop/run-program.lisp index fa4d3961301cf71f7a985373a16d82a212ac5b37..47d2bc397d22c08c86d7f05787e756952d72deff 100644 --- a/uiop/run-program.lisp +++ b/uiop/run-program.lisp @@ -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