ltest

;; Include EUnit macros
(include-lib "eunit/include/eunit.hrl")

;;;===================================================================
;;; OTP 18 hacks
;;;===================================================================

(defmacro otp>=18? ()
  `(try
     (>= (list_to_integer (erlang:system_info 'otp_release)) 18)
     (catch (_ 'false))))

(defmacro assertion-failed ()
  `(if (otp>=18?) 'assert 'assertion_failed))

(defmacro assert-equal-failed ()
  `(if (otp>=18?) 'assertEqual 'assertEqual_failed))

(defmacro assert-not-equal-failed ()
  `(if (otp>=18?) 'assertNotEqual 'assertNotEqual_failed))

(defmacro assert-exception-failed ()
  `(if (otp>=18?) 'assertException 'assertException_failed))

(defmacro assert-match-failed ()
  `(if (otp>=18?) 'assertMatch 'assertMatch_failed))

;;;===================================================================
;;; Helper functions
;;;===================================================================

(eval-when-compile

  (defun to-unders (atm)
    (re:replace (atom_to_list atm) "-" "_" '(#(return list) global)))

  (defun list-body
    ((body) (when (is_list body))
     body)
    ((body)
     (list body)))

  ) ; end of eval-when-compile

;;;===================================================================
;;; Test definition macros
;;;===================================================================

(defmacro deftest
  "Define a standard EUnit test."
  ((name . body)
   (let ((name_test (list_to_atom (++ (to-unders name) "_test"))))
     `(progn (defun ,name_test () ,@body)
             (extend-module () ((export (,name_test 0))))))))

(defmacro deftestgen
  "Define an EUnit test that uses test generators."
  ((name . body)
   (let ((name_test_ (list_to_atom (++ (to-unders name) "_test_"))))
     `(progn (defun ,name_test_ () ,@body)
             (extend-module () ((export (,name_test_ 0))))))))

(defmacro deftestskip
  "Define a standard EUnit test that will be skipped (not run)."
  ((name . body)
   `(defun ,(list_to_atom (++ (to-unders name) "_skip")) ()
      ,@body)))


;;;===================================================================
;;; Set-up and tear-down macros
;;;===================================================================

(defmacro defsetup (func-name)
  "Return a nullary function that calls `func-name/0`.

  A simple wrapper macro for defining the set-up function in a fixture."
  `(lambda () (,func-name)))

(defmacro defteardown (func-name)
  "Return a unary function that calls `func-name/1` on its argument.

  A simple wrapper macro for defining the tear-down function in a fixture."
  `(lambda (x) (,func-name x)))


;;;===================================================================
;;; Test case macros
;;;===================================================================

(eval-when-compile
  ;;Return true if we have (tuple "name"...) or #("Name"...)
  (defun is-named-tuple
    ((t) (when (is_tuple t))
      (io_lib:printable_list (element 1 t)))
    ((t) (when (is_list t))
      (andalso (== 'tuple (hd t))
               (io_lib:printable_list (cadr t))))
    ((other) 'false))

  ;;Return (tuple "Name" lambda() ...) from (tuple "Name" ...)
  (defun mk-named-tuple
    ((t) (when (is_tuple t))
      `(tuple ,(element 1 t)
              (lambda ()
                ,(list_to_tuple (tl (tuple_to_list t))))))
    ((t) (when (is_list t))
      `(tuple ,(cadr t)
              (lambda ()
                ,(list_to_tuple (cdr t)))))))

(defmacro deftestcase
  "This macro is for defining EUnit tests for use by fixtures which have
  particular naming convention needs."
  ((func-name args . rest)
   `(defun ,(list_to_atom (++ (to-unders func-name) "_test_case")) (,@args)
      (list
        ,@(lists:map
            (lambda (part)
              (if (is-named-tuple part)
                ;Make a named tuple if part is a tuple and its
                ;1st element is printable
                (mk-named-tuple part)
                ;Otherwise just make a lamdba
                `(lambda () ,part)))
            rest)))))

(defmacro deftestcases funcs
  "This macro expects one or more function *names* which have been defined
  using [[deftestcase/255]].

  Note that this macro is not composable with (deftestcase ...); you must
  define the test case and then only pass the test case name to this
  macro."
  (cond ((> (length funcs) 1)
         `(list
           ,@(lists:map
              (lambda (func-name)
                `(lambda (x)
                   (,(list_to_atom (++ (to-unders func-name) "_test_case")) x)))
              funcs)))
        ('true
         `(lambda (x)
            (,(list_to_atom (++ (to-unders (car funcs)) "_test_case")) x)))))


;;;===================================================================
;;; Assertion macros
;;;===================================================================

(defmacro is (bool-expression)
  "Assert `bool-expression` evaluates to `'true`."
  `(assert ,bool-expression))

(defmacro is-not (bool-expression)
  "Assert `bool-expression` evaluates to `'false`."
  `(assertNot ,bool-expression))

(defmacro is-match (guard expression)
  "Assert `guard` matches `expression`.

  The main reason to use [[is-match/2]], instead of matching with `=`,
  is that it produces more detailed error messages."
  `(assertMatch ,guard ,expression))

(defmacro is-not-match (guard expression)
  "The inverse case of [[is-match/2]], for convenience."
  `(assertNotMatch ,guard ,expression))

(defmacro is-equal (value expression)
  "Assert `expression` evaluates to `value`."
  `(assertEqual ,value ,expression))

(defmacro is-not-equal (value expression)
  "The inverse case of [[is-equal/2]], for convenience."
  `(assertNotEqual ,value ,expression))

(defmacro is-exception
  "Evaluate `expression`, catching any exception and testing that it matches
  `` `#(,expected-class ,expected-term) ``. If the match fails, or if no
  exception is thrown, an informative exception will be generated.

  [[is-error/2]], [[is-exit/2]] and [[is-throw/2]] are equivalent to using
  [[is-exception/3]] with an `expected-class` of `'error`, `'exit`, or
  `'throw`, respectively."
  ((expression)
   `(is-exception _ _ ,expression))
  ((expected-class expected-term expression)
   `(assertException ,expected-class ,expected-term ,expression)))

(defmacro is-not-exception
  "The inverse case of [[is-exception/3]], for convenience."
  ((expression)
   `(is-not-exception _ _ ,expression))
  ((expected-class expected-term expression)
   `(assertNotException ,expected-class ,expected-term ,expression)))

(defmacro is-error
  "Equivalent to [[is-exception/3]] with `'error` as `expected-class`."
  ((expression) `(is-error _ ,expression))
  ((error body) `(assertError ,error ,body)))

(defmacro is-not-error
  "The inverse case of [[is-error/2]], for convenience."
  ((expression)
   `(is-not-error _ ,expression))
  ((expected-term expression)
   `(is-not-exception 'error ,expected-term ,expression)))

(defmacro is-exit
  "Equivalent to [[is-exception/3]] with `'exit` as `expected-class`."
  ((expression)               `(is-exit _ ,expression))
  ((expected-term expression) `(assertExit ,expected-term ,expression)))

(defmacro is-not-exit
  "The inverse case of [[is-exit/2]], for convenience."
  ((expression)
   `(is-not-exit _ ,expression))
  ((expected-term expression)
   `(is-not-exception 'exit ,expected-term ,expression)))

(defmacro is-throw
  "Equivalent to [[is-exception/3]] with `'throw` as `expected-class`."
  ((expression)               `(is-throw _ ,expression))
  ((expected-term expression) `(assertThrow ,expected-term ,expression)))

(defmacro is-not-throw
  "The inverse case of [[is-throw/2]], for convenience."
  ((expression)
   `(is-not-throw _ ,expression))
  ((expected-term expression)
   `(is-not-exception 'throw ,expected-term ,expression)))

;;;===================================================================
;;; Test object macros
;;;===================================================================

(defmacro is* (bool-expression)
  "Return a test object that wraps [[is/1]]."
  `(_assert ,bool-expression))

(defmacro is-not* (bool-expression)
  "Return a test object that wraps [[is-not/2]]."
  `(_assertNot ,bool-expression))

(defmacro is-match* (guard expression)
  "Return a test object that wraps [[is-match/2]]."
  `(_assertMatch ,guard ,expression))

(defmacro is-not-match* (guard expression)
  "The inverse case of [[is-match*/2]], for convenience."
  `(_assertMatch ,guard ,expression))

(defmacro is-equal* (value expression)
  "Return a test object to assert `expression` evaluates to `value`."
  `(_assertEqual ,value ,expression))

(defmacro is-not-equal* (value expression)
  "Return a test object to assert `expression` evaluates to `value`."
  `(_assertNotEqual ,value ,expression))

(defmacro is-exception*
  "Return a test object that wraps [[is-exception/3]]."
  ((expression)
   `(is-exception* _ _ ,expression))
  ((expected-class expected-term expression)
   `(_assertException ,expected-class ,expected-term ,expression)))

(defmacro is-not-exception*
  "The inverse case of [[is-exception*/3]], for convenience."
  ((expression)
   `(is-not-exception* _ _ ,expression))
  ((expected-class expected-term expression)
   `(_assertNotException ,expected-class ,expected-term ,expression)))

(defmacro is-error*
  "Return a test object that wraps [[is-error/2]]."
  ((expression) `(is-error* _ ,expression))
  ((error body) `(_assertError ,error ,body)))

(defmacro is-not-error*
  "Return a test object that wraps [[is-not-error/2]]."
  ((expression) `(is-not-error* _ ,expression))
  ((error body) `(_test (is-not-error ,error ,body))))

(defmacro is-exit*
  "Return a test object that wraps [[is-exit/2]]"
  ((expression)               `(is-exit* _ ,expression))
  ((expected-term expression) `(_assertExit ,expected-term ,expression)))

(defmacro is-not-exit* (expected-term expression)
  "Return a test object that wraps [[is-not-exit/2]]."
  ((expression)         `(is-not-exit* _ ,expression))
  ((expected-term body) `(_test (is-not-exit ,expected-term ,expression))))

(defmacro is-throw* (expected-term expression)
  "Return a test object that wraps [[is-throw/2]]."
  ((expression)         `(is-throw* _ ,expression))
  ((expected-term body) `(_assertThrow ,expected-term ,expression)))

(defmacro is-not-throw* (expected-term expression)
  "Return a test object that wraps [[is-not-throw/2]]."
  ((expression)
   `(is-not-throw* _ ,expression))
  ((expected-term body)
   `(_test (is-not-throw 'throw ,expected-term ,expression))))

(defun loaded-ltest-macros ()
  "This is just a dummy function for display purposes when including from the
  REPL (the last function loaded has its name printed in stdout).

  This function needs to be the last one in this include."
  'ok)