[elpa] externals/compat 92121f5934 03/10: Fix file-name-concat

[ELPA Syncer]

branch: externals/compat
commit 92121f59348c8a6321d87bbefa2e4bb4517f14c2
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    Fix file-name-concat
---
 NEWS.org        | 21 +++++++++++----------
 compat-28.el    | 23 +++++++++++++----------
 compat-tests.el | 17 +++++++++++++++++
 3 files changed, 41 insertions(+), 20 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index 69de87c678..9d0ae881e2 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -3,9 +3,10 @@
 * Development
 
 - Add multiple new tests for existing APIs.
-- Bug fix for the ~setq-local~ compatibility macro
-- Bug fix for the ~proper-list-p~ compatibility function
-- Bug fix for the ~prop-match-p~ compatibility function
+- Fix the ~setq-local~ compatibility macro.
+- Fix the ~proper-list-p~ compatibility function.
+- Fix the ~prop-match-p~ compatibility function.
+- Fix the ~file-name-concat~ compatibility function.
 - Add new Emacs 29 APIs. Most of these are still untested and may change. If 
you
   intend to use an API please be extra careful and if possible contribute test
   cases. All untested functions are marked as ~<UNTESTED>~ in the Compat
@@ -14,15 +15,15 @@
   functions. Since Compat avoids overwriting already existing functions, we 
must
   define separate compatibility function definitions for functions which 
changed
   their calling convention. These compatibility definitions can be looked up
-  using ~compat-function~ and called with ~compat-call~. For example ~(assoc 
KEY
-  ALIST &optional TESTFN)~ can be called with a ~TESTFN~ since Emacs 29. In 
Emacs
-  28 and older the calling convention was ~(assoc KEY ALIST)~. In order to use 
the
-  new calling convention you can use ~(compat-call assoc KEY ALIST)~.
+  using ~compat-function~ and called with ~compat-call~. For example ~assoc~ 
can be
+  called with a ~TESTFN~ since Emacs 29. In Emacs 28 and older the calling
+  convention was ~(assoc KEY ALIST)~. In order to use the new calling 
convention
+  you can use ~(compat-call assoc KEY ALIST TESTFN)~.
 - Deprecate all ~compat-*~ prefixed functions. Instead use the aforementioned
   ~compat-call~ or ~compat-function~ macros.
-- Deprecate ~compat-help.el~ and ~compat-font-lock.el~
-- Development moved to GitHub
-- BREAKING: Drop broken function ~func-arity~
+- Deprecate ~compat-help.el~ and ~compat-font-lock.el.~
+- Development moved to GitHub.
+- BREAKING: Drop broken function ~func-arity~.
 - BREAKING: Drop support for Emacs 24.3. Emacs 24.4 is required now.
 
 * Release of "Compat" Version 28.1.2.2
diff --git a/compat-28.el b/compat-28.el
index b60720c4cc..a799972b22 100644
--- a/compat-28.el
+++ b/compat-28.el
@@ -85,23 +85,26 @@ issues are inherited."
 
 ;;;; Defined in fileio.c
 
-(compat-defun file-name-concat (directory &rest components) ;; <UNTESTED>
+(compat-defun file-name-concat (directory &rest components) ;; <OK>
   "Append COMPONENTS to DIRECTORY and return the resulting string.
 Elements in COMPONENTS must be a string or nil.
 DIRECTORY or the non-final elements in COMPONENTS may or may not end
 with a slash -- if they don’t end with a slash, a slash will be
 inserted before contatenating."
-  (let ((seperator (eval-when-compile
+  (let ((separator (eval-when-compile
                      (if (memq system-type '(ms-dos windows-nt cygwin))
                          "\\" "/")))
-        (last (if components (car (last components)) directory)))
-    (mapconcat (lambda (part)
-                 (if (eq part last)    ;the last component is not modified
-                     last
-                   (replace-regexp-in-string
-                    (concat seperator "+\\'") "" part)))
-               (cons directory components)
-               seperator)))
+        (components (delq nil
+                          (mapcar (lambda (x) (and (not (equal "" x)) x))
+                                  (cons directory components))))
+        (result ""))
+    (while components
+      (let ((c (pop components)))
+        (setq result (concat result c
+                             (and components
+                                  (not (string-suffix-p separator c))
+                                  separator)))))
+    result))
 
 ;;;; Defined in alloc.c
 
diff --git a/compat-tests.el b/compat-tests.el
index 64ce5eaf5e..f7b7aef24e 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -569,6 +569,23 @@
   (should-equal "/:a" (compat-call file-name-quote "/:a"))
   (should-equal (concat "/ssh:" (system-name) ":/:a") (compat-call 
file-name-quote "/ssh::a")))
 
+(ert-deftest file-name-concat ()
+  (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+  (should (equal (file-name-concat "foo" "bar") "foo/bar"))
+  (should (equal (file-name-concat "foo" "bar" "zot") "foo/bar/zot"))
+  (should (equal (file-name-concat "foo/" "bar") "foo/bar"))
+  (should (equal (file-name-concat "foo//" "bar") "foo//bar"))
+  (should (equal (file-name-concat "foo/" "bar/" "zot") "foo/bar/zot"))
+  (should (equal (file-name-concat "fóo" "bar") "fóo/bar"))
+  (should (equal (file-name-concat "foo" "bár") "foo/bár"))
+  (should (equal (file-name-concat "fóo" "bár") "fóo/bár"))
+  (should (equal (file-name-concat "foo") "foo"))
+  (should (equal (file-name-concat "foo/") "foo/"))
+  (should (equal (file-name-concat "foo" "") "foo"))
+  (should (equal (file-name-concat "foo" "" "" "" nil) "foo"))
+  (should (equal (file-name-concat "" "bar") "bar"))
+  (should (equal (file-name-concat "" "") "")))
+
 (ert-deftest file-name-with-extension ()
   (should-equal "file.ext" (file-name-with-extension "file" "ext"))
   (should-equal "file.ext" (file-name-with-extension "file" ".ext"))