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

   1 ;;; ert-async.el --- Async support for ERT -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014 Johan Andersson
   4
   5 ;; Author: Johan Andersson <johan.rejeep@gmail.com>
   6 ;; Maintainer: Johan Andersson <johan.rejeep@gmail.com>
   7 ;; Version: 0.1.1
   8 ;; Keywords: test
   9 ;; URL: http://github.com/rejeep/ert-async.el
  10
  11 ;; This file is NOT part of GNU Emacs.
  12
  13 ;;; License:
  14
  15 ;; This program is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 3, or (at your option)
  18 ;; any later version.
  19
  20 ;; This program is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  28 ;; Boston, MA 02110-1301, USA.
  29
  30 ;;; Commentary:
  31
  32 ;;; Code:
  33
  34 (require 'ert)
  35
  36 (defvar ert-async-timeout 10
  37   "Number of seconds to wait for callbacks before failing.")
  38
  39 (defun ert-async-activate-font-lock-keywords ()
  40   "Activate font-lock keywords for `ert-deftest-async'."
  41   (font-lock-add-keywords
  42    nil
  43    '(("(\\(\\<ert-deftest\\(?:-async\\)?\\)\\>\\s *\\(\\(?:\\sw\\|\\s_\\)+\\)?"
  44       (1 font-lock-keyword-face nil t)
  45       (2 font-lock-function-name-face nil t)))))
  46
  47 (defmacro ert-deftest-async (name callbacks &rest body)
  48   "Like `ert-deftest' but with support for async.
  49
  50 NAME is the name of the test, which is the first argument to
  51 `ert-deftest'.
  52
  53 CALLBACKS is a list of callback functions that all must be called
  54 before `ert-async-timeout'.  If all callback functions have not
  55 been called before the timeout, the test fails.
  56
  57 The callback functions should be called without any argument.  If
  58 a callback function is called with a string as argument, the test
  59 will fail with that error string.
  60
  61 BODY is the actual test."
  62   (declare (indent 2))
  63   (let ((varlist
  64          (cons
  65           'callbacked
  66           (mapcar
  67            (lambda (callback)
  68              (list
  69               callback
  70               `(lambda (&optional error-message)
  71                  (if error-message
  72                      (ert-fail (format "Callback %s invoked with argument: %s" ',callback error-message))
  73                    (if (member ',callback callbacked)
  74                        (ert-fail (format "Callback %s called multiple times" ',callback))
  75                      (push ',callback callbacked))))))
  76            callbacks))))
  77     `(ert-deftest ,name ()
  78        (let* ,varlist
  79          (with-timeout
  80              (ert-async-timeout
  81               (ert-fail (format "Timeout of %ds exceeded" ert-async-timeout)))
  82            ,@body
  83            (while (not (equal (sort (mapcar 'symbol-name callbacked) 'string<)
  84                               (sort (mapcar 'symbol-name ',callbacks) 'string<)))
  85              (accept-process-output nil 0.05)))))))
  86
  87 (provide 'ert-async)
  88
  89 ;;; ert-async.el ends here