Changeset 15587 for trunk/abcl/src/org/armedbear

Timestamp:

05/23/22 06:23:44 (16 months ago)

Author:

Mark Evenson

Message:

Pathname directory wasn't handling . or .. in certain cases

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• Pathname.java (modified) (1 diff)
• directory.lisp (modified) (2 diffs)

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

@@ -297 +297 @@
       return result;
     } 
+    if (s.startsWith("./"))
+      { s = s.substring(2); }
     if (s.equals("..") || s.equals("../")) {
       result.setDirectory(list(Keyword.RELATIVE, Keyword.UP));

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

@@ -124 +124 @@
 
   (let ((pathname (merge-pathnames pathspec)))
+    (when (equalp (pathname-host pathname) '(:scheme "file"))
+      (setq pathname (subseq (namestring pathname) #.(length "file://"))))
     (when (logical-pathname-p pathname)
       (setq pathname (translate-logical-pathname pathname)))
@@ -144 +146 @@
                 (let ((entries (list-directories-with-wildcards 
                                 namestring nil resolve-symlinks))
-                      matching-entries)
-                  (dolist (entry entries)
-                    (when
-                        (or
-                         (and 
-                          (file-directory-p entry :wild-error-p nil)
-                          (pathname-match-p
-                           (directory-as-file entry) pathname))
-                         (pathname-match-p entry pathname))
-                      (push 
-                       (if resolve-symlinks
-                           (truename 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))))
+                      (matching-entries nil))
+      (flet ((no-dots (path)
+         (merge-pathnames
+          (make-pathname :directory 
+             (let ((reversed nil))
+               (dolist (el (pathname-directory path))
+                 (if (eq el :up) 
+               (pop reversed)
+               (unless (equal el ".")
+                 (push el reversed))))
+               (reverse reversed)))
+          path)))
+        (let ((pathname (no-dots pathname)))
+          (dolist (entry entries)
+      (when
+          (or
+           (and 
+            (file-directory-p entry :wild-error-p nil)
+            (pathname-match-p
+             (directory-as-file entry) pathname))
+           (pathname-match-p entry pathname))
+        (push 
+         (if resolve-symlinks
+             (truename 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))))
         ;; Not wild.
         (let ((truename (probe-file pathname)))