Merge branch 'fix-78x' into develop

CHANGELOG

@@ -29,6 +29,9 @@
 
 * Pending changes since 24.5.10
 
+- Logical pathnames with multiple wild directories are now correctly
+  translated. Previously using them resulted in an infinite recursion
+
 - Process initial bindings, when specified, are inherited when the process
   is enabled (previously they were copied when the process was created)
 

src/c/pathname.d

@@ -1565,28 +1565,46 @@ coerce_to_from_pathname(cl_object x, cl_object host)
   @(return set);
 @)
 
+/* This function matches a single component SOURCE against a single component
+   MATCH. The result is expected to be a list that contains all matches. It is a
+   list accomodate partial wildcards inside the MATCH component. For example:
+
+       ("foo" "bar") -> :error
+       ("foo" "foo") -> ()
+       ("f*o" "fo") ->  ("")
+       ("f*o" "foo") ->  ("o")
+       ("f*b*q*" "foobarqux") -> ("oo" "ar" "ux")
+       ("whatev" :wild) -> ("whatev")
+
+   At least that seems to be the purpose from careful reading. -- jd 2025-06-26
+*/
 static cl_object
-find_wilds(cl_object l, cl_object source, cl_object match)
+find_wilds(cl_object source, cl_object match)
 {
+  cl_object result = ECL_NIL;
   cl_index i, j, k, ls, lm;
 
   if (match == @':wild')
     return ecl_list1(source);
   if (!ecl_stringp(match) || !ecl_stringp(source)) {
+    /* i.e :ABSOLUTE vs :ABSOLUTE */
     if (match != source)
       return @':error';
-    return l;
+    return ECL_NIL;
   }
   ls = ecl_length(source);
   lm = ecl_length(match);
   for(i = j = 0; i < ls && j < lm; ) {
     cl_index pattern_char = ecl_char(match,j);
     if (pattern_char == '*') {
-      for (j++, k = i;
+      /* Find the shortest match to the next character. */
+      pattern_char = ecl_char(match,++j);
+      /* k = (position pattern_char source :start i) */
+      for (k = i;
            k < ls && ecl_char(source,k) != pattern_char;
            k++)
         ;
-      l = CONS(make_one(source, i, k), l);
+      result = CONS(make_one(source, i, k), result);
       i = k;
       continue;
     }
@@ -1596,7 +1614,7 @@ find_wilds(cl_object l, cl_object source, cl_object match)
   }
   if (i < ls || j < lm)
     return @':error';
-  return l;
+  return result;
 }
 
 static cl_object
@@ -1622,8 +1640,8 @@ find_list_wilds(cl_object a, cl_object mask)
       if (item_mask != @':absolute' && item_mask != @':relative')
         return @':error';
     } else {
-      l2 = find_wilds(l, CAR(a), item_mask);
-      if (l == @':error')
+      l2 = find_wilds(CAR(a), item_mask);
+      if (l2 == @':error')
         return @':error';
       if (!Null(l2))
         l = CONS(l2, l);
@@ -1644,9 +1662,16 @@ copy_wildcards(cl_object *wilds_list, cl_object pattern)
     if (ecl_endp(wilds))
       return @':error';
     pattern = CAR(wilds);
+    if(CONSP(pattern)) {
+      /* find_wilds constructs a list with one element */
+      if(!Null(CDR(pattern)))
+        return @':error';
+      pattern = CAR(pattern);
+    }
     *wilds_list = CDR(wilds);
     return pattern;
   }
+
   if (pattern == @':wild-inferiors')
     return @':error';
   if (!ecl_stringp(pattern))
@@ -1684,8 +1709,7 @@ copy_wildcards(cl_object *wilds_list, cl_object pattern)
 static cl_object
 copy_list_wildcards(cl_object *wilds, cl_object to)
 {
-  cl_object l = ECL_NIL;
-
+  cl_object result = ECL_NIL;
   while (!ecl_endp(to)) {
     cl_object d, mask = CAR(to);
     if (mask == @':wild-inferiors') {
@@ -1695,22 +1719,22 @@ copy_list_wildcards(cl_object *wilds, cl_object to)
       else {
         cl_object dirlist = CAR(list);
         if (CONSP(dirlist))
-          l = ecl_append(CAR(list), l);
-        else if (!Null(CAR(list)))
+          result = ecl_append(dirlist, result);
+        else if (!Null(dirlist))
           return @':error';
       }
       *wilds = CDR(list);
     } else {
-      d = copy_wildcards(wilds, CAR(to));
+      d = copy_wildcards(wilds, mask);
       if (d == @':error')
         return d;
-      l = CONS(d, l);
+      result = CONS(d, result);
     }
     to = CDR(to);
   }
-  if (CONSP(l))
-    l = @nreverse(l);
-  return l;
+  if (CONSP(result))
+    result = @nreverse(result);
+  return result;
 }
 
 @(defun translate-pathname (source from to &key)
@@ -1754,7 +1778,7 @@ copy_list_wildcards(cl_object *wilds, cl_object to)
   directory = d;
 
   /* Match name */
-  wilds = find_wilds(ECL_NIL, source->pathname.name, from->pathname.name);
+  wilds = find_wilds(source->pathname.name, from->pathname.name);
   if (wilds == @':error') goto error2;
   if (Null(to->pathname.name)) {
     d = translate_component_case(source->pathname.name, fromcase, tocase);
@@ -1767,7 +1791,7 @@ copy_list_wildcards(cl_object *wilds, cl_object to)
   name = d;
 
   /* Match type */
-  wilds = find_wilds(ECL_NIL, source->pathname.type, from->pathname.type);
+  wilds = find_wilds(source->pathname.type, from->pathname.type);
   if (wilds == @':error') goto error2;
   if (Null(to->pathname.type)) {
     d = translate_component_case(source->pathname.type, fromcase, tocase);

src/tests/normal-tests/mixed.lsp

@@ -632,3 +632,26 @@
                  (ntimes 2048 (apply #'append (make-list 2048 :initial-element '(:foo))))
                  (is (typep n 'number)))))
       (invoke-test-case))))
+
+;;; Reported by: Artyom Bologov
+;;; Created: 2025-06-26
+;;; Issue: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/784
+;;; Description
+;;;
+;;;     When working with multiple wild components in the directory we've
+;;;     entered an infinite recursion becaue find_list_wildcards created a
+;;;     circular list due to invalid interfacing with find_wildcards.
+;;;
+;;;     Moreover, for a similar cause, we didn't translate correctly such
+;;;     pathnames even after fixing the issue. copy_wildcards did not anticipate
+;;;     that for a :WILD component the result could a list from find_wildcards.
+(deftest mix.0032.logical-pathname-with-multiple-wildcards ()
+  (setf (logical-pathname-translations "x")
+        `(("X:a;*;b;*;*.*" "/hello/*/hi/*/what/*.*")))
+  ;; We don't use #P"x:a;bonjour;b;barev;greetings.me" because then the reader
+  ;; constructs the pathname before the logical pathname translation is defined
+  ;; - in that case it is not recognized as logical and won't be translated.
+  (let* ((pathname (parse-namestring "x:a;bonjour;b;barev;greetings.me"))
+         (result (translate-logical-pathname pathname))
+         (expect #P"/hello/bonjour/hi/barev/what/greetings.me"))
+    (is (equalp result expect))))