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
Karsten Poeck
asdf
Commits
b1ffbc47
Commit
b1ffbc47
authored
Jun 25, 2019
by
Robert Goldman
Browse files
Further UIOP directory path fixes.
These from Spencer Truex, with tests by me.
parent
0bda58ed
Changes
2
Hide whitespace changes
Inline
Side-by-side
test/test-utilities.script
View file @
b1ffbc47
;;; -*- Lisp -*-
(in-package :asdf-test)
;; the following should not be necessary, because of `frob-packages`
;; call, but somehow is. [2019/06/25:rpg]
(use-package :uiop :asdf-test)
(proclaim '(optimize (debug 3) (speed 1) (safety 3) (compilation-speed 0)))
(defun getcwd-from-run-program ()
...
...
@@ -318,9 +321,7 @@
(assert (probe-file* (subpathname *build-directory* "deleteme/a/b/2")))
(DBG "check to make sure DIRECTORY-FILES doesn't list subdirectories")
(let ((directory-a (directory-files (subpathname *build-directory* "deleteme/a/")))
(directory-a-no-slash (directory-files (subpathname *build-directory* "deleteme/a")))
(directory-b (directory-files (subpathname *build-directory* "deleteme/a/b/")))
(directory-b-no-slash (directory-files (subpathname *build-directory* "deleteme/a/b"))))
(directory-b (directory-files (subpathname *build-directory* "deleteme/a/b/"))))
(assert-pathnames-equal directory-a (list (subpathname *build-directory* "deleteme/a/1.x")))
(assert-pathnames-equal directory-b (list (subpathname *build-directory* "deleteme/a/b/2"))))
(DBG "check to make sure DIRECTORY-FILES checks its parameter for directory pathname")
...
...
@@ -328,10 +329,31 @@
(directory-b-no-slash (directory-files (subpathname *build-directory* "deleteme/a/b"))))
(assert-pathnames-equal directory-a-no-slash (list (subpathname *build-directory* "deleteme/a/1.x")))
(assert-pathnames-equal directory-b-no-slash (list (subpathname *build-directory* "deleteme/a/b/2"))))
(DBG "check to make sure WITH-CURRENT-DIRECTORY checks its parameter for directory pathname")
(let ((directory-a-no-slash (subpathname *build-directory* "deleteme/a"))
(directory-b-no-slash (subpathname *build-directory* "deleteme/a/b")))
(assert (eq 'with-current-directory 'uiop:with-current-directory))
(with-current-directory (directory-a-no-slash)
(assert-pathnames-equal (directory-files (getcwd)) (list (subpathname *build-directory* "deleteme/a/1.x"))))
(with-current-directory (directory-b-no-slash)
(assert-pathnames-equal (directory-files (getcwd)) (list (subpathname *build-directory* "deleteme/a/b/2")))
(assert-pathnames-equal
(sort (subdirectories (getcwd)) #'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/")))))
(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-pathnames-equal directory-a (list (subpathname *build-directory* "deleteme/a/b/")))
;; trailing slash should not be necessary...
(assert-pathnames-equal (subdirectories (subpathname *build-directory* "deleteme/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/")
...
...
uiop/filesystem.lisp
View file @
b1ffbc47
...
...
@@ -490,7 +490,10 @@ resolving them with respect to GETCWD if the DEFAULTS were relative"
"call the THUNK in a context where the current directory was changed to DIR, if not NIL.
Note that this operation is usually NOT thread-safe."
(
if
dir
(
let*
((
dir
(
resolve-symlinks*
(
get-pathname-defaults
(
pathname-directory-pathname
dir
))))
(
let*
((
dir
(
resolve-symlinks*
(
get-pathname-defaults
(
ensure-directory-pathname
dir
))))
(
cwd
(
getcwd
))
(
*default-pathname-defaults*
dir
))
(
chdir
dir
)
...
...
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