[armedbear-devel] Bug in translate-logical-pathname.
logicmoo at gmail.com
logicmoo at gmail.com
Mon Nov 23 13:29:07 UTC 2009
Has this been fixed in trunk yet?
----- Original Message -----
From: "Thomas Russ" <tar at ISI.EDU>
To: <armedbear-devel at common-lisp.net>
Cc: "Thomas Russ" <tar at ISI.EDU>
Sent: Monday, November 16, 2009 12:14 PM
Subject: [armedbear-devel] Bug in translate-logical-pathname.
> There seems to be a bug in TRANSLATE-LOGICAL-PATHNAME when the logical
> pathname source includes constant elements in addition to wildcards.
>
> Here is an example that demonstrates the problem:
>
> CL-USER(1): (setf (logical-pathname-translations "L")
> '(("L:NATIVE;**;*.*" "/usr/lisp/abcl/native/**/*.*")))
>
> ((#P"L:NATIVE;**;*.*" #P"/usr/lisp/abcl/native/**/*.*"))
>
>
> CL-USER(2): (translate-logical-pathname "L:NATIVE;TEST;FOO.FASL")
>
> #P"/usr/lisp/abcl/native/native/test/foo.fasl"
>
> ;; ERROR. Should be #P"/usr/lisp/abcl/native/test/foo.fasl"
> ;;
> ;; With :wild-inferiors, the full directory path is copied instead of
> ;; just the part after the matching constant part. That results in
> ;; the "native" element appearing twice.
> ;;
>
> The problem seems to be in the file "abcl/src/org/armedbear/lisp/
> pathnames.lisp", in the function SYSTEM::TRANSLATE-DIRECTORY-COMPONENTS:
>
> (defun translate-directory-components (source from to case)
> (cond ((null to)
> nil
> )
> ((memq (car to) '(:absolute :relative))
> (cons (car to)
> (translate-directory-components (cdr source) (cdr
> from) (cdr to) case))
> )
> ((eq (car to) :wild)
> (if (eq (car from) :wild)
> ;; Grab the next chunk from SOURCE.
> (append (casify (car source) case)
> (translate-directory-components (cdr source)
> (cdr from) (cdr to) case))
> (error "Unsupported case 1: ~S ~S ~S" source from to))
> )
> ((eq (car to) :wild-inferiors)
> ;; Grab the next chunk from SOURCE.
> (append (casify (car source) case)
> (translate-directory-components (cdr source) (cdr
> from) (cdr to) case))
> )
> (t
> ;; "If the piece in TO-WILDCARD is present and not wild, it
> is copied
> ;; into the result."
> (append (casify (car to) case)
> (translate-directory-components source from (cdr to)
> case))
> )
> ))
>
> The final COND clause ("T") needs to be more sophisticated in what it
> does. If there are non-wildcard elements in the FROM, then it will
> need to eliminate the the common prefix between "source" and "from".
> In order to be a valid match, it I think it SHOULD be guaranteed that
> a non-wildcard "from" component is a leading subsequence or equal to
> "source" -- but I'm not fully familiar with the code, but a quick test
> seems to indicate that the following modified function covers at least
> the simpler cases of this issue. It adds a new clause checking
> for :WILD-INFERIORS in the FROM slot which performs the current
> function, and changes the T clause to properly manage the subsequence
> matching.
>
> (defun translate-directory-components (source from to case)
> (cond ((null to)
> nil
> )
> ((memq (car to) '(:absolute :relative))
> (cons (car to)
> (translate-directory-components (cdr source) (cdr
> from) (cdr to) case))
> )
> ((eq (car to) :wild)
> (if (eq (car from) :wild)
> ;; Grab the next chunk from SOURCE.
> (append (casify (car source) case)
> (translate-directory-components (cdr source)
> (cdr from) (cdr to) case))
> (error "Unsupported case 1: ~S ~S ~S" source from to))
> )
> ((eq (car to) :wild-inferiors)
> ;; Grab the next chunk from SOURCE.
> (append (casify (car source) case)
> (translate-directory-components (cdr source) (cdr
> from) (cdr to) case))
> )
> ((eq (car from) :wild-inferiors)
> ;; "If the piece in TO-WILDCARD is present and not wild, and
> the FROM item
> ;; doesn't contain any constants, then just copy TO to the result."
> (append (casify (car to) case)
> (translate-directory-components source from (cdr to)
> case)))
> (t
> ;; "If the piece in TO-WILDCARD is present and not wild,
> then FROM should
> ;; be a subsequence of SOURCE. The common subsequence
> needs to be removed
> ;; in the recursive call. Special case handling for a full
> match is
> ;; also needed."
> (let ((pos (mismatch (car source) (car from) :test #'string-
> equal)))
> (append (casify (car to) case)
> (if (null pos) ;; A full match, pop both source
> and from
> (translate-directory-components (cdr source)
> (cdr from) (cdr to) case)
> (translate-directory-components (cons (subseq
> (car source) pos) (cdr source)) (cdr from) (cdr to) case))))
> )
> ))
>
>
> _______________________________________________
> armedbear-devel mailing list
> armedbear-devel at common-lisp.net
> http://common-lisp.net/cgi-bin/mailman/listinfo/armedbear-devel
More information about the armedbear-devel
mailing list