[elpa] externals/ssh-deploy 8e2507b 085/133: Refactored remote changes function and made unit tests for it

[Stefan Monnier]

branch: externals/ssh-deploy
commit 8e2507bd3a9f8866b54b128f17e1b76107e77a82
Author: Christian Johansson <christian@cvj.se>
Commit: Christian Johansson <christian@cvj.se>

    Refactored remote changes function and made unit tests for it
---
 ssh-deploy-test.el |  90 +++++++++++++++++++++++++++++++++--
 ssh-deploy.el      | 135 ++++++++++-------------------------------------------
 2 files changed, 110 insertions(+), 115 deletions(-)

diff --git a/ssh-deploy-test.el b/ssh-deploy-test.el
index 44c7a8b..0c12dab 100644
--- a/ssh-deploy-test.el
+++ b/ssh-deploy-test.el
@@ -44,6 +44,8 @@
 (autoload 'ssh-deploy-add-after-save-hook "ssh-deploy")
 (autoload 'ssh-deploy-add-after-save-hook "ssh-deploy")
 (autoload 'ssh-deploy-upload-handler "ssh-deploy")
+(autoload 'ssh-deploy--remote-changes-data "ssh-deploy")
+(autoload 'ssh-deploy-download-handler "ssh-deploy")
 
 (defun ssh-deploy-test--download (async async-with-threads)
   "Test downloads asynchronously if ASYNC is above zero, with threads if 
ASYNC-WITH-THREADS is above zero."
@@ -155,11 +157,11 @@
         (when (> async 0)
           (sleep-for 1))
 
-        ;; Both old files should not exist anymore
+        ;; Both old files should not exist any more
         (should (equal nil (file-exists-p file-a-old)))
         (should (equal nil (file-exists-p file-b-old)))
 
-        ;; Both new files should exist anymore
+        ;; Both new files should exist any more
         (should (equal t (file-exists-p file-a-new)))
         (should (equal t (file-exists-p file-b-new)))
 
@@ -248,6 +250,79 @@
     (delete-directory directory-a t)
     (delete-directory directory-b t)))
 
+(defun ssh-deploy-test--detect-remote-changes (async async-with-threads)
+  "Test uploads asynchronously if ASYNC is above zero, with threads if 
ASYNC-WITH-THREADS is above zero."
+
+  (let ((directory-a (expand-file-name "test-a/"))
+        (directory-b (expand-file-name "test-b/")))
+
+    ;; Delete directories if they already exists
+    (when (file-directory-p directory-a)
+      (delete-directory directory-a t))
+    (when (file-directory-p directory-b)
+      (delete-directory directory-b t))
+
+    (make-directory-internal directory-a)
+    (make-directory-internal directory-b)
+
+    (let* ((file-a (expand-file-name "test.txt" directory-a))
+           (file-b (expand-file-name "test.txt" directory-b))
+           (file-a-contents "Random text")
+           (ssh-deploy-root-local directory-a)
+           (ssh-deploy-root-remote directory-b)
+           (ssh-deploy-on-explicit-save 1)
+           (ssh-deploy-debug 0)
+           (ssh-deploy-async async)
+           (ssh-deploy-async-with-threads async-with-threads))
+
+      ;; Just bypass the linter here
+      (when (and ssh-deploy-root-local
+                 ssh-deploy-root-remote
+                 ssh-deploy-on-explicit-save
+                 ssh-deploy-debug
+                 ssh-deploy-async
+                 ssh-deploy-async-with-threads)
+
+        (ssh-deploy-add-after-save-hook)
+        (find-file file-a)
+        (insert file-a-contents)
+        (save-buffer) ;; NOTE Should trigger upload action
+        (when (> async 0)
+          (sleep-for 1))
+        (kill-buffer)
+
+        ;; Verify that both files have equal contents
+        (should (equal t (ediff-same-file-contents file-a file-b)))
+
+        ;; Update should not trigger upload
+        (find-file file-b)
+        (insert "Random blbob")
+        (save-buffer)
+        (kill-buffer)
+
+        ;; Verify that both files don't have equal contents
+        (should (equal nil (ediff-same-file-contents file-a file-b)))
+
+        ;; Remote file should signal change now
+        (should (equal 5 (nth 0 (ssh-deploy--remote-changes-data file-a))))
+
+        ;; Open file-a and download remote
+        (find-file file-a)
+        (ssh-deploy-download-handler)
+        (when (> async 0)
+          (sleep-for 1))
+        (kill-buffer)
+
+        ;; Remote file should not signal change now
+        (should (equal 4 (nth 0 (ssh-deploy--remote-changes-data file-a))))
+
+        ;; Delete both test files
+        (delete-file file-b)
+        (delete-file file-a)))
+
+    (delete-directory directory-a t)
+    (delete-directory directory-b t)))
+
 (defun ssh-deploy-test--get-revision-path ()
   "Test this function."
   (should (string= (expand-file-name "./_mydirectory_random-file.txt") 
(ssh-deploy--get-revision-path "/mydirectory/random-file.txt" (expand-file-name 
".")))))
@@ -267,12 +342,14 @@
 (defun ssh-deploy-test ()
   "Run test for plug-in."
   (let ((ssh-deploy-verbose 1)
-        (ssh-deploy-debug 1))
+        (ssh-deploy-debug 1)
+        (debug-on-error t))
     (when (and ssh-deploy-verbose
                ssh-deploy-debug)
       (if (fboundp 'async-start)
           (message "\nNOTE: Running tests for async.el as well since it's 
loaded\n")
         (message "\nNOTE: Skipping tests for async.el since it's not 
loaded\n"))
+
       (ssh-deploy-test--get-revision-path)
       (ssh-deploy-test--file-is-in-path)
       (ssh-deploy-test--is-not-empty-string)
@@ -290,7 +367,12 @@
       (ssh-deploy-test--rename-and-delete 0 0)
       (when (fboundp 'async-start)
         (ssh-deploy-test--rename-and-delete 1 0))
-      (ssh-deploy-test--rename-and-delete 1 1))))
+      (ssh-deploy-test--rename-and-delete 1 1)
+
+      (ssh-deploy-test--detect-remote-changes 0 0)
+      (when (fboundp 'async-start)
+        (ssh-deploy-test--detect-remote-changes 1 0))
+      (ssh-deploy-test--detect-remote-changes 1 1))))
 
 (ssh-deploy-test)
 
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 988e3c7..4db8887 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -171,7 +171,6 @@
 (put 'ssh-deploy-debug 'permanent-local t)
 (put 'ssh-deploy-debug 'safe-local-variable 'integerp)
 
-;; TODO This flag needs to work better, you should not miss any useful 
notifications when this is on
 (defcustom ssh-deploy-verbose 1
   "Boolean variable if debug messages should be shown, 1 by default."
   :type 'integer)
@@ -324,7 +323,6 @@
                    (autoload 'ediff-same-file-contents "ediff-util")
                    (autoload 'string-remove-prefix "subr-x")
 
-                   ;; TODO Add all public functions as autoload here
                    (autoload 'ssh-deploy-download "ssh-deploy")
                    (autoload 'ssh-deploy-download-handler "ssh-deploy")
                    (autoload 'ssh-deploy-upload "ssh-deploy")
@@ -796,120 +794,35 @@
       (list 1 (format "File '%s' is not in root or is excluded from it." 
path-local) path-local))))
 
 ;;;###autoload
-(defun ssh-deploy-remote-changes (path-local &optional root-local root-remote 
async revision-folder exclude-list async-with-threads)
-  "Check if a local revision for PATH-LOCAL on ROOT-LOCAL and if remote file 
has changed on ROOT-REMOTE, do it optionally asynchronously if ASYNC is true, 
check for copies in REVISION-FOLDER and skip if path is in EXCLUDE-LIST.  Use 
multi-threading if ASYNC-WITH-THREADS is above zero."
+(defun ssh-deploy-remote-changes (path-local &optional root-local root-remote 
async revision-folder exclude-list async-with-threads verbose)
+  "Check if a local revision for PATH-LOCAL on ROOT-LOCAL and if remote file 
has changed on ROOT-REMOTE, do it optionally asynchronously if ASYNC is true, 
check for copies in REVISION-FOLDER and skip if path is in EXCLUDE-LIST.  Use 
multi-threading if ASYNC-WITH-THREADS is above zero, VERBOSE if value above 
zero."
   (let ((root-local (or root-local ssh-deploy-root-local))
         (root-remote (or root-remote ssh-deploy-root-remote))
-        (exclude-list (or exclude-list ssh-deploy-exclude-list)))
-
+        (exclude-list (or exclude-list ssh-deploy-exclude-list))
+        (verbose (or verbose ssh-deploy-verbose))
+        (revision-folder (or revision-folder ssh-deploy-revision-folder)))
     ;; Is the file inside the local-root and should it not be excluded?
     (if (and (ssh-deploy--file-is-in-path-p path-local root-local)
              (ssh-deploy--file-is-included-p path-local exclude-list))
-        (let* ((revision-folder (or revision-folder 
ssh-deploy-revision-folder))
-               (revision-path (ssh-deploy--get-revision-path path-local 
revision-folder))
-               (path-remote (expand-file-name (ssh-deploy--get-relative-path 
root-local path-local) root-remote)))
-
-          ;; Is the file a regular file?
-          (if (not (file-directory-p path-local))
-              (progn
-
-                ;; Does a local revision of the file exist?
-                (if (file-exists-p revision-path)
-
-                    ;; Local revision exist. Is async enabled?
-                    (if (> async 0)
-                        (progn
-
-                          ;; Update mode-line status
-                          (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
-
-                          ;; Asynchronous logic here
-                          (ssh-deploy--async-process
-                           (lambda()
-                             (if (file-exists-p path-remote)
-                                 (if (ediff-same-file-contents revision-path 
path-remote)
-                                     (list 0 (format "Remote file '%s' has not 
changed. (asynchronously)" path-remote) path-local)
-                                   (if (ediff-same-file-contents path-local 
path-remote)
-                                       (progn
-                                         (copy-file path-local revision-path t 
t t t)
-                                         (list 0 (format "Remote file '%s' is 
identical to local file '%s' but different to local revision. Updated local 
revision. (asynchronously)" path-remote path-local) path-local))
-                                     (list 1 (format "Remote file '%s' has 
changed please download or diff. (asynchronously)" path-remote) path-local)))
-                               (list 0 (format "Remote file '%s' doesn't 
exist. (asynchronously)" path-remote) path-local)))
-                           (lambda(return)
-
-                             ;; Update buffer status to idle
-                             (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
-
-                             (if (= (nth 0 return) 0)
-                                 (when (> ssh-deploy-verbose 0) (message (nth 
1 return)))
-                               (display-warning 'ssh-deploy (nth 1 return) 
:warning)))
-                           async-with-threads))
-
-                      ;; Async is not enabled - synchronous logic here
-
-                      ;; Update buffer status
-                      (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
-
-                      ;; Does remote file exist?
-                      (if (file-exists-p path-remote)
-                          (if (ediff-same-file-contents revision-path 
path-remote)
-                              (when (> ssh-deploy-verbose 0) (message "Remote 
file '%s' has not changed. (synchronously)" path-remote))
-                            (display-warning 'ssh-deploy (format "Remote file 
'%s' has changed, please download or diff. (synchronously)" path-remote) 
:warning))
-                        (when (> ssh-deploy-verbose 0) (message "Remote file 
'%s' doesn't exist. (synchronously)" path-remote)))
-
-                      ;; Update buffer status to idle
-                      (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle))
-
-                  ;; Does not have local revision. Is async enabled?
-                  (if (> async 0)
-                      (progn
-
-                        ;; Update buffer status
-                        (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
-
-                        ;; Asynchronous logic here
-                        (ssh-deploy--async-process
-                         (lambda()
-
-                           ;; Does remote file exist?
-                           (if (file-exists-p path-remote)
-                               (if (ediff-same-file-contents path-local 
path-remote)
-                                   (progn
-                                     (copy-file path-local revision-path t t t 
t)
-                                     (list 0 (format "Remote file '%s' has not 
changed, created base revision. (asynchronously)" path-remote) path-local))
-                                 (list 1 (format "Remote file '%s' has changed 
please download or diff. (asynchronously)" path-remote) path-local))
-                             (list 0 (format "Remote file '%s' doesn't exist. 
(asynchronously)" path-remote) path-local)))
-                         (lambda(return)
-
-                           ;; Update buffer status to idle
-                           (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 return))
-
-                           (if (= (nth 0 return) 0)
-                               (when (> ssh-deploy-verbose 0) (message (nth 1 
return)))
-                             (display-warning 'ssh-deploy (nth 1 return) 
:warning)))
-                         async-with-threads))
-
-                    ;; Async is not enabled - synchronous logic here
-
-                    ;; Update buffer status
-                    (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
-
-                    ;; Does remote file exist?
-                    (if (file-exists-p path-remote)
-                        (if (ediff-same-file-contents path-local path-remote)
-                            (progn
-                              (copy-file path-local revision-path t t t t)
-                              (when (> ssh-deploy-verbose 0) (message "Remote 
file '%s' has not changed, created base revision. (synchronously)" 
path-remote)))
-                          (display-warning 'ssh-deploy (format "Remote file 
'%s' has changed, please download or diff. (synchronously)" path-remote) 
:warning))
-                      (when (> ssh-deploy-verbose 0) (message "Remote file 
'%s' does not exist. (synchronously)" path-remote)))
-
-                    ;; Update buffer status to idle
-                    (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle))))
-
-            ;; File is a directory
-            (when (> ssh-deploy-debug 0) (message "File %s is a directory, 
ignoring remote changes check." path-local))))
-
-      ;; File is not inside root or is excluded from it
+        ;; Is the file a regular file?
+        (if (not (file-directory-p path-local))
+            (progn
+              ;; Update mode-line status to detecting remote changes
+              (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-detecting-remote-changes)
+              (if (> async 0)
+                  (ssh-deploy--async-process
+                   (lambda()
+                     (ssh-deploy--remote-changes-data path-local root-local 
root-remote revision-folder exclude-list))
+                   (lambda(response)
+                     ;; Update buffer status to idle
+                     (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 response))
+                     (ssh-deploy--remote-changes-post-executor response 
verbose))
+                   async-with-threads)
+                (let ((response (ssh-deploy--remote-changes-data path-local 
root-local root-remote revision-folder exclude-list)))
+                  ;; Update buffer status to idle
+                  (ssh-deploy--mode-line-set-status-and-update 
ssh-deploy--status-idle (nth 2 response))
+                  (ssh-deploy--remote-changes-post-executor response 
verbose))))
+          (when (> ssh-deploy-debug 0) (message "File %s is a directory, 
ignoring remote changes check." path-local)))
       (when (> ssh-deploy-debug 0) (message "File %s is not in root or is 
excluded from it." path-local)))))
 
 (defun ssh-deploy-delete (path &optional async async-with-threads)