[elpa] master 3ac941a 042/187: Move async.el testing code into its own module

[Michael Albinus]

branch: master
commit 3ac941a784814d1b1be8e2e7e4497057b282d841
Author: John Wiegley <address@hidden>
Commit: John Wiegley <address@hidden>

    Move async.el testing code into its own module
---
 async-file.el                  |  150 +-----------------------------
 async-file.el => async-test.el |  203 ++++++++++++++++++++--------------------
 async.el                       |   95 -------------------
 3 files changed, 102 insertions(+), 346 deletions(-)

diff --git a/async-file.el b/async-file.el
index 10e8929..7b52265 100644
--- a/async-file.el
+++ b/async-file.el
@@ -1,4 +1,4 @@
-;;; async --- Asynchronous file operations
+;;; async-file --- Asynchronous file operations
 
 ;; Copyright (C) 2012 John Wiegley
 
@@ -92,60 +92,6 @@ a process object otherwise) when the copy is done."
                                   preserve-selinux-context)
                  callback)))
 
-(defsubst async-file-contents (file)
-  "Return the contents of FILE, as a string."
-  (with-temp-buffer
-    (insert-file-contents file)
-    (buffer-string)))
-
-(defun* async-do-copy-file-test (ok-if-already-exists
-                                 keep-time preserve-uid-gid
-                                 preserve-selinux-context
-                                 &key use-native-commands
-                                 synchronously)
-  (let* ((temp-file (make-temp-file "async-do-copy-file-test"))
-         (temp-file2 (concat temp-file ".target")))
-    (unwind-protect
-        (progn
-          (with-temp-buffer
-            (insert "async-do-copy-file-test")
-            (write-region (point-min) (point-max) temp-file))
-
-          (let* ((async-file-use-native-commands use-native-commands)
-                 (future (if synchronously
-                             (copy-file temp-file temp-file2
-                                        ok-if-already-exists
-                                        keep-time
-                                        preserve-uid-gid
-                                        preserve-selinux-context)
-                           (async-copy-file temp-file temp-file2
-                                            ok-if-already-exists
-                                            keep-time
-                                            preserve-uid-gid
-                                            preserve-selinux-context
-                                            :callback nil))))
-            (unless synchronously
-              (if use-native-commands
-                  (let ((proc (async-get future)))
-                    (should (processp proc))
-                    (should (equal 'exit (process-status proc))))
-                (should (equal (async-get future) nil))))
-
-            (should (file-readable-p temp-file2))
-
-            (should (equal "async-do-copy-file-test"
-                           (async-file-contents temp-file2)))))
-
-      (if (file-exists-p temp-file)  (delete-file temp-file))
-      (if (file-exists-p temp-file2) (delete-file temp-file2)))))
-
-(ert-deftest async-copy-file-lisp-sync-1 ()
-  (async-do-copy-file-test t t t nil :synchronously t))
-(ert-deftest async-copy-file-lisp-1 ()
-  (async-do-copy-file-test t t t nil :use-native-commands nil))
-(ert-deftest async-copy-file-native-1 ()
-  (async-do-copy-file-test t t t nil :use-native-commands t))
-
 (defun* async-copy-directory
     (directory newname
                &optional keep-time parents copy-contents
@@ -185,100 +131,6 @@ the copy is done."
                                   copy-contents)
                  callback)))
 
-(defsubst async-file-make-temp-dir (prefix)
-  "Make a temporary directory using PREFIX.
-Return the name of the directory."
-  (let ((dir (make-temp-name
-              (expand-file-name prefix temporary-file-directory))))
-    (make-directory dir)
-    dir))
-
-(defsubst async-file-make-file (file contents)
-  "Create a new FILE with the given CONTENTS."
-  (with-temp-buffer
-    (insert contents)
-    (write-region (point-min) (point-max) file)))
-
-(defun* async-do-copy-directory-test (keep-time parents copy-contents
-                                                &key use-native-commands
-                                                synchronously)
-  (let* ((temp-dir (async-file-make-temp-dir "async-do-copy-directory-test"))
-         (temp-dir2 (concat temp-dir ".target")))
-    (unwind-protect
-        (progn
-          (async-file-make-file (expand-file-name "foo" temp-dir) "foo")
-          (async-file-make-file (expand-file-name "bar" temp-dir) "bar")
-
-          ;; Shouldn't the parents argument cause this to happen when needed?
-          ;; But if the following is wrapped with "unless parents", even
-          ;; `async-copy-directory-lisp-sync-2' fails.
-          (make-directory temp-dir2)
-
-          (let* ((async-file-use-native-commands use-native-commands)
-                 (future (if synchronously
-                             (copy-directory temp-dir temp-dir2
-                                             keep-time
-                                             parents
-                                             copy-contents)
-                           (async-copy-directory temp-dir temp-dir2
-                                                 keep-time
-                                                 parents
-                                                 copy-contents
-                                                 :callback nil))))
-            (unless synchronously
-              (if use-native-commands
-                  (let ((proc (async-get future)))
-                    (should (processp proc))
-                    (should (equal 'exit (process-status proc))))
-                ;; Ignore the return value from `copy-directory'
-                (async-get future)))
-
-            (if (and parents copy-contents)
-                (should (file-directory-p temp-dir2)))
-
-            (let* ((target (if copy-contents
-                               temp-dir2
-                             (expand-file-name (file-name-nondirectory 
temp-dir)
-                                               temp-dir2)))
-                   (foo-file (expand-file-name "foo" target))
-                   (bar-file (expand-file-name "bar" target)))
-
-              (should (file-readable-p foo-file))
-              (should (file-readable-p bar-file))
-
-              (should (equal "foo" (async-file-contents foo-file)))
-              (should (equal "bar" (async-file-contents bar-file))))))
-
-      (if (file-directory-p temp-dir)  (delete-directory temp-dir t))
-      (if (file-directory-p temp-dir2) (delete-directory temp-dir2 t)))))
-
-(ert-deftest async-copy-directory-lisp-sync-1 ()
-  (async-do-copy-directory-test t nil nil :synchronously t))
-(ert-deftest async-copy-directory-lisp-sync-2 ()
-  (async-do-copy-directory-test t t nil :synchronously t))
-(ert-deftest async-copy-directory-lisp-sync-3 ()
-  (async-do-copy-directory-test t nil t :synchronously t))
-(ert-deftest async-copy-directory-lisp-sync-4 ()
-  (async-do-copy-directory-test t t t :synchronously t))
-
-(ert-deftest async-copy-directory-lisp-1 ()
-  (async-do-copy-directory-test t nil nil :use-native-commands nil))
-(ert-deftest async-copy-directory-lisp-2 ()
-  (async-do-copy-directory-test t t nil :use-native-commands nil))
-(ert-deftest async-copy-directory-lisp-3 ()
-  (async-do-copy-directory-test t nil t :use-native-commands nil))
-(ert-deftest async-copy-directory-lisp-4 ()
-  (async-do-copy-directory-test t t t :use-native-commands nil))
-
-(ert-deftest async-copy-directory-native-1 ()
-  (async-do-copy-directory-test t nil nil :use-native-commands t))
-(ert-deftest async-copy-directory-native-2 ()
-  (async-do-copy-directory-test t t nil :use-native-commands t))
-(ert-deftest async-copy-directory-native-3 ()
-  (async-do-copy-directory-test t nil t :use-native-commands t))
-(ert-deftest async-copy-directory-native-4 ()
-  (async-do-copy-directory-test t t t :use-native-commands t))
-
 (provide 'async-file)
 
 ;;; async-file.el ends here
diff --git a/async-file.el b/async-test.el
similarity index 65%
copy from async-file.el
copy to async-test.el
index 10e8929..379cdf9 100644
--- a/async-file.el
+++ b/async-test.el
@@ -1,4 +1,4 @@
-;;; async --- Asynchronous file operations
+;;; async-test --- async.el-related tests
 
 ;; Copyright (C) 2012 John Wiegley
 
@@ -25,72 +25,110 @@
 
 ;;; Commentary:
 
-;; Provides asynchronous versions of the following operations:
-;;
-;;   Function                 Command equivalent
-;;   -----------------------  ---------------------------------
-;;   copy-file                cp
-;;   copy-directory           cp -R
-;;   rename-file              mv
-;;   delete-file              rm
-;;   delete-directory         rm -r
-;;
-;; Additional features:
-;;
-;; - If `async-file-use-native-commands' is non-nil, and none of the files
-;;   involved are `file-remote-p', the native command equivalents are used
-;;   above rather than spawning a child Emacs to call the related function.
-;;
-;; - Operations are queued, so that only one asynchronous operation is
-;;   performed at one time.  If an error occurs while processing the queue,
-;;   the whole queue is aborted.
+;; Contains tests for all the async modules.
 
 ;;; Code:
 
+(require 'async)
+(require 'async-file)
+
 (eval-when-compile
   (require 'cl))
 
-(defgroup async-file nil
-  "Asynchronous file processing using async.el"
-  :group 'async)
-
-(defcustom async-file-use-native-commands nil
-  "If non-nil, use native cp/mv/rm commands for local-only files."
-  :type 'boolean
-  :group 'async-file)
-
-(defvar async-file-queue nil
-  "Queue of pending asynchronous file operations.
-Each operation that succeeds will start the next member of the queue.  If an
-error occurs at any point, the rest of the queue is flushed.")
-(defvar async-file-queue-mutex nil)
-
-(defun* async-copy-file
-    (file newname
-          &optional ok-if-already-exists keep-time
-          preserve-uid-gid preserve-selinux-context
-          &key (callback 'ignore))
-  "Asynchronous version of `copy-file'.
-Accepts a key argument `:callback' which takes a lambda that
-receives the return value from `copy-file' (nil if Lisp was used,
-a process object otherwise) when the copy is done."
-  (if (and async-file-use-native-commands
-           (not (or (file-remote-p file)
-                    (file-remote-p newname))))
-
-      (let ((args (list "-f" file newname)))
-        (if keep-time
-            (setq args (cons "-p" args)))
-        (unless ok-if-already-exists
-          (setq args (cons "-n" args)))
-        (apply #'async-start-process "cp" (executable-find "cp")
-               callback args))
-
-    (async-start (apply-partially #'copy-file
-                                  file newname ok-if-already-exists
-                                  keep-time preserve-uid-gid
-                                  preserve-selinux-context)
-                 callback)))
+(defun async-test-1 ()
+  (interactive)
+  (message "Starting async-test-1...")
+  (async-start
+   ;; What to do in the child process
+   (lambda ()
+     (message "This is a test")
+     (sleep-for 3)
+     222)
+
+   ;; What to do when it finishes
+   (lambda (result)
+     (message "Async process done, result should be 222: %s" result)))
+  (message "Starting async-test-1...done"))
+
+(defun async-test-2 ()
+  (interactive)
+  (message "Starting async-test-2...")
+  (let ((proc (async-start
+               ;; What to do in the child process
+               (lambda ()
+                 (message "This is a test")
+                 (sleep-for 3)
+                 222))))
+    (message "I'm going to do some work here")
+    ;; ....
+    (message "Async process done, result should be 222: %s"
+             (async-get proc))))
+
+(defun async-test-3 ()
+  (interactive)
+  (message "Starting async-test-3...")
+  (async-start
+   ;; What to do in the child process
+   (lambda ()
+     (message "This is a test")
+     (sleep-for 3)
+     (error "Error in child process")
+     222)
+
+   ;; What to do when it finishes
+   (lambda (result)
+     (message "Async process done, result should be 222: %s" result)))
+  (message "Starting async-test-1...done"))
+
+(defun async-test-4 ()
+  (interactive)
+  (message "Starting async-test-4...")
+  (async-start-process "sleep" "sleep"
+                       ;; What to do when it finishes
+                       (lambda (proc)
+                         (message "Sleep done, exit code was %d"
+                                  (process-exit-status proc)))
+                       "3")
+  (message "Starting async-test-4...done"))
+
+(defun async-test-5 ()
+  (interactive)
+  (message "Starting async-test-5...")
+  (let ((proc
+         (async-start
+          ;; What to do in the child process
+          (lambda ()
+            (message "This is a test, sending message")
+            (async-send :hello "world")
+            ;; wait for a message
+            (let ((msg (async-receive)))
+              (message "Child got message: %s"
+                       (plist-get msg :goodbye)))
+            (sleep-for 3)
+            222)
+
+          ;; What to do when it finishes
+          (lambda (result)
+            (if (async-message-p result)
+                (message "Got hello from child process: %s"
+                         (plist-get result :hello))
+              (message "Async process done, result should be 222: %s"
+                       result))))))
+    (async-send proc :goodbye "everyone"))
+  (message "Starting async-test-5...done"))
+
+(defun async-test-6 ()
+  (interactive)
+  (message "Starting async-test-6...")
+  (async-start
+   ;; What to do in the child process
+   `(lambda ()
+      ,(async-inject-variables "\\`user-mail-address\\'")
+      (format "user-mail-address = %s" user-mail-address))
+
+   ;; What to do when it finishes
+   (lambda (result)
+     (message "Async process done: %s" result))))
 
 (defsubst async-file-contents (file)
   "Return the contents of FILE, as a string."
@@ -146,45 +184,6 @@ a process object otherwise) when the copy is done."
 (ert-deftest async-copy-file-native-1 ()
   (async-do-copy-file-test t t t nil :use-native-commands t))
 
-(defun* async-copy-directory
-    (directory newname
-               &optional keep-time parents copy-contents
-               &key (callback 'ignore))
-  "Asynchronous version of `copy-directory'.
-Accepts a key argument `:callback' which takes a lambda that
-receives the return value from `copy-directory' (always nil) when
-the copy is done."
-  (if (and async-file-use-native-commands
-           (not (or (file-remote-p directory)
-                    (file-remote-p newname))))
-      (progn
-        (if parents
-            (let ((dest-dir (if copy-contents
-                                (file-name-directory newname)
-                              newname)))
-              (unless (file-directory-p dest-dir)
-                (message "Creating directory '%s'" dest-dir)
-                (make-directory dest-dir t))))
-
-        (if copy-contents
-            (let ((args (list "-r" (file-name-as-directory directory)
-                              (file-name-as-directory newname))))
-              (if keep-time
-                  (setq args (cons "-a" args)))
-              (apply #'async-start-process "rsync" (executable-find "rsync")
-                     callback args))
-
-          (let ((args (list "-fR" directory newname)))
-            (if keep-time
-                (setq args (cons "-p" args)))
-            (apply #'async-start-process "cp" (executable-find "cp")
-                   callback args))))
-
-    (async-start (apply-partially #'copy-directory
-                                  directory newname keep-time parents
-                                  copy-contents)
-                 callback)))
-
 (defsubst async-file-make-temp-dir (prefix)
   "Make a temporary directory using PREFIX.
 Return the name of the directory."
@@ -279,6 +278,6 @@ Return the name of the directory."
 (ert-deftest async-copy-directory-native-4 ()
   (async-do-copy-directory-test t t t :use-native-commands t))
 
-(provide 'async-file)
+(provide 'async-test)
 
-;;; async-file.el ends here
+;;; async-test.el ends here
diff --git a/async.el b/async.el
index 429d6ec..15966d2 100644
--- a/async.el
+++ b/async.el
@@ -281,101 +281,6 @@ returns nil.  It can still be useful, however, as an 
argument to
   "Evaluate FUNC in a separate Emacs process, synchronously."
   `(async-get (async-start ,func)))
 
-(defun async-test-1 ()
-  (interactive)
-  (message "Starting async-test-1...")
-  (async-start
-   ;; What to do in the child process
-   (lambda ()
-     (message "This is a test")
-     (sleep-for 3)
-     222)
-
-   ;; What to do when it finishes
-   (lambda (result)
-     (message "Async process done, result should be 222: %s" result)))
-  (message "Starting async-test-1...done"))
-
-(defun async-test-2 ()
-  (interactive)
-  (message "Starting async-test-2...")
-  (let ((proc (async-start
-               ;; What to do in the child process
-               (lambda ()
-                 (message "This is a test")
-                 (sleep-for 3)
-                 222))))
-    (message "I'm going to do some work here")
-    ;; ....
-    (message "Async process done, result should be 222: %s"
-             (async-get proc))))
-
-(defun async-test-3 ()
-  (interactive)
-  (message "Starting async-test-3...")
-  (async-start
-   ;; What to do in the child process
-   (lambda ()
-     (message "This is a test")
-     (sleep-for 3)
-     (error "Error in child process")
-     222)
-
-   ;; What to do when it finishes
-   (lambda (result)
-     (message "Async process done, result should be 222: %s" result)))
-  (message "Starting async-test-1...done"))
-
-(defun async-test-4 ()
-  (interactive)
-  (message "Starting async-test-4...")
-  (async-start-process "sleep" "sleep"
-                       ;; What to do when it finishes
-                       (lambda (proc)
-                         (message "Sleep done, exit code was %d"
-                                  (process-exit-status proc)))
-                       "3")
-  (message "Starting async-test-4...done"))
-
-(defun async-test-5 ()
-  (interactive)
-  (message "Starting async-test-5...")
-  (let ((proc
-         (async-start
-          ;; What to do in the child process
-          (lambda ()
-            (message "This is a test, sending message")
-            (async-send :hello "world")
-            ;; wait for a message
-            (let ((msg (async-receive)))
-              (message "Child got message: %s"
-                       (plist-get msg :goodbye)))
-            (sleep-for 3)
-            222)
-
-          ;; What to do when it finishes
-          (lambda (result)
-            (if (async-message-p result)
-                (message "Got hello from child process: %s"
-                         (plist-get result :hello))
-              (message "Async process done, result should be 222: %s"
-                       result))))))
-    (async-send proc :goodbye "everyone"))
-  (message "Starting async-test-5...done"))
-
-(defun async-test-6 ()
-  (interactive)
-  (message "Starting async-test-6...")
-  (async-start
-   ;; What to do in the child process
-   `(lambda ()
-      ,(async-inject-variables "\\`user-mail-address\\'")
-      (format "user-mail-address = %s" user-mail-address))
-
-   ;; What to do when it finishes
-   (lambda (result)
-     (message "Async process done: %s" result))))
-
 (provide 'async)
 
 ;;; async.el ends here