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 ,expr ',res)
  21                                          ',expr ',res))))
  22
  23 (defmacro test-combine-results (&rest forms)
  24   "Combine the results (as booleans) of evaluating 'forms' in order."
  25   (let ((result (make-symbol "result")))
  26     `(let ((,result t))
  27        ,@(loop for f in forms collect `(unless ,f (setf ,result nil)))
  28        ,result)))
  29
  30 (defun test-report-result (result res req)
  31   "Report the results of a single test case. Called by 'check'."
  32   (if result
  33       (insert (format "%s ... %S: %S\n"
  34                      (propertize "pass"
  35                                  'face '(:weight bold :foreground "green"))
  36                      *test-name* res))
  37     (insert (format "%s ... %S: %S is not %S\n"
  38                    (propertize "FAIL"
  39                                'face '(:weight bold :foreground "red"))
  40                    *test-name*
  41                    res req)))
  42   result)
  43
  44 (defun test-run-test (name)
  45   (with-current-buffer (get-buffer-create "*test-results*")
  46     (unless *test-running-tests*
  47       (erase-buffer))
  48     (let ((*test-running-tests* t))
  49       (funcall (gethash name *test-tests*)))
  50     (pop-to-buffer (current-buffer))))
  51
  52 (deftest type-modifiers ()
  53   (test-check
  54    ((f90-split-declaration "integer") ("integer"))
  55    ((f90-split-declaration "integer, pointer") ("integer" "pointer"))
  56    ((f90-split-declaration "character(len=*)") ("character"))
  57    ((f90-split-declaration "integer, dimension(:)")
  58     ("integer" ("dimension" . 1)))))
  59
  60 (deftest parse-declaration ()
  61   (flet ((fun (str) (with-temp-buffer
  62                       (insert str)
  63                       (goto-char (point-min))
  64                       (f90-parse-single-type-declaration))))
  65     (test-check
  66      ((fun "integer :: name") (("name" "integer")))
  67      ((fun "integer :: name1, name2") (("name1" "integer")
  68                                        ("name2" "integer")))
  69      ((fun "integer, dimension(:) :: name1, name2(:, :)") (("name1" "integer"
  70                                                             ("dimension" . 1))
  71                                                            ("name2" "integer"
  72                                                             ("dimension" . 2))))
  73      ((fun "integer, pointer :: NAmE => null()") (("name" "integer" "pointer"))))))
  74
  75
  76 (deftest splits ()
  77   (test-check
  78    ((f90-count-commas ",") 1)
  79    ((f90-count-commas "(,)") 0)
  80    ((f90-count-commas "a, b, size(c, d)") 2)
  81    ((f90-count-commas "a, b, size(c, d)" 1) 3)
  82    ((f90-split-arglist "a,B") ("a" "b"))
  83    ((f90-split-arglist "foo, dimension(1, size(a, b))")
  84     ("foo" "dimension(1, size(a, b))"))
  85    ((f90-parse-names-list "a=1, B=>null()") ("a" "b"))))
  86
  87 (deftest all ()
  88   (test-combine-results
  89    (test-run-test 'type-modifiers)
  90    (test-run-test 'parse-declaration)
  91    (test-run-test 'splits)))
  92