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
abcl
abcl
Commits
a01314f9
Commit
a01314f9
authored
Jan 30, 2014
by
mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files
Untabify.
parent
cd048d63
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/org/armedbear/lisp/Pathname.java
View file @
a01314f9
...
...
@@ -1641,14 +1641,14 @@ public class Pathname extends LispObject {
for
(
int
i
=
files
.
length
;
i
--
>
0
;)
{
File
file
=
files
[
i
];
Pathname
p
;
String
path
;
if
(
resolveSymlinks
==
NIL
)
{
path
=
file
.
getAbsolutePath
();
}
else
{
path
=
file
.
getCanonicalPath
();
}
URI
pathURI
=
(
new
File
(
path
)).
toURI
();
p
=
new
Pathname
(
pathURI
.
toString
());
String
path
;
if
(
resolveSymlinks
==
NIL
)
{
path
=
file
.
getAbsolutePath
();
}
else
{
path
=
file
.
getCanonicalPath
();
}
URI
pathURI
=
(
new
File
(
path
)).
toURI
();
p
=
new
Pathname
(
pathURI
.
toString
());
result
=
new
Cons
(
p
,
result
);
}
}
catch
(
IOException
e
)
{
...
...
@@ -2036,21 +2036,21 @@ public class Pathname extends LispObject {
result
.
type
=
d
.
type
;
}
// CLtLv2 MERGE-PATHNAMES
// "[T]he missing components in the given pathname are filled
// in from the defaults pathname, except that if no version is
// specified the default version is used."
// "The merging rules for the version are more complicated and
// depend on whether the pathname specifies a name. If the
// pathname doesn't specify a name, then the version, if not
// provided, will come from the defaults, just like the other
// components. However, if the pathname does specify a name,
// then the version is not affected by the defaults. The
// reason is that the version ``belongs to'' some other file
// name and is unlikely to have anything to do with the new
// one. Finally, if this process leaves the
// version missing, the default version is used."
// "[T]he missing components in the given pathname are filled
// in from the defaults pathname, except that if no version is
// specified the default version is used."
// "The merging rules for the version are more complicated and
// depend on whether the pathname specifies a name. If the
// pathname doesn't specify a name, then the version, if not
// provided, will come from the defaults, just like the other
// components. However, if the pathname does specify a name,
// then the version is not affected by the defaults. The
// reason is that the version ``belongs to'' some other file
// name and is unlikely to have anything to do with the new
// one. Finally, if this process leaves the
// version missing, the default version is used."
if
(
p
.
version
!=
NIL
)
{
result
.
version
=
p
.
version
;
...
...
@@ -2202,9 +2202,9 @@ public class Pathname extends LispObject {
// Possibly canonicalize jar file directory
Cons
jars
=
(
Cons
)
pathname
.
device
;
LispObject
o
=
jars
.
car
();
if
(!(
o
instanceof
Pathname
))
{
return
doTruenameExit
(
pathname
,
errorIfDoesNotExist
);
}
if
(!(
o
instanceof
Pathname
))
{
return
doTruenameExit
(
pathname
,
errorIfDoesNotExist
);
}
if
(
o
instanceof
Pathname
&&
!(((
Pathname
)
o
).
isURL
())
// XXX Silently fail to call truename() if the default
...
...
@@ -2282,7 +2282,7 @@ public class Pathname extends LispObject {
}
}
error:
return
doTruenameExit
(
pathname
,
errorIfDoesNotExist
);
return
doTruenameExit
(
pathname
,
errorIfDoesNotExist
);
}
static
private
LispObject
doTruenameExit
(
Pathname
pathname
,
boolean
errorIfDoesNotExist
)
{
...
...
src/org/armedbear/lisp/directory.lisp
View file @
a01314f9
...
...
@@ -134,18 +134,18 @@ error to its caller."
namestring
nil
resolve-symlinks
))
(
matching-entries
()))
(
dolist
(
entry
entries
)
(
when
(
or
(
and
(
file-directory-p
entry
)
(
pathname-match-p
(
file-namestring
(
pathname-as-file
entry
))
(
file-namestring
pathname
)))
(
pathname-match-p
(
or
(
file-namestring
entry
)
""
)
(
file-namestring
pathname
)))
(
push
(
if
resolve-symlinks
(
truename
entry
)
entry
)
matching-entries
)))
(
when
(
or
(
and
(
file-directory-p
entry
)
(
pathname-match-p
(
file-namestring
(
pathname-as-file
entry
))
(
file-namestring
pathname
)))
(
pathname-match-p
(
or
(
file-namestring
entry
)
""
)
(
file-namestring
pathname
)))
(
push
(
if
resolve-symlinks
(
truename
entry
)
entry
)
matching-entries
)))
matching-entries
))))
;; Not wild.
(
let
((
truename
(
probe-file
pathname
)))
...
...
test/lisp/abcl/wild-pathnames.lisp
View file @
a01314f9
...
...
@@ -13,12 +13,12 @@
(
dolist
(
file
*test-files*
)
(
let
((
file
(
merge-pathnames
file
*temp-directory-root*
)))
(
ensure-directories-exist
(
directory-namestring
file
))
(
unless
(
probe-file
file
)
(
touch
file
)))))
(
unless
(
probe-file
file
)
(
touch
file
)))))
(
defun
remove-wild-test-hierarchy
()
(
ignore-errors
(
delete-directory-and-files
*temp-directory-root*
)))
(
delete-directory-and-files
*temp-directory-root*
)))
(
defmacro
with-test-directories
(
&rest
body
)
`
(
prog2
(
create-wild-test-hierarchy
)
...
...
@@ -32,21 +32,21 @@
(
subsetp
b
a
:test
#'
equal
)))
(
deftest
wild-pathnames.1
(
with-test-directories
(
let
((
results
(
directory
(
merge-pathnames
"**/*.ext"
*temp-directory-root*
)))
(
expected
(
loop
:for
file
:in
*test-files*
:collecting
(
merge-pathnames
file
*temp-directory-root*
))))
(
values
(
eq
(
length
results
)
(
length
expected
))
;; link --> file is not resolved by change in DIRECTORY to :RESOLVE-SYMLINKS nil
results
expected
(
set-equal
(
mapcar
#'
truename
results
)
(
mapcar
#'
truename
expected
)))))
(
with-test-directories
(
let
((
results
(
directory
(
merge-pathnames
"**/*.ext"
*temp-directory-root*
)))
(
expected
(
loop
:for
file
:in
*test-files*
:collecting
(
merge-pathnames
file
*temp-directory-root*
))))
(
values
(
eq
(
length
results
)
(
length
expected
))
;; link --> file is not resolved by change in DIRECTORY to :RESOLVE-SYMLINKS nil
results
expected
(
set-equal
(
mapcar
#'
truename
results
)
(
mapcar
#'
truename
expected
)))))
t
)
(
deftest
wild-pathnames.2
...
...
@@ -58,5 +58,5 @@
(
merge-pathnames
*temp-directory-root*
"foo.ext"
))
t
)
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