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
5f3c95ce
Commit
5f3c95ce
authored
Feb 20, 2014
by
Francois-Rene Rideau
Browse files
Add the same kludge in DIRECTORY-FILES for GCL as for CLISP.
Fix DIRECTORY tests in test-utilities.script.
parent
8dc5508c
Changes
3
Hide whitespace changes
Inline
Side-by-side
TODO
View file @
5f3c95ce
...
...
@@ -152,6 +152,7 @@
which suggests brokenness in handler-bind and/or error.
*** `#5(1 ,@`(2 3)))` returns #(1 2 3),
rather than #(1 2 3 2 3 2 3 2 3) or even better #(1 2 3 3 3).
*** (DIRECTORY #p"*.*") fails to match files with pathname type NIL.
** ABCL has a few bugs.
*** ABCL fails the timestamp propagation test.
...
...
test/test-utilities.script
View file @
5f3c95ce
...
...
@@ -202,22 +202,20 @@
(assert (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/")))
(assert (probe-file* (subpathname *build-directory* "deleteme/a/1.x")))
(assert (probe-file* (subpathname *build-directory* "deleteme/a/b/2")))
;;;
check to make sure DIRECTORY-FILES doesn't list subdirectories
(DBG "
check to make sure DIRECTORY-FILES doesn't list subdirectories
")
(let ((directory-a (directory-files (subpathname *build-directory* "deleteme/a/")))
(directory-b (directory-files (subpathname *build-directory* "deleteme/a/b/"))))
(assert
(every '
pathname-equal directory-a (list (subpathname *build-directory* "deleteme/a/1.x")))
)
(assert
(every '
pathname-equal directory-b (list (subpathname *build-directory* "deleteme/a/b/2"))))
)
;;;
check to make sure SUBDIRECTORIES does list subdirectories
(assert
-
pathname
s
-equal directory-a (list (subpathname *build-directory* "deleteme/a/1.x")))
(assert
-
pathname
s
-equal directory-b (list (subpathname *build-directory* "deleteme/a/b/2"))))
(DBG "
check to make sure SUBDIRECTORIES does list subdirectories
")
(let ((directory-a (subdirectories (subpathname *build-directory* "deleteme/a/")))
(directory-b (subdirectories (subpathname *build-directory* "deleteme/a/b/"))))
(assert (set-equality directory-a
(list (subpathname *build-directory* "deleteme/a/b/"))
:test 'pathname-equal))
(assert (set-equality directory-b
(list (subpathname *build-directory* "deleteme/a/b/c/")
(subpathname *build-directory* "deleteme/a/b/d/")
(subpathname *build-directory* "deleteme/a/b/e/"))
:test 'pathname-equal)))
(assert-pathnames-equal directory-a (list (subpathname *build-directory* "deleteme/a/b/")))
(assert-pathnames-equal
(sort directory-b #'string< :key #'(lambda (x) (car (last (pathname-directory x)))))
(list (subpathname *build-directory* "deleteme/a/b/c/")
(subpathname *build-directory* "deleteme/a/b/d/")
(subpathname *build-directory* "deleteme/a/b/e/"))))
(delete-empty-directory (subpathname *build-directory* "deleteme/a/b/e/"))
(assert (not (directory-exists-p (subpathname *build-directory* "deleteme/a/b/e/"))))
(delete-directory-tree (subpathname *build-directory* "deleteme/")
...
...
uiop/filesystem.lisp
View file @
5f3c95ce
...
...
@@ -212,7 +212,7 @@ permits this."
(
setf
pattern
(
make-pathname-logical
pattern
(
pathname-host
dir
))))
(
let*
((
pat
(
merge-pathnames*
pattern
dir
))
(
entries
(
append
(
ignore-errors
(
directory*
pat
))
#+
clisp
#+
(
or
clisp
gcl
)
(
when
(
equal
:wild
(
pathname-type
pattern
))
(
ignore-errors
(
directory*
(
make-pathname
:type
nil
:defaults
pat
)))))))
(
remove-if
'directory-pathname-p
...
...
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