[elpa] externals/gited d31e1b2 63/73: Avoid side-effects in a couple of functions

[Stefan Monnier]

branch: externals/gited
commit d31e1b21be65b660e5d4acbd550848df0aa2a573
Author: Tino Calancha <tino.calancha@gmail.com>
Commit: Tino Calancha <tino.calancha@gmail.com>

    Avoid side-effects in a couple of functions
    
    Fixes a long-standing issue.
    See Emacs Prince analysis of the Bug and John Wick's fix here:
    https://youtu.be/nVLeQoBeNL8
    
    * packages/gited/gited.el (gited--handle-new-or-delete-files)
    (gited-add-patched-files):
    Avoid unsafe `nconc' usage, i.e. quoted constant list as a non-last
    argument.
    
    * packages/gited/gited-tests.el (gited-test-add-patch-bug):
    Add test.  Clean previous tests by adding helper some functions/variables.
---
 gited-tests.el | 216 +++++++++++++++++++++++++++++++++++++--------------------
 gited.el       |  10 +--
 2 files changed, 146 insertions(+), 80 deletions(-)

diff --git a/gited-tests.el b/gited-tests.el
index 89c549c..e72e32e 100644
--- a/gited-tests.el
+++ b/gited-tests.el
@@ -1,6 +1,6 @@
 ;;; gited-tests.el --- Tests for gited.el  -*- lexical-binding: t; -*-
 
-;; Copyright (C) 2017 Free Software Foundation, Inc.
+;; Copyright (C) 2017-2019 Free Software Foundation, Inc.
 
 ;; Author: Tino Calancha <tino.calancha@gmail.com>,
 ;; Keywords:
@@ -30,77 +30,117 @@
 (require 'gited)
 (eval-when-compile (require 'cl-lib))
 
+;; Settings for a test repository.
+(defvar gited-user-name "John Doe")
+(defvar gited-user-email "john.doe@example.com")
+(defvar gited-initial-commit-msg "Initialize repository.")
+(defvar gited-initial-filename "foo")
+(defvar gited-initial-file-content "Test file")
+
+(defvar gited-remote-repo "https://github.com/calancha/foo";)
+(defvar gited-remote-repo-branch "fail-say-foo-test")
+(defvar gited-remote-repo-file "do_not_delete.el")
+
+(defun gited-create-new-repo (dir)
+  "Create a new repository at DIR and return its gited buffer."
+  (let ((inhibit-message t))
+    (write-region gited-initial-file-content
+                  nil
+                  (expand-file-name gited-initial-filename dir))
+    (dired dir)
+    (gited-git-command '("init"))
+    (gited-git-command `("config" "user.email" ,gited-user-email))
+    (gited-git-command `("config" "user.name" ,gited-user-name))
+    (gited-git-command `("add" ,gited-initial-filename))
+    (gited-git-command `("commit" "-m" ,gited-initial-commit-msg))
+    (gited-list-branches "local")
+    gited-buffer))
+
+(defmacro with-gited-repo (dir &rest body)
+  "Create a new Git repository at DIR and evaluate BODY.
+The repository consists of just one file with content
+`gited-initial-file-content'.
+The forms in BODY are evaluated with DIR as `default-directory'."
+  (declare (indent 1) (debug (form body)))
+  `(let* ((gited-expert t)
+          (inhibit-message t))
+     (unwind-protect
+         (progn
+           (gited-create-new-repo ,dir)
+           ,@body)
+       (delete-directory ,dir 'recursive))))
+
+(defmacro with-specified-completion-branch (branch &rest body)
+  "Fix branch completions to BRANCH and evaluate BODY.
+This macro uses `cl-letf' to temporary fix the completions.
+Return the last evaled BODY form."
+  (declare (indent 1) (debug (form body)))
+  `(cl-letf (((symbol-function 'completing-read)
+              (lambda (&rest _) ,branch)))
+     ,@body))
+
 (ert-deftest gited-test1 ()
   (skip-unless (executable-find vc-git-program))
-  (let* ((dir (make-temp-file "gited" 'dir))
-         (file (expand-file-name "foo" dir))
-         (gited-expert t)
-         (inhibit-message t)
-         dired-buf)
-    (unwind-protect
-        (let ((str "Initialize repository."))
-          (write-region "Test file" nil file)
-             (setq dired-buf (dired dir))
-          (gited-git-command '("init"))
-             (gited-git-command '("config" "user.email" 
"john.doe@example.com"))
-             (gited-git-command '("config" "user.name" "John Doe"))
-          (gited-git-command '("add" "foo"))
-          (gited-git-command `("commit" "-m" ,str))
-          (gited-list-branches "local")
-          (should (gited-dir-under-Git-control-p))
-          (should (gited-buffer-p))
-          (should (equal str (gited--last-commit-title)))
-          (should (equal "master" (gited-current-branch)))
-          (should-not (gited-branch-exists-p "foo"))
-          (gited-copy-branch "master" "foo")
-          (should (gited-branch-exists-p "foo"))
-          (gited-toggle-marks)
-          (should (= 2 (gited-number-marked)))
+  (let ((dir (make-temp-file "gited" 'dir)))
+    (with-gited-repo dir
+      (progn
+        (should (gited-dir-under-Git-control-p))
+        (should (gited-buffer-p))
+        (should (equal gited-initial-commit-msg (gited--last-commit-title)))
+        (should (equal "master" (gited-current-branch)))
+        ;; Only master branch do exist
+        (should-not (gited-branch-exists-p gited-initial-filename))
+        ;; Create a new branch (copy of master)
+        (gited-copy-branch "master" gited-initial-filename)
+        (should (gited-branch-exists-p gited-initial-filename))
+        (gited-toggle-marks)
+        (should (= 2 (gited-number-marked)))
+        (gited-unmark-all-marks)
+        (should (zerop (gited-number-marked)))
+        ;; Update the file in the current branch and commit the changes
+        (gited-with-current-branch gited-initial-filename
+          (write-region "Changed this file" nil gited-initial-filename)
+          (gited-git-command `("add" ,gited-initial-filename))
+          (gited-git-command '("commit" "-m" "Update file"))
+          (let ((hash
+                 (with-temp-buffer
+                   (gited-git-command
+                    '("rev-parse" "HEAD") (current-buffer))
+                   (buffer-substring 1 (1- (point-max))))))
+            ;; gited-mark-branches-containing-commit
+            (gited-mark-branches-containing-commit hash)
+            (should (= 1 (gited-number-marked))))
+          ;; gited-mark-branches-regexp
           (gited-unmark-all-marks)
-          (should (= 0 (gited-number-marked)))
-          (gited-with-current-branch "foo"
-            (write-region "Changed this file" nil file)
-            (gited-git-command '("add" "foo"))
-            (gited-git-command '("commit" "-m" "Update file"))
-            (let ((hash
-                   (with-temp-buffer
-                     (gited-git-command
-                      '("rev-parse" "HEAD") (current-buffer))
-                     (buffer-substring 1 (1- (point-max))))))
-              ;; gited-mark-branches-containing-commit
-              (gited-mark-branches-containing-commit hash)
-              (should (= 1 (gited-number-marked))))
-            ;; gited-mark-branches-regexp
-            (gited-unmark-all-marks)
-            (gited-mark-branches-regexp "foo")
-            (should (= 1 (gited-number-marked)))
-            ;; gited-mark-branches-containing-regexp
-            (gited-unmark-all-marks)
-            (gited-mark-branches-containing-regexp "Update")
-            (should (= 1 (gited-number-marked)))
-            ;; gited-mark-branches-by-date
-            (gited-unmark-all-marks)
-            (gited-mark-branches-by-date
-             (format-time-string "%F" (current-time)))
-            (should (= (length (gited-listed-branches))
-                       (gited-number-marked)))
-            (gited-unmark-all-marks)
-            (gited-mark-branches-by-date
-             (format-time-string
-              "%F"
-              (time-add (current-time) (seconds-to-time (* 7 24 60 60)))))
-            (should (= 0 (gited-number-marked)))
-            (gited-unmark-all-marks))
-          (gited-copy-branch "foo" "bar")
-          (gited-delete-branch "foo" 'force)
-          (gited-update)
-          (should-not (gited-branch-exists-p "foo"))
-          (gited-rename-branch "bar" "foo") ; Asynchronous.
-          (while gited-branch-after-op
-            (sit-for 0.05))
-          (should (gited-branch-exists-p "foo")))
-      (delete-directory dir 'recursive)
-      (kill-buffer dired-buf))))
+          (gited-mark-branches-regexp gited-initial-filename)
+          (should (= 1 (gited-number-marked)))
+          ;; gited-mark-branches-containing-regexp
+          (gited-unmark-all-marks)
+          (gited-mark-branches-containing-regexp "Update")
+          (should (= 1 (gited-number-marked)))
+          ;; gited-mark-branches-by-date
+          (gited-unmark-all-marks)
+          (gited-mark-branches-by-date
+           (format-time-string "%F" (current-time)))
+          (should (= (length (gited-listed-branches))
+                     (gited-number-marked)))
+          (gited-unmark-all-marks)
+          (gited-mark-branches-by-date
+           (format-time-string
+            "%F"
+            (time-add (current-time) (seconds-to-time (* 7 24 60 60)))))
+          (should (zerop (gited-number-marked)))
+          (gited-unmark-all-marks))
+        ;; Copy the updated branch into a new branch "bar"
+        (gited-copy-branch gited-initial-filename "bar")
+        ;; Test delete/rename branch features
+        (gited-delete-branch gited-initial-filename 'force)
+        (gited-update)
+        (should-not (gited-branch-exists-p gited-initial-filename))
+        (gited-rename-branch "bar" gited-initial-filename) ; Asynchronous.
+        (while gited-branch-after-op
+          (sit-for 0.05))
+        (should (gited-branch-exists-p gited-initial-filename))))))
 
 (ert-deftest gited-test2 ()
   (skip-unless (executable-find vc-git-program))
@@ -111,20 +151,21 @@
        (cd dir)
     (unwind-protect
         (progn
-          (gited-git-command '("clone" "https://github.com/calancha/foo";))
+          (gited-git-command `("clone" ,gited-remote-repo))
           (setq dired-buf (dired (expand-file-name "foo")))
           (gited-list-branches "local")
           (should (equal "origin" gited-current-remote-rep))
           (should-error (gited-change-current-remote-rep)) ; Only 1 remote rep
           (gited-list-branches "remote")
-          (gited-copy-branch "origin/fail-say-foo-test" "fail-say-foo-test")
+          (gited-copy-branch (concat "origin/" gited-remote-repo-branch)
+                             gited-remote-repo-branch)
           (gited-list-branches "local")
           (gited-goto-branch "master")
-          (cl-letf (((symbol-function 'completing-read)
-                     (lambda (&rest _) "fail-say-foo-test")))
+          (with-specified-completion-branch gited-remote-repo-branch
             (gited-merge-branch "master"))
-          (load-file "do_not_delete.el")
-          ;; Now it fails: After merge, `say-foo' returns 'bar.
+          (load-file gited-remote-repo-file)
+          ;; Now it fails: At master branch, `say-foo' returns 'foo
+          ;; But at branch `gited-remote-repo-file', `say-foo' returns 'bar.
           (should-not (eq 'foo (say-foo))))
       (delete-directory dir 'recursive)
       (kill-buffer dired-buf))))
@@ -133,5 +174,30 @@
   "Tests to see whether gited-ci has been loaded."
   (should (fboundp 'gited-parse-ci-status)))
 
+(ert-deftest gited-test-add-patch-bug ()
+  "Tests for bug in `gited-add-patched-files'."
+  (skip-unless (executable-find vc-git-program))
+  (let* ((dir1 (make-temp-file "gited-1" 'dir))
+         (dir2 (make-temp-file "gited-2" 'dir))
+         (gited-buffer-1 (gited-create-new-repo dir1))
+         (gited-buffer-2 (gited-create-new-repo dir2))
+         (inhibit-message t))
+    (unwind-protect
+        (progn
+          (pop-to-buffer gited-buffer-1)
+          (write-region "Changed this file" nil gited-initial-filename)
+          (pop-to-buffer gited-buffer-2)
+          ;; Add a new file inside a subdirectory
+          (mkdir (expand-file-name "subdir" dir2))
+          (write-region "New nested file" nil (concat "subdir/" 
gited-initial-filename))
+          (should (gited-add-patched-files (gited-untracked-files)))
+          (pop-to-buffer gited-buffer-1)
+          ;; The bug causes the following to fail
+          (should (gited-add-patched-files (gited-modified-files))))
+      ;; Clean up
+      (delete-directory dir1 'recursive)
+      (delete-directory dir2 'recursive))))
+
+
 (provide 'gited-tests)
 ;;; gited-tests.el ends here
diff --git a/gited.el b/gited.el
index 077afe9..5900c7a 100644
--- a/gited.el
+++ b/gited.el
@@ -1,6 +1,6 @@
 ;;; gited.el --- Operate on Git branches like dired  -*- lexical-binding:t -*-
 ;;
-;; Copyright (C) 2016-2018 Free Software Foundation, Inc.
+;; Copyright (C) 2016-2019 Free Software Foundation, Inc.
 ;;
 ;; Author: Tino Calancha <tino.calancha@gmail.com>
 ;; Maintainer: Tino Calancha <tino.calancha@gmail.com>
@@ -10,9 +10,9 @@
 ;; Compatibility: GNU Emacs: 24.4
 ;; Version: 0.5.3
 ;; Package-Requires: ((emacs "24.4") (cl-lib "0.5"))
-;; Last-Updated: Tue May 15 13:30:52 JST 2018
+;; Last-Updated: Tue Jul 30 18:28:26 CEST 2019
 ;;           By: calancha
-;;     Update #: 696
+;;     Update #: 697
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
@@ -1701,7 +1701,7 @@ local, then prompt for a branch name where to check out 
BRANCH."
                   (string-match "diff --git a/\\(.*\\) b/.*" str)
                   (match-string-no-properties 1 str))))
           (push file new-files))))
-    (if (zerop (gited-git-command (nconc '("add") new-files)))
+    (if (zerop (gited-git-command `("add" ,@new-files)))
         (message "Sucessfully staged new files: %s"
                  (mapconcat #'shell-quote-argument new-files " "))
       (error "Cannot stage some new files.  Please check"))))
@@ -1775,7 +1775,7 @@ Interactively, with 2 prefices C-u C-u set arg ASK 
non-nil."
                (with-temp-buffer
                  ;; Add files from top-level dir.
                  (setq default-directory (file-name-as-directory toplevel))
-                 (if (not (zerop (gited-git-command (nconc '("add") files))))
+                 (if (not (zerop (gited-git-command `("add" ,@files))))
                      (error "Cannot add files.  Please check")
                    (message "Successfully added files: %s"
                             (mapconcat #'shell-quote-argument files " 
"))))))))))