code.delx.au - gnu-emacs-elpa/blob - f90-tests.el

   1 (defvar *test-name* nil)
   2
   3 (defvar *test-tests* (make-hash-table :test 'eq))
   4
   5 (defvar *test-running-tests* nil)
   6 (defmacro deftest (name parameters &rest body)
   7   "Define a test function. Within a test function we can call
   8    other test functions or use 'check' to run individual test
   9    cases."
  10   `(prog1 ',name
  11      (setf (gethash ',name *test-tests*)
  12            (lambda ,parameters
  13              (let ((*test-name* (append *test-name* (list ',name))))
  14                ,@body)))))
  15
  16 (defmacro test-check (&rest forms)
  17   "Run each expression in 'forms' as a test case."
  18   `(test-combine-results
  19     ,@(loop for (expr res) in forms
  20             collect `(test-report-result (equal (condition-case err
  21                                                     ,expr
  22                                                   (error (gensym))) ',res)
  23                                          ',expr ',res))))
  24
  25 (defmacro test-combine-results (&rest forms)
  26   "Combine the results (as booleans) of evaluating 'forms' in order."
  27   (let ((result (make-symbol "result")))
  28     `(let ((,result t))
  29        ,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
  30        ,result)))
  31
  32 (defun test-report-result (result res req)
  33   "Report the results of a single test case. Called by 'check'."
  34   (if result
  35       (insert (format "%s ... %S: %S\n"
  36                      (propertize "pass"
  37                                  'face '(:weight bold :foreground "green"))
  38                      *test-name* res))
  39     (insert (format "%s ... %S: %S is not %S\n"
  40                    (propertize "FAIL"
  41                                'face '(:weight bold :foreground "red"))
  42                    *test-name*
  43                    res req)))
  44   result)
  45
  46 (defun test-run-test (name)
  47   (with-current-buffer (get-buffer-create "*test-results*")
  48     (unless *test-running-tests*
  49       (erase-buffer))
  50     (let ((*test-running-tests* t))
  51       (funcall (gethash name *test-tests*)))
  52     (pop-to-buffer (current-buffer))))
  53
  54 (deftest type-modifiers ()
  55   (test-check
  56    ((f90-split-declaration "integer") ("integer"))
  57    ((f90-split-declaration "integer, pointer") ("integer" "pointer"))
  58    ((f90-split-declaration "integer (kind = c_int(8)   )") ("integer"))
  59    ((f90-split-declaration "character(len=*)") ("character"))
  60    ((f90-split-declaration "integer, dimension(:)")
  61     ("integer" ("dimension" . 1)))))
  62
  63 (deftest parse-declaration ()
  64   (flet ((fun (str) (with-temp-buffer
  65                       (insert str)
  66                       (goto-char (point-min))
  67                       (f90-parse-single-type-declaration))))
  68     (test-check
  69      ((fun "integer :: name") (("name" "integer")))
  70      ((fun "integer :: name1, name2") (("name1" "integer")
  71                                        ("name2" "integer")))
  72      ((fun "integer, dimension(:) :: name1, name2(:, :)") (("name1" "integer"
  73                                                             ("dimension" . 1))
  74                                                            ("name2" "integer"
  75                                                             ("dimension" . 2))))
  76      ((fun "integer, pointer :: name(:, :)") (("name" "integer" "pointer"
  77                                                ("dimension" . 2))))
  78      ((fun "integer, pointer :: NAmE => null()") (("name" "integer" "pointer"))))))
  79
  80
  81 (deftest splits ()
  82   (test-check
  83    ((f90-count-commas ",") 1)
  84    ((f90-count-commas "(,)") 0)
  85    ((f90-count-commas "a, b, size(c, d)") 2)
  86    ((f90-count-commas "a, b, size(c, d)" 1) 3)
  87    ((f90-split-arglist "a,B") ("a" "b"))
  88    ((f90-split-arglist "foo, dimension(1, size(a, b))")
  89     ("foo" "dimension(1, size(a, b))"))
  90    ((f90-parse-names-list "a=1, B=>null()") ("a" "b"))))
  91
  92 (deftest all ()
  93   (test-combine-results
  94    (test-run-test 'type-modifiers)
  95    (test-run-test 'parse-declaration)
  96    (test-run-test 'splits)))