From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Ruijie Yu via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#61326: [PATCH v5] Work around zip's filename extension limitation (was: Adding --no-add-suffix to zip patch) Date: Thu, 20 Apr 2023 16:49:29 +0800 Message-ID: References: <87ilgeoc4w.fsf@tullinup.koldfront.dk> <8574C128-9560-490A-88E6-49E415BBDB24@netyu.xyz> <83k00up32i.fsf@gnu.org> <83bkm4nihw.fsf@gnu.org> <83zg8sahin.fsf@gnu.org> <83jzzwa6u3.fsf@gnu.org> <83h6uz8ac4.fsf@gnu.org> <834jqry8fn.fsf@gnu.org> <835y9r6lll.fsf@gnu.org> Reply-To: Ruijie Yu Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="34171"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: mu4e 1.9.22; emacs 30.0.50 Cc: asjo@koldfront.dk, 61326@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Apr 20 11:22:28 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1ppQUm-0008fr-5q for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 20 Apr 2023 11:22:28 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ppQTP-0007uc-KY; Thu, 20 Apr 2023 05:21:03 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ppQTO-0007u3-P5 for bug-gnu-emacs@gnu.org; Thu, 20 Apr 2023 05:21:02 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1ppQTO-0006zC-Gt for bug-gnu-emacs@gnu.org; Thu, 20 Apr 2023 05:21:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ppQTN-0003Vc-Sy for bug-gnu-emacs@gnu.org; Thu, 20 Apr 2023 05:21:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Ruijie Yu Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Thu, 20 Apr 2023 09:21:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 61326 X-GNU-PR-Package: emacs X-Debbugs-Original-Cc: asjo@koldfront.dk, bug-gnu-emacs@gnu.org, 61326@debbugs.gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.168198241613396 (code B ref -1); Thu, 20 Apr 2023 09:21:01 +0000 Original-Received: (at submit) by debbugs.gnu.org; 20 Apr 2023 09:20:16 +0000 Original-Received: from localhost ([127.0.0.1]:36563 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ppQSb-0003Tx-32 for submit@debbugs.gnu.org; Thu, 20 Apr 2023 05:20:16 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:57290) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ppQSX-0003Tk-AP for submit@debbugs.gnu.org; Thu, 20 Apr 2023 05:20:11 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ppQSV-0007VC-JH for bug-gnu-emacs@gnu.org; Thu, 20 Apr 2023 05:20:07 -0400 Original-Received: from netyu.xyz ([152.44.41.246] helo=mail.netyu.xyz) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1ppQSS-0006NG-0t; Thu, 20 Apr 2023 05:20:06 -0400 Original-Received: from fw.net.yu.netyu.xyz ( [222.248.4.98]) by netyu.xyz (OpenSMTPD) with ESMTPSA id d74cfd90 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Thu, 20 Apr 2023 09:20:00 +0000 (UTC) In-reply-to: <835y9r6lll.fsf@gnu.org> Received-SPF: pass client-ip=152.44.41.246; envelope-from=ruijie@netyu.xyz; helo=mail.netyu.xyz X-Spam_score_int: -18 X-Spam_score: -1.9 X-Spam_bar: - X-Spam_report: (-1.9 / 5.0 requ) BAYES_00=-1.9, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:260318 Archived-At: --=-=-= Content-Type: text/plain Eli Zaretskii writes: >> From: Ruijie Yu >> Cc: Eli Zaretskii , asjo@koldfront.dk, 61326@debbugs.gnu.org >> Date: Mon, 17 Apr 2023 16:48:13 +0800 >> >> >> Ruijie Yu writes: >> >> > New iteration. As mentioned from my last message, I have reverted the >> > part where I tried to rewrite part of `archive-expunge' using `cl-do'. >> > >> > FTR, I am still waiting for the counter signature from FSF before this >> > can be included into emacs.git. >> > >> >> Ping? >> >> Removing the "DRAFT" from subject, because I think it is probably >> complete. Also, my FSF process should now be complete. > > Great, then, with these two issues out of our way, we can install this > now. > > However, the patch as posted back then no longer applies. Please > rebase on the current master branch and re-post. > > Thanks. Thanks. I have made one change after the previous iteration: I turned the "bug#xxx" comment in the test/lisp/arc-mode-tests.el into a docstring. Also, interestingly, git-rebase finishes cleanly on my end. Here attached is a patch _without_ indentation changes. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Handle-modifications-on-extensionless-zips-correctly.patch Content-Description: Patch *without* indentation changes >From a98a530d7a7e73404c107e77c173d8981db811ce Mon Sep 17 00:00:00 2001 From: Ruijie Yu Date: Mon, 6 Mar 2023 11:03:32 +0800 Subject: [PATCH] Handle modifications on extensionless zips correctly (Bug#61326) * lisp/arc-mode.el (archive-*-write-file-member) (archive-*-expunge): Refactor to correctly modify extensionless zip archives. (archive-expunge): Move implementation to a separate helper function to facilitate testing. (archive--act-files): New helper function to wrap around `call-process' calls. (archive--need-rename-p): New helper function to check whether a temporary rename is necessary. (archive--ensure-extension) (archive--maybe-rename): New helper functions to rename archive if the caller deems it necessary. (archive--with-ensure-extension): New helper function to handle writing an archive while ensuring extensionless archives work correctly by temporarily renaming them. * test/lisp/arc-mode-tests.el (arc-mode-test-zip-ensure-ext): New regression test for bug#61326. --- lisp/arc-mode.el | 76 +++++++++++++++++++++++++++---------- test/lisp/arc-mode-tests.el | 67 ++++++++++++++++++++++++++++++++ 2 files changed, 123 insertions(+), 20 deletions(-) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 5e696c091b2..0a971799746 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -645,6 +645,49 @@ archive-get-descr (if (not noerror) (error "Line does not describe a member of the archive"))))) ;; ------------------------------------------------------------------------- +;;; Section: Helper functions for requiring filename extensions + +(defun archive--act-files (command files) + (lambda (archive) + (apply #'call-process (car command) + nil nil nil (append (cdr command) (cons archive files))))) + +(defun archive--need-rename-p (&optional archive) + (let ((archive + (file-name-nondirectory (or archive buffer-file-name)))) + (cl-case archive-subtype + ((zip) (not (seq-contains-p archive ?. #'eq)))))) + +(defun archive--ensure-extension (archive ensure-extension) + (if ensure-extension + (make-temp-name (expand-file-name (concat archive "_tmp."))) + archive)) + +(defun archive--maybe-rename (newname need-rename-p) + ;; Operating with archive as current buffer, and protect + ;; `default-directory' from being modified in `rename-visited-file'. + (when need-rename-p + (let ((default-directory default-directory)) + (rename-visited-file newname)))) + +(defun archive--with-ensure-extension (archive proc-fn) + (let ((saved default-directory)) + (with-current-buffer (find-buffer-visiting archive) + (let ((ensure-extension (archive--need-rename-p)) + (default-directory saved)) + (unwind-protect + ;; Some archive programs (like zip) expect filenames to + ;; have an extension, so if necessary, temporarily rename + ;; an extensionless file for write accesses. + (let ((archive (archive--ensure-extension + archive ensure-extension))) + (archive--maybe-rename archive ensure-extension) + (let ((exitcode (funcall proc-fn archive))) + (or (zerop exitcode) + (error "Updating was unsuccessful (%S)" exitcode)))) + (progn (archive--maybe-rename archive ensure-extension) + (revert-buffer nil t))))))) +;; ------------------------------------------------------------------------- ;;; Section: the mode definition ;;;###autoload @@ -1378,16 +1421,9 @@ archive-*-write-file-member (setq ename (encode-coding-string ename archive-file-name-coding-system)) (let* ((coding-system-for-write 'no-conversion) - (default-directory (file-name-as-directory archive-tmpdir)) - (exitcode (apply #'call-process - (car command) - nil - nil - nil - (append (cdr command) - (list archive ename))))) - (or (zerop exitcode) - (error "Updating was unsuccessful (%S)" exitcode)))) + (default-directory (file-name-as-directory archive-tmpdir))) + (archive--with-ensure-extension + archive (archive--act-files command (list ename))))) (archive-delete-local tmpfile)))) (defun archive-write-file (&optional file) @@ -1510,9 +1546,7 @@ archive-chgrp-entry (archive-resummarize)) (error "Setting group is not supported for this archive type")))) -(defun archive-expunge () - "Do the flagged deletions." - (interactive) +(defun archive--expunge-maybe-force (force) (let (files) (save-excursion (goto-char archive-file-list-start) @@ -1526,7 +1560,8 @@ archive-expunge (and files (or (not archive-read-only) (error "Archive is read-only")) - (or (yes-or-no-p (format "Really delete %d member%s? " + (or force + (yes-or-no-p (format "Really delete %d member%s? " (length files) (if (null (cdr files)) "" "s"))) (error "Operation aborted")) @@ -1540,13 +1575,14 @@ archive-expunge (archive-resummarize) (revert-buffer)))))) +(defun archive-expunge () + "Do the flagged deletions." + (interactive) + (archive--expunge-maybe-force nil)) + (defun archive-*-expunge (archive files command) - (apply #'call-process - (car command) - nil - nil - nil - (append (cdr command) (cons archive files)))) + (archive--with-ensure-extension + archive (archive--act-files command files))) (defun archive-rename-entry (newname) "Change the name associated with this entry in the archive file." diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 32bce1b71bd..b6e06a563fe 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -46,6 +46,73 @@ arc-mode-test-zip-extract-gz (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) + (base-zip-1 "base-1.zip") + (base-zip-2 "base-2.zip") + (content-1 '("1" "2")) + (content-2 '("3" "4")) + (make-file (lambda (name) + (with-temp-buffer + (insert name) + (write-file name)))) + (make-zip + (lambda (zip files) + (delete-file zip nil) + (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))) + (copy-file base-zip-1 zip t) + (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)))))) + ;; setup: make two zip files with different contents + (mapc make-file (append content-1 content-2)) + (mapc (lambda (args) (apply make-zip args)) + (list (list base-zip-1 content-1) + (list 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))) + (provide 'arc-mode-tests) ;;; arc-mode-tests.el ends here -- 2.40.0 --=-=-= Content-Type: text/plain Here attached is a patch _with_ indentation changes (on functions which I have touched) -- I simply re-indented these functions without tabs. Not sure if you want this, so I provided the other patch file as an alternative. Please choose whichever you prefer to install. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Handle-modifications-on-extensionless-zips-correctly.patch Content-Description: Patch *with* indentation changes >From 36c5f839042e39b3d49e7939543b988142103033 Mon Sep 17 00:00:00 2001 From: Ruijie Yu Date: Mon, 6 Mar 2023 11:03:32 +0800 Subject: [PATCH] Handle modifications on extensionless zips correctly (Bug#61326) * lisp/arc-mode.el (archive-*-write-file-member) (archive-*-expunge): Refactor to correctly modify extensionless zip archives. (archive-expunge): Move implementation to a separate helper function to facilitate testing. (archive--act-files): New helper function to wrap around `call-process' calls. (archive--need-rename-p): New helper function to check whether a temporary rename is necessary. (archive--ensure-extension) (archive--maybe-rename): New helper functions to rename archive if the caller deems it necessary. (archive--with-ensure-extension): New helper function to handle writing an archive while ensuring extensionless archives work correctly by temporarily renaming them. * test/lisp/arc-mode-tests.el (arc-mode-test-zip-ensure-ext): New regression test for bug#61326. --- lisp/arc-mode.el | 144 ++++++++++++++++++++++-------------- test/lisp/arc-mode-tests.el | 67 +++++++++++++++++ 2 files changed, 157 insertions(+), 54 deletions(-) diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index 5e696c091b2..89b3e720ed9 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -645,6 +645,49 @@ archive-get-descr (if (not noerror) (error "Line does not describe a member of the archive"))))) ;; ------------------------------------------------------------------------- +;;; Section: Helper functions for requiring filename extensions + +(defun archive--act-files (command files) + (lambda (archive) + (apply #'call-process (car command) + nil nil nil (append (cdr command) (cons archive files))))) + +(defun archive--need-rename-p (&optional archive) + (let ((archive + (file-name-nondirectory (or archive buffer-file-name)))) + (cl-case archive-subtype + ((zip) (not (seq-contains-p archive ?. #'eq)))))) + +(defun archive--ensure-extension (archive ensure-extension) + (if ensure-extension + (make-temp-name (expand-file-name (concat archive "_tmp."))) + archive)) + +(defun archive--maybe-rename (newname need-rename-p) + ;; Operating with archive as current buffer, and protect + ;; `default-directory' from being modified in `rename-visited-file'. + (when need-rename-p + (let ((default-directory default-directory)) + (rename-visited-file newname)))) + +(defun archive--with-ensure-extension (archive proc-fn) + (let ((saved default-directory)) + (with-current-buffer (find-buffer-visiting archive) + (let ((ensure-extension (archive--need-rename-p)) + (default-directory saved)) + (unwind-protect + ;; Some archive programs (like zip) expect filenames to + ;; have an extension, so if necessary, temporarily rename + ;; an extensionless file for write accesses. + (let ((archive (archive--ensure-extension + archive ensure-extension))) + (archive--maybe-rename archive ensure-extension) + (let ((exitcode (funcall proc-fn archive))) + (or (zerop exitcode) + (error "Updating was unsuccessful (%S)" exitcode)))) + (progn (archive--maybe-rename archive ensure-extension) + (revert-buffer nil t))))))) +;; ------------------------------------------------------------------------- ;;; Section: the mode definition ;;;###autoload @@ -1357,37 +1400,30 @@ archive-*-write-file-member (ename (archive--file-desc-ext-file-name descr)) (tmpfile (expand-file-name ename archive-tmpdir)) (top (directory-file-name (file-name-as-directory archive-tmpdir))) - (default-directory (file-name-as-directory top))) + (default-directory (file-name-as-directory top))) (unwind-protect (progn (make-directory (file-name-directory tmpfile) t) - ;; If the member is itself an archive, write it without - ;; the dired-like listing we created. - (if (eq major-mode 'archive-mode) - (archive-write-file tmpfile) - (write-region nil nil tmpfile nil 'nomessage)) - ;; basic-save-buffer needs last-coding-system-used to have - ;; the value used to write the file, so save it before any - ;; further processing clobbers it (we restore it in - ;; archive-write-file-member, above). - (setq archive-member-coding-system last-coding-system-used) - (if (archive--file-desc-mode descr) - ;; Set the file modes, but make sure we can read it. - (set-file-modes tmpfile - (logior ?\400 (archive--file-desc-mode descr)))) - (setq ename - (encode-coding-string ename archive-file-name-coding-system)) + ;; If the member is itself an archive, write it without + ;; the dired-like listing we created. + (if (eq major-mode 'archive-mode) + (archive-write-file tmpfile) + (write-region nil nil tmpfile nil 'nomessage)) + ;; basic-save-buffer needs last-coding-system-used to have + ;; the value used to write the file, so save it before any + ;; further processing clobbers it (we restore it in + ;; archive-write-file-member, above). + (setq archive-member-coding-system last-coding-system-used) + (if (archive--file-desc-mode descr) + ;; Set the file modes, but make sure we can read it. + (set-file-modes tmpfile + (logior ?\400 (archive--file-desc-mode descr)))) + (setq ename + (encode-coding-string ename archive-file-name-coding-system)) (let* ((coding-system-for-write 'no-conversion) - (default-directory (file-name-as-directory archive-tmpdir)) - (exitcode (apply #'call-process - (car command) - nil - nil - nil - (append (cdr command) - (list archive ename))))) - (or (zerop exitcode) - (error "Updating was unsuccessful (%S)" exitcode)))) + (default-directory (file-name-as-directory archive-tmpdir))) + (archive--with-ensure-extension + archive (archive--act-files command (list ename))))) (archive-delete-local tmpfile)))) (defun archive-write-file (&optional file) @@ -1510,43 +1546,43 @@ archive-chgrp-entry (archive-resummarize)) (error "Setting group is not supported for this archive type")))) -(defun archive-expunge () - "Do the flagged deletions." - (interactive) +(defun archive--expunge-maybe-force (force) (let (files) (save-excursion (goto-char archive-file-list-start) (while (< (point) archive-file-list-end) (if (= (following-char) ?D) - (setq files (cons (archive--file-desc-ext-file-name - (archive-get-descr)) - files))) + (setq files (cons (archive--file-desc-ext-file-name + (archive-get-descr)) + files))) (forward-line 1))) (setq files (nreverse files)) (and files - (or (not archive-read-only) - (error "Archive is read-only")) - (or (yes-or-no-p (format "Really delete %d member%s? " - (length files) - (if (null (cdr files)) "" "s"))) - (error "Operation aborted")) - (let ((archive (archive-maybe-copy (buffer-file-name))) - (expunger (archive-name "expunge"))) - (if (fboundp expunger) - (funcall expunger archive files) - (archive-*-expunge archive files (symbol-value expunger))) - (archive-maybe-update nil) - (if archive-remote - (archive-resummarize) - (revert-buffer)))))) + (or (not archive-read-only) + (error "Archive is read-only")) + (or force + (yes-or-no-p (format "Really delete %d member%s? " + (length files) + (if (null (cdr files)) "" "s"))) + (error "Operation aborted")) + (let ((archive (archive-maybe-copy (buffer-file-name))) + (expunger (archive-name "expunge"))) + (if (fboundp expunger) + (funcall expunger archive files) + (archive-*-expunge archive files (symbol-value expunger))) + (archive-maybe-update nil) + (if archive-remote + (archive-resummarize) + (revert-buffer)))))) + +(defun archive-expunge () + "Do the flagged deletions." + (interactive) + (archive--expunge-maybe-force nil)) (defun archive-*-expunge (archive files command) - (apply #'call-process - (car command) - nil - nil - nil - (append (cdr command) (cons archive files)))) + (archive--with-ensure-extension + archive (archive--act-files command files))) (defun archive-rename-entry (newname) "Change the name associated with this entry in the archive file." diff --git a/test/lisp/arc-mode-tests.el b/test/lisp/arc-mode-tests.el index 32bce1b71bd..b6e06a563fe 100644 --- a/test/lisp/arc-mode-tests.el +++ b/test/lisp/arc-mode-tests.el @@ -46,6 +46,73 @@ arc-mode-test-zip-extract-gz (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) + (base-zip-1 "base-1.zip") + (base-zip-2 "base-2.zip") + (content-1 '("1" "2")) + (content-2 '("3" "4")) + (make-file (lambda (name) + (with-temp-buffer + (insert name) + (write-file name)))) + (make-zip + (lambda (zip files) + (delete-file zip nil) + (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))) + (copy-file base-zip-1 zip t) + (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)))))) + ;; setup: make two zip files with different contents + (mapc make-file (append content-1 content-2)) + (mapc (lambda (args) (apply make-zip args)) + (list (list base-zip-1 content-1) + (list 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))) + (provide 'arc-mode-tests) ;;; arc-mode-tests.el ends here -- 2.40.0 --=-=-= Content-Type: text/plain -- Best, RY [Please note that this mail might go to spam due to some misconfiguration in my mail server -- will fix soon.] --=-=-=--