Combine archive-int-to-mode and tar-grind-file-modebug27952_combine-tar-grind-file-mode_archive-int-to-mode

Add a new function, file-modes-number-to-symbolic.
Make archive-int-to-mode and obsolete alias of it; use it
to define tar-grind-file-mode (Bug#27952).

* lisp/files.el (file-modes-number-to-symbolic): New defun.
* lisp/arc-mode.el (archive-int-to-mode): Make it an obsolete alias.
* lisp/tar-mode.el (tar-grind-file-mode):
Use file-modes-number-to-symbolic.

* test/lisp/arc-mode-tests.el (arc-mode-test-archive-int-to-mode)
* test/lisp/tar-mode-tests.el (tar-mode-test-tar-grind-file-mode):
Update test.

* test/lisp/files-tests.el (files-tests-file-modes-symbolic-to-number)
(files-tests-file-modes-number-to-symbolic): New tests.

* doc/lispref/files.texi (Changing Files): Document the new funtion.
* etc/NEWS (Lisp Changes in Emacs 28.1): Announce it.

3 files changed, 39 insertions, 2 deletions

diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el
index df658b98139..22ca7e2ec55 100644
--- a/test/lisp/arc-mode-tests.el
+++ b/test/lisp/arc-mode-tests.el
@@ -28,7 +28,7 @@
   (let ((alist (list (cons 448 "-rwx------")
                      (cons 420 "-rw-r--r--")
                      (cons 292 "-r--r--r--")
-                     (cons 512 "----------")
+                     (cons 512 "---------T")
                      (cons 1024 "------S---") ; Bug#28092
                      (cons 2048 "---S------"))))
     (dolist (x alist)
diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el
index 05d9ceebf1d..4b902fd82ae 100644
--- a/test/lisp/files-tests.el
+++ b/test/lisp/files-tests.el
@@ -1164,6 +1164,42 @@ works as expected if the default directory is quoted."
     (should-not (make-directory a/b t))
     (delete-directory dir 'recursive)))
 
+(ert-deftest files-tests-file-modes-symbolic-to-number ()
+  (let ((alist (list (cons "a=rwx" #o777)
+                     (cons "o=t" #o1000)
+                     (cons "o=xt" #o1001)
+                     (cons "o=tx" #o1001) ; Order doesn't matter.
+                     (cons "u=rwx,g=rx,o=rx" #o755)
+                     (cons "u=rwx,g=,o=" #o700)
+                     (cons "u=rwx" #o700) ; Empty permissions can be ignored.
+                     (cons "u=rw,g=r,o=r" #o644)
+                     (cons "u=rw,g=r,o=t" #o1640)
+                     (cons "u=rw,g=r,o=xt" #o1641)
+                     (cons "u=rwxs,g=rs,o=xt" #o7741)
+                     (cons "u=rws,g=rs,o=t" #o7640)
+                     (cons "u=rws,g=rs,o=r" #o6644)
+                     (cons "a=r" #o444)
+                     (cons "u=S" nil)
+                     (cons "u=T" nil)
+                     (cons "u=Z" nil))))
+    (dolist (x alist)
+      (if (cdr-safe x)
+          (should (equal (cdr x) (file-modes-symbolic-to-number (car x))))
+        (should-error (file-modes-symbolic-to-number (car x)))))))
+
+(ert-deftest files-tests-file-modes-number-to-symbolic ()
+  (let ((alist (list (cons #o755 "-rwxr-xr-x")
+                     (cons #o700 "-rwx------")
+                     (cons #o644 "-rw-r--r--")
+                     (cons #o1640 "-rw-r----T")
+                     (cons #o1641 "-rw-r----t")
+                     (cons #o7741 "-rwsr-S--t")
+                     (cons #o7640 "-rwSr-S--T")
+                     (cons #o6644 "-rwSr-Sr--")
+                     (cons #o444 "-r--r--r--"))))
+    (dolist (x alist)
+      (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))
+
 (ert-deftest files-tests-no-file-write-contents ()
   "Test that `write-contents-functions' permits saving a file.
 Usually `basic-save-buffer' will prompt for a file name if the
diff --git a/test/lisp/tar-mode-tests.el b/test/lisp/tar-mode-tests.el
index bc41b863da7..f05389df60f 100644
--- a/test/lisp/tar-mode-tests.el
+++ b/test/lisp/tar-mode-tests.el
@@ -29,7 +29,8 @@
                      (cons 420 "rw-r--r--")
                      (cons 292 "r--r--r--")
                      (cons 512 "--------T")
-                     (cons 1024 "-----S---"))))
+                     (cons 1024 "-----S---")
+                     (cons 2048 "--S------"))))
     (dolist (x alist)
       (should (equal (cdr x) (tar-grind-file-mode (car x)))))))