[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 2393f3a 1/3: Avoid side-effects in a couple of functions
From: |
Tino Calancha |
Subject: |
[elpa] master 2393f3a 1/3: Avoid side-effects in a couple of functions |
Date: |
Tue, 30 Jul 2019 13:33:31 -0400 (EDT) |
branch: master
commit 2393f3a7d17eb3ebe674127821925c60547d1bcb
Author: Tino Calancha <address@hidden>
Commit: Tino Calancha <address@hidden>
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 <address@hidden>,
;; 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 "address@hidden")
+(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" "address@hidden"))
- (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 <address@hidden>
;; Maintainer: Tino Calancha <address@hidden>
@@ -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 "
"))))))))))