-;;; async-test --- async.el-related tests
+;;; async-test.el --- async.el-related tests
-;; Copyright (C) 2012 John Wiegley
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: John Wiegley <jwiegley@gmail.com>
;; Created: 10 Jul 2012
;;; Code:
(require 'async)
-(require 'async-file)
+
(eval-when-compile
(require 'cl))
(lambda (result)
(message "Async process done: %s" result))))
-(defun async-test-7 ()
- (interactive)
- (message "Starting async-test-7...")
- (eval
- '(mapcar #'async-get
- (cl-loop repeat 2 collect
- (async-start (lambda () t))))
- t))
-
-(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))
-
-(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-test)
;;; async-test.el ends here
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End: