code.delx.au - gnu-emacs-elpa/blob - async-test.el

   1 ;;; async-test --- async.el-related tests
   2
   3 ;; Copyright (C) 2012 John Wiegley
   4
   5 ;; Author: John Wiegley <jwiegley@gmail.com>
   6 ;; Created: 10 Jul 2012
   7 ;; Version: 1.0
   8 ;; Keywords: async
   9 ;; X-URL: https://github.com/jwiegley/emacs-async
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 \f
  26 ;;; Commentary:
  27
  28 ;; Contains tests for all the async modules.
  29 \f
  30 ;;; Code:
  31
  32 (require 'async)
  33 (require 'async-file)
  34
  35 (eval-when-compile
  36   (require 'cl))
  37
  38 (defun async-test-1 ()
  39   (interactive)
  40   (message "Starting async-test-1...")
  41   (async-start
  42    ;; What to do in the child process
  43    (lambda ()
  44      (message "This is a test")
  45      (sleep-for 3)
  46      222)
  47
  48    ;; What to do when it finishes
  49    (lambda (result)
  50      (message "Async process done, result should be 222: %s" result)))
  51   (message "Starting async-test-1...done"))
  52
  53 (defun async-test-2 ()
  54   (interactive)
  55   (message "Starting async-test-2...")
  56   (let ((proc (async-start
  57                ;; What to do in the child process
  58                (lambda ()
  59                  (message "This is a test")
  60                  (sleep-for 3)
  61                  222))))
  62     (message "I'm going to do some work here")
  63     ;; ....
  64     (message "Async process done, result should be 222: %s"
  65              (async-get proc))))
  66
  67 (defun async-test-3 ()
  68   (interactive)
  69   (message "Starting async-test-3...")
  70   (async-start
  71    ;; What to do in the child process
  72    (lambda ()
  73      (message "This is a test")
  74      (sleep-for 3)
  75      (error "Error in child process")
  76      222)
  77
  78    ;; What to do when it finishes
  79    (lambda (result)
  80      (message "Async process done, result should be 222: %s" result)))
  81   (message "Starting async-test-1...done"))
  82
  83 (defun async-test-4 ()
  84   (interactive)
  85   (message "Starting async-test-4...")
  86   (async-start-process "sleep" "sleep"
  87                        ;; What to do when it finishes
  88                        (lambda (proc)
  89                          (message "Sleep done, exit code was %d"
  90                                   (process-exit-status proc)))
  91                        "3")
  92   (message "Starting async-test-4...done"))
  93
  94 (defun async-test-5 ()
  95   (interactive)
  96   (message "Starting async-test-5...")
  97   (let ((proc
  98          (async-start
  99           ;; What to do in the child process
 100           (lambda ()
 101             (message "This is a test, sending message")
 102             (async-send :hello "world")
 103             ;; wait for a message
 104             (let ((msg (async-receive)))
 105               (message "Child got message: %s"
 106                        (plist-get msg :goodbye)))
 107             (sleep-for 3)
 108             222)
 109
 110           ;; What to do when it finishes
 111           (lambda (result)
 112             (if (async-message-p result)
 113                 (message "Got hello from child process: %s"
 114                          (plist-get result :hello))
 115               (message "Async process done, result should be 222: %s"
 116                        result))))))
 117     (async-send proc :goodbye "everyone"))
 118   (message "Starting async-test-5...done"))
 119
 120 (defun async-test-6 ()
 121   (interactive)
 122   (message "Starting async-test-6...")
 123   (async-start
 124    ;; What to do in the child process
 125    `(lambda ()
 126       ,(async-inject-variables "\\`user-mail-address\\'")
 127       (format "user-mail-address = %s" user-mail-address))
 128
 129    ;; What to do when it finishes
 130    (lambda (result)
 131      (message "Async process done: %s" result))))
 132
 133 (defsubst async-file-contents (file)
 134   "Return the contents of FILE, as a string."
 135   (with-temp-buffer
 136     (insert-file-contents file)
 137     (buffer-string)))
 138
 139 (defun* async-do-copy-file-test (ok-if-already-exists
 140                                  keep-time preserve-uid-gid
 141                                  preserve-selinux-context
 142                                  &key use-native-commands
 143                                  synchronously)
 144   (let* ((temp-file (make-temp-file "async-do-copy-file-test"))
 145          (temp-file2 (concat temp-file ".target")))
 146     (unwind-protect
 147         (progn
 148           (with-temp-buffer
 149             (insert "async-do-copy-file-test")
 150             (write-region (point-min) (point-max) temp-file))
 151
 152           (let* ((async-file-use-native-commands use-native-commands)
 153                  (future (if synchronously
 154                              (copy-file temp-file temp-file2
 155                                         ok-if-already-exists
 156                                         keep-time
 157                                         preserve-uid-gid
 158                                         preserve-selinux-context)
 159                            (async-copy-file temp-file temp-file2
 160                                             ok-if-already-exists
 161                                             keep-time
 162                                             preserve-uid-gid
 163                                             preserve-selinux-context
 164                                             :callback nil))))
 165             (unless synchronously
 166               (if use-native-commands
 167                   (let ((proc (async-get future)))
 168                     (should (processp proc))
 169                     (should (equal 'exit (process-status proc))))
 170                 (should (equal (async-get future) nil))))
 171
 172             (should (file-readable-p temp-file2))
 173
 174             (should (equal "async-do-copy-file-test"
 175                            (async-file-contents temp-file2)))))
 176
 177       (if (file-exists-p temp-file)  (delete-file temp-file))
 178       (if (file-exists-p temp-file2) (delete-file temp-file2)))))
 179
 180 (ert-deftest async-copy-file-lisp-sync-1 ()
 181   (async-do-copy-file-test t t t nil :synchronously t))
 182 (ert-deftest async-copy-file-lisp-1 ()
 183   (async-do-copy-file-test t t t nil :use-native-commands nil))
 184 (ert-deftest async-copy-file-native-1 ()
 185   (async-do-copy-file-test t t t nil :use-native-commands t))
 186
 187 (defsubst async-file-make-temp-dir (prefix)
 188   "Make a temporary directory using PREFIX.
 189 Return the name of the directory."
 190   (let ((dir (make-temp-name
 191               (expand-file-name prefix temporary-file-directory))))
 192     (make-directory dir)
 193     dir))
 194
 195 (defsubst async-file-make-file (file contents)
 196   "Create a new FILE with the given CONTENTS."
 197   (with-temp-buffer
 198     (insert contents)
 199     (write-region (point-min) (point-max) file)))
 200
 201 (defun* async-do-copy-directory-test (keep-time parents copy-contents
 202                                                 &key use-native-commands
 203                                                 synchronously)
 204   (let* ((temp-dir (async-file-make-temp-dir "async-do-copy-directory-test"))
 205          (temp-dir2 (concat temp-dir ".target")))
 206     (unwind-protect
 207         (progn
 208           (async-file-make-file (expand-file-name "foo" temp-dir) "foo")
 209           (async-file-make-file (expand-file-name "bar" temp-dir) "bar")
 210
 211           ;; Shouldn't the parents argument cause this to happen when needed?
 212           ;; But if the following is wrapped with "unless parents", even
 213           ;; `async-copy-directory-lisp-sync-2' fails.
 214           (make-directory temp-dir2)
 215
 216           (let* ((async-file-use-native-commands use-native-commands)
 217                  (future (if synchronously
 218                              (copy-directory temp-dir temp-dir2
 219                                              keep-time
 220                                              parents
 221                                              copy-contents)
 222                            (async-copy-directory temp-dir temp-dir2
 223                                                  keep-time
 224                                                  parents
 225                                                  copy-contents
 226                                                  :callback nil))))
 227             (unless synchronously
 228               (if use-native-commands
 229                   (let ((proc (async-get future)))
 230                     (should (processp proc))
 231                     (should (equal 'exit (process-status proc))))
 232                 ;; Ignore the return value from `copy-directory'
 233                 (async-get future)))
 234
 235             (if (and parents copy-contents)
 236                 (should (file-directory-p temp-dir2)))
 237
 238             (let* ((target (if copy-contents
 239                                temp-dir2
 240                              (expand-file-name (file-name-nondirectory temp-dir)
 241                                                temp-dir2)))
 242                    (foo-file (expand-file-name "foo" target))
 243                    (bar-file (expand-file-name "bar" target)))
 244
 245               (should (file-readable-p foo-file))
 246               (should (file-readable-p bar-file))
 247
 248               (should (equal "foo" (async-file-contents foo-file)))
 249               (should (equal "bar" (async-file-contents bar-file))))))
 250
 251       (if (file-directory-p temp-dir)  (delete-directory temp-dir t))
 252       (if (file-directory-p temp-dir2) (delete-directory temp-dir2 t)))))
 253
 254 (ert-deftest async-copy-directory-lisp-sync-1 ()
 255   (async-do-copy-directory-test t nil nil :synchronously t))
 256 (ert-deftest async-copy-directory-lisp-sync-2 ()
 257   (async-do-copy-directory-test t t nil :synchronously t))
 258 (ert-deftest async-copy-directory-lisp-sync-3 ()
 259   (async-do-copy-directory-test t nil t :synchronously t))
 260 (ert-deftest async-copy-directory-lisp-sync-4 ()
 261   (async-do-copy-directory-test t t t :synchronously t))
 262
 263 (ert-deftest async-copy-directory-lisp-1 ()
 264   (async-do-copy-directory-test t nil nil :use-native-commands nil))
 265 (ert-deftest async-copy-directory-lisp-2 ()
 266   (async-do-copy-directory-test t t nil :use-native-commands nil))
 267 (ert-deftest async-copy-directory-lisp-3 ()
 268   (async-do-copy-directory-test t nil t :use-native-commands nil))
 269 (ert-deftest async-copy-directory-lisp-4 ()
 270   (async-do-copy-directory-test t t t :use-native-commands nil))
 271
 272 (ert-deftest async-copy-directory-native-1 ()
 273   (async-do-copy-directory-test t nil nil :use-native-commands t))
 274 (ert-deftest async-copy-directory-native-2 ()
 275   (async-do-copy-directory-test t t nil :use-native-commands t))
 276 (ert-deftest async-copy-directory-native-3 ()
 277   (async-do-copy-directory-test t nil t :use-native-commands t))
 278 (ert-deftest async-copy-directory-native-4 ()
 279   (async-do-copy-directory-test t t t :use-native-commands t))
 280
 281 (provide 'async-test)
 282
 283 ;;; async-test.el ends here