emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/ssh-deploy 6ddb12b 090/133: All unit tests for remote c


From: Stefan Monnier
Subject: [elpa] externals/ssh-deploy 6ddb12b 090/133: All unit tests for remote changes sync and async and compilation passing
Date: Sat, 27 Mar 2021 14:48:50 -0400 (EDT)

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

    All unit tests for remote changes sync and async and compilation passing
---
 ssh-deploy-test.el | 45 ++++++++++++++++------------------
 ssh-deploy.el      | 72 +++++++++++++++++++++++++++++++-----------------------
 2 files changed, 62 insertions(+), 55 deletions(-)

diff --git a/ssh-deploy-test.el b/ssh-deploy-test.el
index 15f89d1..18c2694 100644
--- a/ssh-deploy-test.el
+++ b/ssh-deploy-test.el
@@ -269,11 +269,11 @@
     (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))
+    (let* ((file-a (file-truename (expand-file-name "test.txt" directory-a)))
+           (file-b (file-truename (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-root-local (file-truename directory-a))
+           (ssh-deploy-root-remote (file-truename directory-b))
            (ssh-deploy-on-explicit-save 1)
            (ssh-deploy-debug 0)
            (ssh-deploy-async async)
@@ -311,13 +311,8 @@
         (if (> async 0)
             (progn
               (ssh-deploy--async-process
-               `(lambda()
-                 ;; (format "root local 2: %s, root remote: %s, 
revision-folder: %s, exclude-list: %s" ,ssh-deploy-root-local 
,ssh-deploy-root-remote ,ssh-deploy-revision-folder ,ssh-deploy-exclude-list)
-                 (ssh-deploy--remote-changes-data ,file-a 
,ssh-deploy-root-local ,ssh-deploy-root-remote ,ssh-deploy-revision-folder)
-                 )
-               (lambda(response)
-                 ;;(message "Response: %s" response)
-                 (should (equal 5 (nth 0 response))))
+               (lambda() (ssh-deploy--remote-changes-data file-a))
+               (lambda(response) (should (equal 5 (nth 0 response))))
                async-with-threads)
               (sleep-for 1))
           (should (equal 5 (nth 0 (ssh-deploy--remote-changes-data file-a)))))
@@ -333,9 +328,8 @@
         (if (> async 0)
             (progn
               (ssh-deploy--async-process
-               `(lambda()
-                 (ssh-deploy--remote-changes-data ,file-a 
,ssh-deploy-root-local ,ssh-deploy-root-remote ,ssh-deploy-revision-folder))
-               (lambda(response)(should (equal 4 (nth 0 response))))
+               (lambda() (ssh-deploy--remote-changes-data file-a))
+               (lambda(response) (should (equal 4 (nth 0 response))))
                async-with-threads)
               (sleep-for 1))
           (should (equal 4 (nth 0 (ssh-deploy--remote-changes-data file-a)))))
@@ -365,15 +359,14 @@
 
 (defun ssh-deploy-test ()
   "Run test for plug-in."
+  (require 'ssh-deploy)
   (let ((ssh-deploy-verbose 1)
         (ssh-deploy-debug 1)
-        (debug-on-error t)
+        ;; (debug-on-error t)
         (async-el (fboundp 'async-start))
-        (revision-folder (expand-file-name "revisions")))
+        (ssh-deploy-revision-folder (file-truename (expand-file-name 
"revisions"))))
     (when (and ssh-deploy-verbose
                ssh-deploy-debug)
-
-      (setq ssh-deploy-revision-folder revision-folder)
       
       (if async-el
           (message "\nNOTE: Running tests for async.el as well since it's 
loaded\n")
@@ -383,27 +376,31 @@
       (ssh-deploy-test--file-is-in-path)
       (ssh-deploy-test--is-not-empty-string)
 
+      ;; Detect Remote Changes
+      (ssh-deploy-test--detect-remote-changes 0 0)
+      (when async-el
+        (ssh-deploy-test--detect-remote-changes 1 0))
+      (ssh-deploy-test--detect-remote-changes 1 1)
+
+      ;; Upload
       (ssh-deploy-test--upload 0 0)
       (when async-el
         (ssh-deploy-test--upload 1 0))
       (ssh-deploy-test--upload 1 1)
 
+      ;; Download
       (ssh-deploy-test--download 0 0)
       (when async-el
         (ssh-deploy-test--download 1 0))
       (ssh-deploy-test--download 1 1)
 
+      ;; Rename And Delete
       (ssh-deploy-test--rename-and-delete 0 0)
       (when async-el
         (ssh-deploy-test--rename-and-delete 1 0))
       (ssh-deploy-test--rename-and-delete 1 1)
 
-      (ssh-deploy-test--detect-remote-changes 0 0)
-      (when async-el
-        (ssh-deploy-test--detect-remote-changes 1 0))
-      (ssh-deploy-test--detect-remote-changes 1 1)
-
-      (delete-directory revision-folder t)
+      (delete-directory ssh-deploy-revision-folder t)
 
 
       )))
diff --git a/ssh-deploy.el b/ssh-deploy.el
index 7aae71f..9a59f4b 100644
--- a/ssh-deploy.el
+++ b/ssh-deploy.el
@@ -316,6 +316,8 @@
             (let ((script-filename (file-name-directory (symbol-file 
'ssh-deploy-diff-directories))))
               (async-start
                (lambda()
+                 (add-to-list 'load-path script-filename)
+                 (require 'ssh-deploy)
                  (let ((ssh-deploy-async 0)
                        (ssh-deploy-async-with-threads 0)
                        (ssh-deploy-on-explicit-save 0)
@@ -328,7 +330,6 @@
                      ;; Pass ange-ftp setting to asynchronous process
                      (defvar ange-ftp-netrc-filename ftp-netrc))
 
-                   (add-to-list 'load-path script-filename)
                    (autoload 'ediff-same-file-contents "ediff-util")
                    (autoload 'string-remove-prefix "subr-x")
 
@@ -743,8 +744,11 @@
 (defun ssh-deploy--remote-changes-post-executor (response verbose)
   "Process RESPONSE from `ssh-deploy--remote-changes-data' with flags: 
VERBOSE."
   (pcase (nth 0 response)
+    (0
+     ;; File is outside of root
+     (when (> verbose 0) (message (nth 1 response))))
     (1
-     ;; File is outside root or excluded from it
+     ;; File is excluded from deployment
      (when (> verbose 0) (message (nth 1 response))))
     (2
      ;; File is a directory ignore
@@ -773,36 +777,39 @@
         (exclude-list (or exclude-list ssh-deploy-exclude-list)))
 
     ;; 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)))
+    (if (ssh-deploy--file-is-in-path-p path-local root-local)
+        (if (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))
+              ;; Is the file a regular file?
+              (if (not (file-directory-p path-local))
 
-              ;; Does remote file exists?
-              (if (file-exists-p path-remote)
+                  ;; Does remote file exists?
+                  (if (file-exists-p path-remote)
 
-                  ;; Does a local revision of the file exist?
-                  (if (file-exists-p revision-path)
+                      ;; Does a local revision of the file exist?
+                      (if (file-exists-p revision-path)
 
-                      (if (ediff-same-file-contents revision-path path-remote)
-                          (list 4 (format "Remote file '%s' has not changed." 
path-remote) path-local)
-                        (list 5 (format "Remote file '%s' has changed compared 
to local revision, please download or diff." path-remote) path-local 
revision-path))
+                          (if (ediff-same-file-contents revision-path 
path-remote)
+                              (list 4 (format "Remote file '%s' has not 
changed." path-remote) path-local)
+                            (list 5 (format "Remote file '%s' has changed 
compared to local revision, please download or diff." path-remote) path-local 
revision-path))
 
-                    (if (ediff-same-file-contents path-local path-remote)
-                        (list 6 (format "Remote file '%s' has not changed 
compared to local file, created local revision." path-remote) path-local 
revision-path)
-                      (list 7 (format "Remote file '%s' has changed compared 
to local file, please download or diff." path-remote) path-local path-remote)))
+                        (if (ediff-same-file-contents path-local path-remote)
+                            (list 6 (format "Remote file '%s' has not changed 
compared to local file, created local revision." path-remote) path-local 
revision-path)
+                          (list 7 (format "Remote file '%s' has changed 
compared to local file, please download or diff." path-remote) path-local 
path-remote)))
 
-                (list 3 (format "Remote file '%s' doesn't exist." path-remote) 
path-local))
+                    (list 3 (format "Remote file '%s' doesn't exist." 
path-remote) path-local))
 
-            ;; File is a directory
-            (list 2 (format "File '%s' is a directory, ignoring remote changes 
check." path-local) path-local)))
+                ;; File is a directory
+                (list 2 (format "File '%s' is a directory, ignoring remote 
changes check." path-local) path-local)))
 
-      ;; File is not inside root or is excluded from it
-      (list 1 (format "File '%s' is not in root or is excluded from it." 
path-local) path-local))))
+          ;; File is excluded from root
+          (list 1 (format "File '%s' is excluded from deployment." path-local) 
path-local))
+
+      ;; File is not inside root
+      (list 0 (format "File '%s' is not in root '%s'" path-local root-local) 
path-local))))
 
 ;;;###autoload
 (defun ssh-deploy-remote-changes (path-local &optional root-local root-remote 
async revision-folder exclude-list async-with-threads verbose)
@@ -1271,13 +1278,16 @@
   (interactive)
   (if ssh-deploy-script
       (if (> ssh-deploy-async 0)
-          (message "Executing of deployment-script starting... 
(asynchronously)")
-        (ssh-deploy--async-process
-         `(lambda() (let ((ssh-deploy-root-local ,ssh-deploy-root-local)
-                          (ssh-deploy-root-remote ,ssh-deploy-root-remote))
-                      (funcall ,ssh-deploy-script)))
-         (lambda(result) (message "Completed execution of deployment-script. 
Return: '%s' (asynchronously)" result))
-         ssh-deploy-async-with-threads)
+          (let ((root-local ssh-deploy-root-local)
+                (root-remote ssh-deploy-root-remote)
+                (script ssh-deploy-script))
+            (message "Executing of deployment-script starting... 
(asynchronously)")
+            (ssh-deploy--async-process
+             (lambda() (let ((ssh-deploy-root-local root-local)
+                             (ssh-deploy-root-remote root-remote))
+                         (funcall script)))
+             (lambda(result) (message "Completed execution of 
deployment-script. Return: '%s' (asynchronously)" result))
+             ssh-deploy-async-with-threads))
         (message "Executing of deployment-script starting... (synchronously)")
         (let ((ret (funcall ssh-deploy-script)))
           (message "Completed execution of deployment-script. Return: '%s' 
(synchronously)" ret)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]