1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
;;; arc-mode-tests.el --- Test suite for arc-mode. -*- lexical-binding: t -*-
;; Copyright (C) 2017-2025 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)))))
(declare-function tar-extract "tar-mode")
(ert-deftest arc-mode-test-zip-extract-tar-and-gz ()
(skip-unless (and archive-zip-extract (executable-find (car archive-zip-extract))))
(skip-unless (executable-find "gzip"))
(require 'tar-mode)
(let* ((zip-file (expand-file-name "ztg.zip" arc-mode-tests-data-directory))
zip-buffer tar-buffer gz-buffer)
(unwind-protect
(with-current-buffer (setq zip-buffer (find-file-noselect zip-file))
(with-current-buffer (setq tar-buffer (archive-extract))
(setq gz-buffer (tar-extract))
(should (equal (char-after) ?\N{SNOWFLAKE}))))
(when (buffer-live-p zip-buffer) (kill-buffer zip-buffer))
(when (buffer-live-p tar-buffer) (kill-buffer tar-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
|
