Changeset 14620

Timestamp:

01/30/14 14:10:04 (9 years ago)

Author:

Mark Evenson

Message:

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.

File:

• trunk/abcl/test/lisp/abcl/wild-pathnames.lisp (modified) (3 diffs)

trunk/abcl/test/lisp/abcl/wild-pathnames.lisp

@@ -7 +7 @@
 
 (defvar *temp-directory-root* 
-  (merge-pathnames "tmp/" *this-directory*))
+  (ext:make-temp-directory))
 
 (defun create-wild-test-hierarchy ()
+  (ensure-directories-exist *temp-directory-root*)
   (dolist (file *test-files*)
     (let ((file (merge-pathnames file *temp-directory-root*)))
       (ensure-directories-exist (directory-namestring file))
-      (touch file))))
+    (unless (probe-file file)
+    (touch file)))))
 
 (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)
@@ -30 +33 @@
     
 (deftest wild-pathnames.1
-    (let ((results
-           (with-test-directories
-               (directory (merge-pathnames "**/*.ext"
-                                           *temp-directory-root*))))
-          (expected
-           (loop :for file :in *test-files*
-              :collecting (merge-pathnames file
-                                           *temp-directory-root*))))
-      (set-equal results 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)
 
-;;; 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
     (equal 
@@ -54 +59 @@
   t)
 
+