[armedbear-cvs] r12552 - trunk/abcl/src/org/armedbear/lisp

[Mark Evenson]

Author: mevenson
Date: Tue Mar 16 17:02:54 2010
New Revision: 12552

Log:
Refine TRANSLATE-PATHNAME to match SBCL's behavior on corner case.

This patch allows

    (TRANSLATE-PATHNAME
       #P"/Users/evenson/work/bordeaux-threads/src/bordeaux-threads.abcl"
       #P"/**/**/*.*"
       #P"/Users/evenson/.cache/common-lisp/armedbear-0.20.0-dev-darwin-unknown/**/*.*")

to return

    #P"/Users/evenson/.cache/common-lisp/armedbear-0.20.0-dev-darwin-unknown/bordeaux-threads.abcl"

which matches SBCL' behavior, and seems reasonable that if there is no
more of SRC or TO left to match and FROM has a :WILD-INFERIORS, one
might as well return what has matched so far.



Modified:
   trunk/abcl/src/org/armedbear/lisp/pathnames.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/pathnames.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/pathnames.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/pathnames.lisp	Tue Mar 16 17:02:54 2010
@@ -232,6 +232,10 @@
            (append (reverse match) 
                    (translate-directory-components-aux
                     src (cdr from) (cdr to) case))))
+       (when (and (null src) 
+                  (eq (car from) :wild-inferiors)
+                  (eq (car to) :wild-inferiors))
+         (return-from translate-directory-components-aux nil))
        (when (null src) ;; SRC is NIL and we're still here: error exit
          (throw 'failed-match))))))