emacs/test/lisp/arc-mode-tests.el

;;; arc-mode-tests.el --- Test suite for arc-mode. -*- lexical-binding: t -*-

;; Copyright (C) 2017-2024 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Code:
(require 'ert)
(require 'arc-mode)

(defvar arc-mode-tests-data-directory
  (expand-file-name "test/data/decompress" source-directory))

(ert-deftest arc-mode-test-archive-int-to-mode ()
  (let ((alist (list (cons 448 "-rwx------")
                     (cons 420 "-rw-r--r--")
                     (cons 292 "-r--r--r--")
                     (cons 512 "---------T")
                     (cons 1024 "------S---") ; Bug#28092
                     (cons 2048 "---S------"))))
    (dolist (x alist)
      (should (equal (cdr x) (file-modes-number-to-symbolic (car x)))))))

(ert-deftest arc-mode-test-zip-extract-gz ()
  (skip-unless (and archive-zip-extract (executable-find (car archive-zip-extract))))
  (skip-unless (executable-find "gzip"))
  (let* ((zip-file (expand-file-name "zg.zip" arc-mode-tests-data-directory))
         zip-buffer gz-buffer)
    (unwind-protect
        (with-current-buffer (setq zip-buffer (find-file-noselect zip-file))
          (setq gz-buffer (archive-extract))
          (should (equal (char-after) ?\N{SNOWFLAKE})))
      (when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
      (when (buffer-live-p gz-buffer) (kill-buffer gz-buffer)))))

(ert-deftest arc-mode-test-zip-ensure-ext ()
  "Regression test for bug#61326."
  (skip-unless (executable-find "zip"))
  (let* ((default-directory arc-mode-tests-data-directory)
         (created-files nil)
         (base-zip-1 "base-1.zip")
         (base-zip-2 "base-2.zip")
         (content-1 '("1" "2"))
         (content-2 '("3" "4"))
         (make-file (lambda (name)
                      (push name created-files)
                      (with-temp-buffer
                        (insert name)
                        (write-file name))))
         (make-zip
          (lambda (zip files)
            (delete-file zip nil)
            (push zip created-files)
            (funcall (archive--act-files '("zip") files) zip)))
         (update-fn
          (lambda (zip-nonempty)
            (with-current-buffer (find-file-noselect zip-nonempty)
              (save-excursion
                (goto-char archive-file-list-start)
                (save-current-buffer
                  (archive-extract)
                  (save-excursion
                    (goto-char (point-max))
                    (insert ?a)
                    (save-buffer))
                  (kill-buffer (current-buffer)))
                (archive-extract)
                ;; [2] must be ?a; [3] must be (eobp)
                (should (eq (char-after 2) ?a))
                (should (eq (point-max) 3))))))
         (delete-fn
          (lambda (zip-nonempty)
            (with-current-buffer (find-file-noselect zip-nonempty)
              ;; mark delete and expunge first entry
              (save-excursion
                (goto-char archive-file-list-start)
                (should (length= archive-files 2))
                (archive-flag-deleted 1)
                (archive--expunge-maybe-force t)
                (should (length= archive-files 1))))))
         (test-modify
          (lambda (zip mod-fn)
            (let ((zip-base (concat zip ".zip"))
                  (tag (gensym)))
              (push zip created-files)
              (copy-file base-zip-1 zip t)
              (push zip-base created-files)
              (copy-file base-zip-2 zip-base t)
              (file-has-changed-p zip tag)
              (file-has-changed-p zip-base tag)
              (funcall mod-fn zip)
              (should-not (file-has-changed-p zip-base tag))
              (should (file-has-changed-p zip tag))))))
    (unwind-protect
        (progn
          ;; setup: make two zip files with different contents
          (mapc make-file (append content-1 content-2))
          (funcall make-zip base-zip-1 content-1)
          (funcall make-zip base-zip-2 content-2)

          ;; test 1: with "test-update" and "test-update.zip", update
          ;; "test-update": (1) ensure only "test-update" is modified, (2)
          ;; ensure the contents of the new member is expected.
          (funcall test-modify "test-update" update-fn)

          ;; test 2: with "test-delete" and "test-delete.zip", delete entry
          ;; from "test-delete": (1) ensure only "test-delete" is modified,
          ;; (2) ensure the file list is reduced as expected.
          (funcall test-modify "test-delete" delete-fn))

      ;; Clean up created files.
      (dolist (file created-files)
        (ignore-errors (delete-file file))))))

(provide 'arc-mode-tests)

;;; arc-mode-tests.el ends here