Changeset 12417


Ignore:
Timestamp:
02/04/10 09:42:16 (12 years ago)
Author:
Mark Evenson
Message:

Fix TRANSLATE-LOGICAL-PATHNAME regression.

Problem and solution found by Alan Ruttenburg.

Closes ticket:83.

Location:
trunk/abcl
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/pathnames.lisp

    r12284 r12417  
    204204          (not (member (car to) '(:wild :wild-inferiors))))
    205205     (cons (casify (car to) case)
    206            (translate-directory-components-aux src from (cdr to) case)))
     206           (translate-directory-components-aux
     207            src from (cdr to) case)))
     208    ((and (not src)
     209          (eq (car from) :wild-inferiors)
     210          (eq (car to) :wild-inferiors))
     211     (translate-directory-components-aux src (cdr from) (cdr to) case))
    207212    ((not (and src from))
    208213     ;; both are NIL --> TO is a wildcard which can't be matched
     
    225230       (catch 'failed-match
    226231         (return-from translate-directory-components-aux
    227            (append (reverse match) (translate-directory-components-aux
    228                                         src (cdr from) (cdr to) case))))
     232           (append (reverse match)
     233                   (translate-directory-components-aux
     234                    src (cdr from) (cdr to) case))))
    229235       (when (null src) ;; SRC is NIL and we're still here: error exit
    230236         (throw 'failed-match))))))
  • trunk/abcl/test/lisp/abcl/bugs.lisp

    r12406 r12417  
    44;;; testsuite so they remain fixed.
    55
    6 (deftest bugs.translate-logical-pathname
     6(deftest bugs.logical-pathname.1
    77    #|
    8     Date: Mon, 18 Jan 2010 10:51:07 -0500
    9     Message-ID: <29af5e2d1001180751l7cf79a3ay929cef1deb9ed063@mail.gmail.com>
    10     Subject: Re: [armedbear-devel] translate-logical-pathname and :wild-inferiors
    11     regression
    12     From: Alan Ruttenberg <alanruttenberg@gmail.com>
     8Date: Mon, 18 Jan 2010 10:51:07 -0500
     9Message-ID: <29af5e2d1001180751l7cf79a3ay929cef1deb9ed063@mail.gmail.com>
     10Subject: Re: [armedbear-devel] translate-logical-pathname and :wild-inferiors
     11regression
     12From: Alan Ruttenberg <alanruttenberg@gmail.com>
    1313    |#
    1414    (progn
    1515      (setf (logical-pathname-translations "ido")
    16             '((#P"IDO:IDO-CORE;**;*.*"
    17                #P"/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/ido-core/**/*.*")
    18               (#P"IDO:IMMUNOLOGY;**;*.*"
    19                #P"/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/immunology/**/*.*")
    20               (#P"IDO:TOOLS;**;*.*"
    21                #P"/Users/alanr/repos/infectious-disease-ontology/trunk/src/tools/**/*.*")
    22               (#P"IDO:LIB;**;*.*"
    23                #P"/Users/alanr/repos/infectious-disease-ontology/trunk/lib/**/*.*")))
    24       (translate-pathname #P"IDO:IMMUNOLOGY;" #P"IDO:IMMUNOLOGY;**;*.*"
    25                           #P"/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/**/*.*"))
    26   #P"/users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/immunology/")
     16            '(("IDO:IDO-CORE;**;*.*"
     17               "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/ido-core/**/*.*")
     18              ("IDO:IMMUNOLOGY;**;*.*"
     19               "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/immunology/**/*.*")
     20              ("IDO:TOOLS;**;*.*"
     21               "/Users/alanr/repos/infectious-disease-ontology/trunk/src/tools/**/*.*")
     22              ("IDO:LIB;**;*.*"
     23               "/Users/alanr/repos/infectious-disease-ontology/trunk/lib/**/*.*")))
     24      (translate-pathname "IDO:IMMUNOLOGY;" "IDO:IMMUNOLOGY;**;*.*"
     25                          "/Users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/**/*.*"))
     26  #P"/users/alanr/repos/infectious-disease-ontology/trunk/src/ontology/")
     27
     28(deftest bugs.logical.pathname.2
     29    #|
     30Message-Id: <BBE9D0E5-5166-4D24-9A8A-DC4E766976D1@ISI.EDU>
     31From: Thomas Russ <tar@ISI.EDU>
     32To: armedbear-devel@common-lisp.net
     33Subject: [armedbear-devel] Bug in translate-logical-pathname.
     34    |#
     35    (progn
     36      (setf (logical-pathname-translations "L")
     37            '(("L:NATIVE;**;*.*" "/usr/lisp/abcl/native/**/*.*")))
     38      (translate-logical-pathname "L:NATIVE;TEST;FOO.FASL"))
     39  #p"/usr/lisp/abcl/native/test/foo.fasl")
     40
     41     
Note: See TracChangeset for help on using the changeset viewer.