Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
asdf
asdf
Commits
a4fdf6f9
Commit
a4fdf6f9
authored
May 07, 2015
by
Francois-Rene Rideau
Browse files
Adopt for XCL same chdir pseudo-implementation as for ABCL.
parent
1ba453f8
Changes
4
Hide whitespace changes
Inline
Side-by-side
test/test-utilities.script
View file @
a4fdf6f9
...
...
@@ -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"))
...
...
uiop/os.lisp
View file @
a4fdf6f9
...
...
@@ -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
View file @
a4fdf6f9
...
...
@@ -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
View file @
a4fdf6f9
...
...
@@ -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
...
...
François-René Rideau
@frideau
mentioned in commit
cf8a8202
·
Jul 08, 2015
mentioned in commit
cf8a8202
mentioned in commit cf8a82025ce071611ee72fa06622b0633282c1a2
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment