branch: master commit 2393f3a7d17eb3ebe674127821925c60547d1bcb Author: Tino Calancha <tino.calan...@gmail.com> Commit: Tino Calancha <tino.calan...@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. --- packages/gited/gited-tests.el | 216 +++++++++++++++++++++++++++--------------- packages/gited/gited.el | 10 +- 2 files changed, 146 insertions(+), 80 deletions(-) diff --git a/packages/gited/gited-tests.el b/packages/gited/gited-tests.el index 89c549c..e72e32e 100644 --- a/packages/gited/gited-tests.el +++ b/packages/gited/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.calan...@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....@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....@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/packages/gited/gited.el b/packages/gited/gited.el index 077afe9..5900c7a 100644 --- a/packages/gited/gited.el +++ b/packages/gited/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.calan...@gmail.com> ;; Maintainer: Tino Calancha <tino.calan...@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 " "))))))))))