Changeset 14624

Timestamp:

02/06/14 14:28:50 (9 years ago)

Author:

Mark Evenson

Message:

Fix (remaining?) bugs for DIRECTORY.

Fixes Quicklisp, aka the "DIRECTORY no longer works with
:WILD-INFERIORS" problem, q.v. <​http://abcl.org/trac/ticket/344>.

DIRECTORY under non-Windows now fills nil DEVICE components with
:UNSPECIFIC, otherwise forms like

(equal (truename "~/.emacs")

(first (directory "~/.emacs")) )

fail (c.f. ANSI test DIRECTORY.[67]).

Location:

trunk/abcl

Files:

• doc/design/pathnames/merging-defaults.markdown (modified) (3 diffs)
• src/org/armedbear/lisp/Pathname.java (modified) (5 diffs)
• src/org/armedbear/lisp/directory.lisp (modified) (2 diffs)
• test/src/org/armedbear/lisp/PathnameTest.java (modified) (1 diff)

trunk/abcl/doc/design/pathnames/merging-defaults.markdown

@@ -100 +100 @@
 resolving a path to a plain file.
 
+
+### DIRECTORY sets DEVICE to :UNSPECIFIC
+
+When the default for the :RESOLVE-SYMLINKS argument to DIRECTORY was
+changed to nil, DIRECTORY was changed not to always resolve its
+results via TRUENAME.  As a result
+
+    (equal (truename "~/.emacs")
+           (first (directory "~/.emacs")) )
+
+forms would return nil.  This is a bit counter to expectations set by
+CLHS that DIRECTORY "returns a list of pathnames corresponding to the
+truenames".  In particular, this breaks the ANSI CL DIRECTORY.[67]
+tests.  Thus, under non-Windows we now explicitly normalize DEVICE
+components which are nil to :UNSPECIFIC for the results of DIRECTORY
+calls.
+
 ### Use an implicit type for merging 
 
@@ -105 +122 @@
 is a JAR-PATHNAME and the following conditions hold:
 
-1.  HOST and DEVICE of the PATHNAME are NIL
+    1.  HOST and DEVICE of the PATHNAME are NIL
 
-2.  The DIRECTORY of the PATHNAME represents an absolute path. 
+    2.  The DIRECTORY of the PATHNAME represents an absolute path.
 
-3.  We are not on Windows.
+    3.  We are not running under Windows.
 
 we set the DEVICE to be :UNSPECIFIC.
@@ -117 +134 @@
 Mark <evenson@panix.com>
 Created:  01-SEP-2012
-Revised:  09-OCT-2012
+Revised:  06-FEB-2014
 

trunk/abcl/src/org/armedbear/lisp/Pathname.java

@@ -218 +218 @@
         init(url.toString());
     }
+    
+    public Pathname(URI uri) {
+        init(uri.toString());
+    }
 
     static final Symbol SCHEME = internKeyword("SCHEME");
@@ -369 +373 @@
                 URI uri = null;
                 try {
-                    uri = url.toURI();
+                    uri = new URI(s);
                 } catch (URISyntaxException ex) {
                     error(new SimpleError("Improper URI syntax for "
@@ -375 +379 @@
                                     + ": " + ex.toString()));
                 }
+            
                 String uriPath = uri.getPath();
                 if (null == uriPath) {
-            // We make an exception for forms like "file:z:/foo/path"
-            uriPath = uri.getSchemeSpecificPart();
-            if (uriPath == null || uriPath.equals("")) {
-               error(new LispError("The URI has no path: " + uri));
-                }
+          // Under Windows, deal with pathnames containing
+          // devices expressed as "file:z:/foo/path"
+          uriPath = uri.getSchemeSpecificPart();
+          if (uriPath == null || uriPath.equals("")) {
+                    error(new LispError("The URI has no path: " + uri));
+                  }
                 }
                 final File file = new File(uriPath);
-                final Pathname p = new Pathname(file.getPath());
+                String path = file.getPath();
+                if (uri.toString().endsWith("/") && !path.endsWith("/")) {
+                  path += "/";
+                }
+                final Pathname p = new Pathname(path);
                 this.host = p.host;
                 this.device = p.device;
@@ -404 +414 @@
             String authority = uri.getAuthority();
         if (authority == null) {
-        authority = url.getAuthority();
-        if (authority == null) {
-            Debug.trace(MessageFormat.format("{0} has a null authority.",
-                             url));
-        }
-        }
-
-            host = NIL;
-            host = host.push(SCHEME);
-            host = host.push(new SimpleString(scheme));
+          authority = url.getAuthority();
+          if (authority == null) {
+            Debug.trace(MessageFormat.format("{0} has a null authority.", url));
+          }
+        }
+
+        host = NIL;
+        host = host.push(SCHEME);
+        host = host.push(new SimpleString(scheme));
 
         if (authority != null) {
-        host = host.push(AUTHORITY);
-        host = host.push(new SimpleString(authority));
-        }
-
-            device = NIL;
+          host = host.push(AUTHORITY);
+          host = host.push(new SimpleString(authority));
+        }
+
+        device = NIL;
             
-            // URI encode necessary characters
-            String path = uri.getRawPath();
-            if (path == null) {
-                path = "";
-            } 
-            String query = uri.getRawQuery();
-            if (query != null) {
-                host = host.push(QUERY);
+        // URI encode necessary characters
+        String path = uri.getRawPath();
+        if (path == null) {
+          path = "";
+        } 
+        String query = uri.getRawQuery();
+        if (query != null) {
+          host = host.push(QUERY);
                 host = host.push(new SimpleString(query));
             }
@@ -1649 +1658 @@
                             }
                             URI pathURI = (new File(path)).toURI();
-                            p = new Pathname(pathURI.toString());
+                            p = new Pathname(pathURI);
                             result = new Cons(p, result);
                         }
                     } catch (IOException e) {
-                        return error(new FileError("Unable to list directory " + pathname.princToString() + ".",
+                        return error(new FileError("Unable to list directory " 
+                                                   + pathname.princToString() + ".",
                                                    pathname));
                     } catch (SecurityException e) {

trunk/abcl/src/org/armedbear/lisp/directory.lisp

@@ -62 +62 @@
                                  :name nil :type nil :defaults pathname))
          (entries (list-directory newpath resolve-symlinks)))
-    (if (not (or wild wild-inferiors-found))
-        entries
-        (let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
-          (nconc 
-           (mapcan (lambda (entry) 
-                     (when (pathname-match-p (pathname entry) pathname)
-                       (list entry)))
-                   inferior-entries)
-           (mapcan (lambda (entry)
-                     (let* ((pathname (pathname entry))
-                            (directory (pathname-directory pathname))
-                            (rest-wild (cdr wild)))
-                       (unless (pathname-name pathname)
-                         (when (pathname-match-p (first (last directory))
-                                    (cond ((eql (car wild) :wild)
-                                           "*")
-                                          ((eql (car wild) :wild-inferiors)
-                                           "*")
-                                          (wild 
-                                           (car wild))
-                                          (t "")))
-                           (when (and 
-                                  (not (or first-wild-inferior 
-                                           wild-inferiors-found)) 
-                                  rest-wild)
-                             (setf directory (nconc directory rest-wild)))
-                           (let ((recurse (make-pathname :directory directory
-                                                  :defaults newpath)))
-                             (when (not (equal recurse newpath))
-                               (list-directories-with-wildcards
-                                recurse
-                                (or first-wild-inferior wild-inferiors-found)
-                                resolve-symlinks)))))))
-                   entries))))))
-
-;;; XXX Kludge for compatibilty:  hope no one uses.
-(defun directory-old (pathspec &key (resolve-symlinks t))
-  (warn "Deprecated:  Please use CL:DIRECTORY which has a NIL default for :RESOLVE-SYMLINKS.")
-  (directory pathspec :resolve-symlinks resolve-symlinks))
+    (when (not (or wild wild-inferiors-found)) ;; no further recursion necessary
+        (return-from list-directories-with-wildcards entries))
+    (let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
+      (nconc 
+       (mapcan (lambda (entry) 
+                 (when (pathname-match-p (pathname entry) pathname)
+                   (list entry)))
+               inferior-entries)
+       (mapcan (lambda (entry)
+                 (let* ((pathname (pathname entry))
+                        (directory (pathname-directory pathname))
+                        (rest-wild (cdr wild)))
+                   (unless (pathname-name pathname)
+                     (when (pathname-match-p (first (last directory))
+                                             (cond ((eql (car wild) :wild)
+                                                    "*")
+                                                   ((eql (car wild) :wild-inferiors)
+                                                    "*")
+                                                   (wild 
+                                                    (car wild))
+                                                   (t "")))
+                       (when (and 
+                              (not (or first-wild-inferior 
+                                       wild-inferiors-found)) 
+                              rest-wild)
+                         (setf directory (nconc directory rest-wild)))
+                       (let ((recurse (make-pathname :directory directory
+                                                     :defaults newpath)))
+                         (when (not (equal recurse newpath))
+                           (list-directories-with-wildcards
+                            recurse
+                            (or first-wild-inferior wild-inferiors-found)
+                            resolve-symlinks)))))))
+                     entries)))))
 
 (defun directory (pathspec &key (resolve-symlinks nil))
-  "Determines which, if any, files that are present in the file system have names matching PATHSPEC, and returns
-a fresh list of pathnames corresponding to the potential truenames of those files.  
+  "Determines which, if any, files that are present in the file system have names matching PATHSPEC, and returns a fresh list of pathnames corresponding to the potential truenames of those files.  
 
 With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may
@@ -141 +135 @@
                           (pathname-match-p (file-namestring (pathname-as-file entry)) 
                                             (file-namestring pathname)))
-                         (pathname-match-p (or (file-namestring entry) "") (file-namestring pathname)))
+                         (pathname-match-p (or (file-namestring entry) "") 
+                                           (file-namestring pathname)))
                       (push 
                        (if resolve-symlinks
                            (truename entry) 
-                           entry)
+                           ;; Normalize nil DEVICE to :UNSPECIFIC under non-Windows
+                           ;; fixes ANSI DIRECTORY.[67]
+                           (if (and (not (find :windows *features*))
+                                    (not (pathname-device entry)))
+                               (make-pathname :defaults entry :device :unspecific)
+                               entry))
                        matching-entries)))
                   matching-entries))))

trunk/abcl/test/src/org/armedbear/lisp/PathnameTest.java

@@ -102 +102 @@
       assertTrue(s.equals("jar:file:/a/b/c/foo.jar!/bar.abcl"));
   }
+  @Test 
+  public void constructorFileDirectory() {
+    Pathname p = new Pathname("file://tmp/");
+    assertTrue(p.getNamestring().endsWith("/"));
+  }
+  @Test 
+    public void constructorFileWindowsDevice() {
+    Pathname p = new Pathname("file:c://tmp/");
+    LispObject device = p.getDevice();
+    if (Utilities.isPlatformWindows) {
+      assert(device != Lisp.NIL);
+    }
+  }
 }