Changeset 14619

Timestamp:

01/30/14 14:10:03 (10 years ago)

Author:

Mark Evenson

Message:

CL:DIRECTORY semantics for symbolic link resolution inverted and fixed.

The default for the :RESOLVE-SYMLINKS keyword to CL:DIRECTORY has
changed from T to nil, meaning that naked DIRECTORY calls should never
return an error for dangling symlinks.

Thanks to Marco Antoniotti, Alan Ruttenberg, and Alessio Stallo for
clarifying a reasonable position vis a vis ANSI.

Addresses <​http://abcl.org/trac/ticket/340>.

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Pathname.java (modified) (3 diffs)
• directory.lisp (modified) (2 diffs)

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

@@ -1565 +1565 @@
     private static final Primitive LIST_DIRECTORY = new pf_list_directory();
     @DocString(name="list-directory",
-               args="directory &optional (resolve-symlinks t)",
+               args="directory &optional (resolve-symlinks nil)",
                returns="pathnames",
                doc="Lists the contents of DIRECTORY, optionally resolving symbolic links.")
@@ -1577 +1577 @@
         }
         @Override
-        public LispObject execute(LispObject arg, LispObject arg2) {
+        public LispObject execute(LispObject arg, LispObject resolveSymlinks) {
             Pathname pathname = coerceToPathname(arg);
             if (pathname instanceof LogicalPathname) {
@@ -1642 +1642 @@
                             File file = files[i];
                             Pathname p;
-                            if (file.isDirectory()) {
-                                if (arg2 != NIL) {
-                                    p = Pathname.getDirectoryPathname(file);
-                                } else {
-                                    p = new Pathname(file.getAbsolutePath()); 
-                                }
-                            } else {
-                                if (arg2 != NIL) {
-                                    p = new Pathname(file.getCanonicalPath());
-                                } else {
-                                    p = new Pathname(file.getAbsolutePath());
-                                }
-                            }
+              String path;
+              if (resolveSymlinks == NIL) {
+                path = file.getAbsolutePath();
+              } else {
+                path = file.getCanonicalPath();
+              }
+              URI pathURI = (new File(path)).toURI();
+              p = new Pathname(pathURI.toString());
                             result = new Cons(p, result);
                         }

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

@@ -97 +97 @@
                    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))
 
-(defun directory (pathspec &key (resolve-symlinks t))
+(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.  
+
+With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may
+correspond to an existing file.  Symbolic links are considered to be
+be valid entries even if they do not currently have a valid file or
+directory as a target.  Therefore, subsequent CL:TRUENAME call on
+individual pathnames in the list may signal an error, i.e. the
+pathnames have been constructed as truenames, without calling the
+entire resolution routine of CL:TRUENAME.
+
+If called with :RESOLVE-SYMLINKS set to T, and any of the pathnames
+have truenames which do not exist, this routine will signal a file
+error to its caller."
+
   (let ((pathname (merge-pathnames pathspec)))
     (when (logical-pathname-p pathname)
@@ -116 +135 @@
                       (matching-entries ()))
                   (dolist (entry entries)
-                    (cond ((file-directory-p entry)
-                           (when (pathname-match-p (file-namestring (pathname-as-file entry)) (file-namestring pathname))
-                             (push (truename entry) matching-entries)))
-                          ((pathname-match-p (or (file-namestring entry) "") (file-namestring pathname))
-                           (push (truename entry) matching-entries))))
+          (when 
+            (or 
+             (and 
+              (file-directory-p entry)
+              (pathname-match-p (file-namestring (pathname-as-file entry)) 
+                      (file-namestring pathname)))
+             (pathname-match-p (or (file-namestring entry) "") (file-namestring pathname)))
+            (push 
+             (if resolve-symlinks
+               (truename entry) 
+               entry)
+             matching-entries)))
                   matching-entries))))
         ;; Not wild.