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)))) ) ))