Changeset 14624


Ignore:
Timestamp:
02/06/14 14:28:50 (7 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:
4 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/doc/design/pathnames/merging-defaults.markdown

    r14174 r14624  
    100100resolving a path to a plain file.
    101101
     102
     103### DIRECTORY sets DEVICE to :UNSPECIFIC
     104
     105When the default for the :RESOLVE-SYMLINKS argument to DIRECTORY was
     106changed to nil, DIRECTORY was changed not to always resolve its
     107results via TRUENAME.  As a result
     108
     109    (equal (truename "~/.emacs")
     110           (first (directory "~/.emacs")) )
     111
     112forms would return nil.  This is a bit counter to expectations set by
     113CLHS that DIRECTORY "returns a list of pathnames corresponding to the
     114truenames".  In particular, this breaks the ANSI CL DIRECTORY.[67]
     115tests.  Thus, under non-Windows we now explicitly normalize DEVICE
     116components which are nil to :UNSPECIFIC for the results of DIRECTORY
     117calls.
     118
    102119### Use an implicit type for merging
    103120
     
    105122is a JAR-PATHNAME and the following conditions hold:
    106123
    107 1.  HOST and DEVICE of the PATHNAME are NIL
     124    1.  HOST and DEVICE of the PATHNAME are NIL
    108125
    109 2.  The DIRECTORY of the PATHNAME represents an absolute path.
     126    2.  The DIRECTORY of the PATHNAME represents an absolute path.
    110127
    111 3.  We are not on Windows.
     128    3.  We are not running under Windows.
    112129
    113130we set the DEVICE to be :UNSPECIFIC.
     
    117134Mark <evenson@panix.com>
    118135Created:  01-SEP-2012
    119 Revised:  09-OCT-2012
     136Revised:  06-FEB-2014
    120137
  • trunk/abcl/src/org/armedbear/lisp/Pathname.java

    r14621 r14624  
    218218        init(url.toString());
    219219    }
     220   
     221    public Pathname(URI uri) {
     222        init(uri.toString());
     223    }
    220224
    221225    static final Symbol SCHEME = internKeyword("SCHEME");
     
    369373                URI uri = null;
    370374                try {
    371                     uri = url.toURI();
     375                    uri = new URI(s);
    372376                } catch (URISyntaxException ex) {
    373377                    error(new SimpleError("Improper URI syntax for "
     
    375379                                    + ": " + ex.toString()));
    376380                }
     381           
    377382                String uriPath = uri.getPath();
    378383                if (null == uriPath) {
    379             // We make an exception for forms like "file:z:/foo/path"
    380             uriPath = uri.getSchemeSpecificPart();
    381             if (uriPath == null || uriPath.equals("")) {
    382                error(new LispError("The URI has no path: " + uri));
    383                 }
     384          // Under Windows, deal with pathnames containing
     385          // devices expressed as "file:z:/foo/path"
     386          uriPath = uri.getSchemeSpecificPart();
     387          if (uriPath == null || uriPath.equals("")) {
     388                    error(new LispError("The URI has no path: " + uri));
     389                  }
    384390                }
    385391                final File file = new File(uriPath);
    386                 final Pathname p = new Pathname(file.getPath());
     392                String path = file.getPath();
     393                if (uri.toString().endsWith("/") && !path.endsWith("/")) {
     394                  path += "/";
     395                }
     396                final Pathname p = new Pathname(path);
    387397                this.host = p.host;
    388398                this.device = p.device;
     
    404414            String authority = uri.getAuthority();
    405415        if (authority == null) {
    406         authority = url.getAuthority();
    407         if (authority == null) {
    408             Debug.trace(MessageFormat.format("{0} has a null authority.",
    409                              url));
    410         }
    411         }
    412 
    413             host = NIL;
    414             host = host.push(SCHEME);
    415             host = host.push(new SimpleString(scheme));
     416          authority = url.getAuthority();
     417          if (authority == null) {
     418            Debug.trace(MessageFormat.format("{0} has a null authority.", url));
     419          }
     420        }
     421
     422        host = NIL;
     423        host = host.push(SCHEME);
     424        host = host.push(new SimpleString(scheme));
    416425
    417426        if (authority != null) {
    418         host = host.push(AUTHORITY);
    419         host = host.push(new SimpleString(authority));
    420         }
    421 
    422             device = NIL;
     427          host = host.push(AUTHORITY);
     428          host = host.push(new SimpleString(authority));
     429        }
     430
     431        device = NIL;
    423432           
    424             // URI encode necessary characters
    425             String path = uri.getRawPath();
    426             if (path == null) {
    427                 path = "";
    428             }
    429             String query = uri.getRawQuery();
    430             if (query != null) {
    431                 host = host.push(QUERY);
     433        // URI encode necessary characters
     434        String path = uri.getRawPath();
     435        if (path == null) {
     436          path = "";
     437        }
     438        String query = uri.getRawQuery();
     439        if (query != null) {
     440          host = host.push(QUERY);
    432441                host = host.push(new SimpleString(query));
    433442            }
     
    16491658                            }
    16501659                            URI pathURI = (new File(path)).toURI();
    1651                             p = new Pathname(pathURI.toString());
     1660                            p = new Pathname(pathURI);
    16521661                            result = new Cons(p, result);
    16531662                        }
    16541663                    } catch (IOException e) {
    1655                         return error(new FileError("Unable to list directory " + pathname.princToString() + ".",
     1664                        return error(new FileError("Unable to list directory "
     1665                                                   + pathname.princToString() + ".",
    16561666                                                   pathname));
    16571667                    } catch (SecurityException e) {
  • trunk/abcl/src/org/armedbear/lisp/directory.lisp

    r14621 r14624  
    6262                                 :name nil :type nil :defaults pathname))
    6363         (entries (list-directory newpath resolve-symlinks)))
    64     (if (not (or wild wild-inferiors-found))
    65         entries
    66         (let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
    67           (nconc
    68            (mapcan (lambda (entry)
    69                      (when (pathname-match-p (pathname entry) pathname)
    70                        (list entry)))
    71                    inferior-entries)
    72            (mapcan (lambda (entry)
    73                      (let* ((pathname (pathname entry))
    74                             (directory (pathname-directory pathname))
    75                             (rest-wild (cdr wild)))
    76                        (unless (pathname-name pathname)
    77                          (when (pathname-match-p (first (last directory))
    78                                     (cond ((eql (car wild) :wild)
    79                                            "*")
    80                                           ((eql (car wild) :wild-inferiors)
    81                                            "*")
    82                                           (wild
    83                                            (car wild))
    84                                           (t "")))
    85                            (when (and
    86                                   (not (or first-wild-inferior
    87                                            wild-inferiors-found))
    88                                   rest-wild)
    89                              (setf directory (nconc directory rest-wild)))
    90                            (let ((recurse (make-pathname :directory directory
    91                                                   :defaults newpath)))
    92                              (when (not (equal recurse newpath))
    93                                (list-directories-with-wildcards
    94                                 recurse
    95                                 (or first-wild-inferior wild-inferiors-found)
    96                                 resolve-symlinks)))))))
    97                    entries))))))
    98 
    99 ;;; XXX Kludge for compatibilty:  hope no one uses.
    100 (defun directory-old (pathspec &key (resolve-symlinks t))
    101   (warn "Deprecated:  Please use CL:DIRECTORY which has a NIL default for :RESOLVE-SYMLINKS.")
    102   (directory pathspec :resolve-symlinks resolve-symlinks))
     64    (when (not (or wild wild-inferiors-found)) ;; no further recursion necessary
     65        (return-from list-directories-with-wildcards entries))
     66    (let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
     67      (nconc
     68       (mapcan (lambda (entry)
     69                 (when (pathname-match-p (pathname entry) pathname)
     70                   (list entry)))
     71               inferior-entries)
     72       (mapcan (lambda (entry)
     73                 (let* ((pathname (pathname entry))
     74                        (directory (pathname-directory pathname))
     75                        (rest-wild (cdr wild)))
     76                   (unless (pathname-name pathname)
     77                     (when (pathname-match-p (first (last directory))
     78                                             (cond ((eql (car wild) :wild)
     79                                                    "*")
     80                                                   ((eql (car wild) :wild-inferiors)
     81                                                    "*")
     82                                                   (wild
     83                                                    (car wild))
     84                                                   (t "")))
     85                       (when (and
     86                              (not (or first-wild-inferior
     87                                       wild-inferiors-found))
     88                              rest-wild)
     89                         (setf directory (nconc directory rest-wild)))
     90                       (let ((recurse (make-pathname :directory directory
     91                                                     :defaults newpath)))
     92                         (when (not (equal recurse newpath))
     93                           (list-directories-with-wildcards
     94                            recurse
     95                            (or first-wild-inferior wild-inferiors-found)
     96                            resolve-symlinks)))))))
     97                     entries)))))
    10398
    10499(defun directory (pathspec &key (resolve-symlinks nil))
    105   "Determines which, if any, files that are present in the file system have names matching PATHSPEC, and returns
    106 a fresh list of pathnames corresponding to the potential truenames of those files. 
     100  "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. 
    107101
    108102With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may
     
    141135                          (pathname-match-p (file-namestring (pathname-as-file entry))
    142136                                            (file-namestring pathname)))
    143                          (pathname-match-p (or (file-namestring entry) "") (file-namestring pathname)))
     137                         (pathname-match-p (or (file-namestring entry) "")
     138                                           (file-namestring pathname)))
    144139                      (push
    145140                       (if resolve-symlinks
    146141                           (truename entry)
    147                            entry)
     142                           ;; Normalize nil DEVICE to :UNSPECIFIC under non-Windows
     143                           ;; fixes ANSI DIRECTORY.[67]
     144                           (if (and (not (find :windows *features*))
     145                                    (not (pathname-device entry)))
     146                               (make-pathname :defaults entry :device :unspecific)
     147                               entry))
    148148                       matching-entries)))
    149149                  matching-entries))))
  • trunk/abcl/test/src/org/armedbear/lisp/PathnameTest.java

    r12424 r14624  
    102102      assertTrue(s.equals("jar:file:/a/b/c/foo.jar!/bar.abcl"));
    103103  }
     104  @Test
     105  public void constructorFileDirectory() {
     106    Pathname p = new Pathname("file://tmp/");
     107    assertTrue(p.getNamestring().endsWith("/"));
     108  }
     109  @Test
     110    public void constructorFileWindowsDevice() {
     111    Pathname p = new Pathname("file:c://tmp/");
     112    LispObject device = p.getDevice();
     113    if (Utilities.isPlatformWindows) {
     114      assert(device != Lisp.NIL);
     115    }
     116  }
    104117}
Note: See TracChangeset for help on using the changeset viewer.