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

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

parent 1ba453f8

test/test-utilities.script

+6 −8
Original line number Diff line number Diff line
@@ -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")))

(assert (probe-file* "asdf.asd"))



(with-expected-failure (#+xcl "chdir unsupported")

  (chdir *test-directory*))

(chdir *test-directory*)

(assert (pathname-equal *test-directory* (getcwd)))

(assert (pathname-equal *test-directory* (getcwd-from-run-program)))

(assert (probe-file* "test-utilities.script"))

uiop/os.lisp

+3 −3
Original line number Diff line number Diff line
@@ -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"))))

uiop/pathname.lisp

+3 −3
Original line number Diff line number Diff line
@@ -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)))

uiop/run-program.lisp

+1 −1
Original line number Diff line number Diff line
@@ -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