Commit cd048d63 authored by mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

Test towards working through ASDF bundle-op with WILD-INFERIORS problems.

WILD.PATHNAMES.1 normalization problems were fixed by relaxing
semantics on resolving symlinks in CL:DIRECTORY calls.
parent 32563d28
...@@ -6,16 +6,19 @@ ...@@ -6,16 +6,19 @@
'("foo.ext" "a/b/c/foo.ext" "a/d/e/foo.ext" "b/foo.ext" "a/foo.ext")) '("foo.ext" "a/b/c/foo.ext" "a/d/e/foo.ext" "b/foo.ext" "a/foo.ext"))
(defvar *temp-directory-root* (defvar *temp-directory-root*
(merge-pathnames "tmp/" *this-directory*)) (ext:make-temp-directory))
(defun create-wild-test-hierarchy () (defun create-wild-test-hierarchy ()
(ensure-directories-exist *temp-directory-root*)
(dolist (file *test-files*) (dolist (file *test-files*)
(let ((file (merge-pathnames file *temp-directory-root*))) (let ((file (merge-pathnames file *temp-directory-root*)))
(ensure-directories-exist (directory-namestring file)) (ensure-directories-exist (directory-namestring file))
(touch file)))) (unless (probe-file file)
(touch file)))))
(defun remove-wild-test-hierarchy () (defun remove-wild-test-hierarchy ()
(delete-directory-and-files *temp-directory-root*)) (ignore-errors
(delete-directory-and-files *temp-directory-root*)))
(defmacro with-test-directories (&rest body) (defmacro with-test-directories (&rest body)
`(prog2 (create-wild-test-hierarchy) `(prog2 (create-wild-test-hierarchy)
...@@ -29,21 +32,23 @@ ...@@ -29,21 +32,23 @@
(subsetp b a :test #'equal))) (subsetp b a :test #'equal)))
(deftest wild-pathnames.1 (deftest wild-pathnames.1
(let ((results (with-test-directories
(with-test-directories (let ((results
(directory (merge-pathnames "**/*.ext" (directory (merge-pathnames "**/*.ext"
*temp-directory-root*)))) *temp-directory-root*)))
(expected (expected
(loop :for file :in *test-files* (loop :for file :in *test-files*
:collecting (merge-pathnames file :collecting (merge-pathnames file
*temp-directory-root*)))) *temp-directory-root*))))
(set-equal results expected)) (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) t)
;;; XXX try to track this down by going to the git version?
;;;
;;; Passing, but some form of :VERSION :NEWEST was failing for
;;; ASDF-2.116 according to Faré in proviate email of 18.08.2010
(deftest wild-pathnames.2 (deftest wild-pathnames.2
(equal (equal
(first (with-test-directories (first (with-test-directories
...@@ -53,4 +58,5 @@ ...@@ -53,4 +58,5 @@
(merge-pathnames *temp-directory-root* "foo.ext")) (merge-pathnames *temp-directory-root* "foo.ext"))
t) t)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment