X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/ba705c61187e969a67ce59c38861154ce7144eec..228ec4bb351a9e14e338b9cb09eeb4809957c909:/async-test.el

diff --git a/async-test.el b/async-test.el
index b77fdd14a..76d6a3a96 100644
--- a/async-test.el
+++ b/async-test.el
@@ -1,6 +1,6 @@
-;;; 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
@@ -29,9 +29,8 @@
 
 ;;; Code:
 
-(add-to-list 'load-path (file-name-directory (or load-file-name (buffer-file-name))))
 (require 'async)
-(require 'async-file)
+
 
 (eval-when-compile
   (require 'cl))
@@ -131,225 +130,11 @@
    (lambda (result)
      (message "Async process done: %s" result))))
 
-(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)))))
-
-(defun async-do-start-func-value-type-test ()
-  ;; Variable
-  (set 'myfunc-var (lambda () t))
-  ;; Function symbol
-  (fset 'myfunc-fsym myfunc-var)
-  ;; Defun
-  (defun myfunc-defun () t)
-
-  (should-error (error "ERROR"))
-
-  (should (eq t (eval '(async-sandbox myfunc-var))))
-  (should-error (eval '(async-sandbox 'myfunc-var)))
-  (should-error (eval '(async-sandbox #'myfunc-var)))
-
-  (should-error (eval '(async-sandbox myfunc-fsym)))
-  (should (eq t (eval '(async-sandbox 'myfunc-fsym))))
-  (should (eq t (eval '(async-sandbox #'myfunc-fsym))))
-
-  (should-error (eval '(async-sandbox myfunc-defun)))
-  (should (eq t (eval '(async-sandbox 'myfunc-defun))))
-  (should (eq t (eval '(async-sandbox #'myfunc-defun))))
-
-  (should (eq t (eval '(async-sandbox (lambda () t)))))
-  (should (eq t (eval '(async-sandbox '(lambda () t)))))
-  (should (eq t (eval '(async-sandbox #'(lambda () t)))))
-
-  (should-error (eval '(async-sandbox (closure (t) () t))))
-  (should (eq t (eval '(async-sandbox '(closure (t) () t)))))
-  (should (eq t (eval '(async-sandbox #'(closure (t) () t))))))
-
-(defun async-do-lexbind-test ()
-  ;; The `cl-loop' macro creates some lexical variables, and in this
-  ;; case one of those variables (the one that collects the result)
-  ;; gets set to a list of process objects, which are unprintable. If
-  ;; `lexical-binding' is non-nil, this unprintable value is
-  ;; incorporated into the closures created by `lambda' within the
-  ;; loop. Closure prevention avoids the error from this unprintable
-  ;; lexical value in these examples.
-  (eval
-   '(progn
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start (lambda () t))))
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start '(lambda () t))))
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start #'(lambda () t))))
-       (mapcar #'async-get
-               (cl-loop repeat 2 collect
-                        (async-start `(lambda () ,(* 150 2))))))
-   t)
-  ;; However closure prevention also (obviously) prevents creation of
-  ;; lexical closures, leading to an error in this case.
-  (should
-   (eq 6
-       (eval
-        '(let ((x 1)
-               (y 2)
-               (z 3))
-           (async-sandbox (lambda () (+ x y z))))
-        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))
-
-(ert-deftest async-start-func-value-type-test ()
-  (async-do-start-func-value-type-test))
-
-(ert-deftest async-lexbind-test ()
-  (async-do-lexbind-test))
 
 (provide 'async-test)
 
 ;;; async-test.el ends here
+
+;; Local Variables:
+;; no-byte-compile: t
+;; End: