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

   1 ;;; f90-tests.el --- Tests for f90-interface-browser
   2
   3 ;; Copyright (C) 2013  Free Software Foundation, Inc.
   4
   5 ;; This program is free software: you can redistribute it and/or modify
   6 ;; it under the terms of the GNU General Public License as published by
   7 ;; the Free Software Foundation, either version 3 of the License, or
   8 ;; (at your option) any later version.
   9
  10 ;; This program is distributed in the hope that it will be useful,
  11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;; GNU General Public License for more details.
  14
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with this program  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;; Code:
  19
  20 (require 'cl-lib)
  21
  22 ;; FIXME: Convert to use ERT.
  23
  24 (defvar *test-name* nil)
  25
  26 (defvar *test-tests* (make-hash-table :test 'eq))
  27
  28 (defvar *test-running-tests* nil)
  29 (defmacro deftest (name parameters &rest body)
  30   "Define a test function. Within a test function we can call
  31    other test functions or use `check' to run individual test
  32    cases."
  33   `(prog1 ',name
  34      (setf (gethash ',name *test-tests*)
  35            (lambda ,parameters
  36              (let ((*test-name* (append *test-name* (list ',name))))
  37                ,@body)))))
  38
  39 (defmacro test-check (&rest forms)
  40   "Run each expression in FORMS as a test case."
  41   `(test-combine-results
  42     ,@(cl-loop for (expr res) in forms
  43                collect `(test-report-result (equal (condition-case _
  44                                                        ,expr
  45                                                      (error (cl-gensym)))
  46                                                    ',res)
  47                                             ',expr ',res))))
  48
  49 (defmacro test-combine-results (&rest forms)
  50   "Combine the results (as booleans) of evaluating FORMS in order."
  51   (let ((result (make-symbol "result")))
  52     `(let ((,result t))
  53        ,@(cl-loop for f in forms collect `(unless ,f (setf ,result nil)))
  54        ,result)))
  55
  56 (defun test-report-result (result res req)
  57   "Report the results of a single test case. Called by `check'."
  58   (if result
  59       (insert (format "%s ... %S: %S\n"
  60                      (propertize "pass"
  61                                  'face '(:weight bold :foreground "green"))
  62                      *test-name* res))
  63     (insert (format "%s ... %S: %S is not %S\n"
  64                    (propertize "FAIL"
  65                                'face '(:weight bold :foreground "red"))
  66                    *test-name*
  67                    res req)))
  68   result)
  69
  70 (defun test-run-test (name)
  71   (with-current-buffer (get-buffer-create "*test-results*")
  72     (unless *test-running-tests*
  73       (erase-buffer))
  74     (let ((*test-running-tests* t))
  75       (funcall (gethash name *test-tests*)))
  76     (pop-to-buffer (current-buffer))))
  77
  78 (deftest type-modifiers ()
  79   (test-check
  80    ((f90-split-declaration "integer") ("integer"))
  81    ((f90-split-declaration "integer, pointer") ("integer" "pointer"))
  82    ((f90-split-declaration "integer (kind = c_int(8)   )") ("integer"))
  83    ((f90-split-declaration "character(len=*)") ("character"))
  84    ((f90-split-declaration "integer, dimension(:)")
  85     ("integer" ("dimension" . 1)))))
  86
  87 (deftest parse-declaration ()
  88   (cl-flet ((fun (str) (with-temp-buffer
  89                          (insert str)
  90                          (goto-char (point-min))
  91                          (f90-parse-single-type-declaration))))
  92     (test-check
  93      ((fun "integer :: name") (("name" "integer")))
  94      ((fun "integer :: name1, name2") (("name1" "integer")
  95                                        ("name2" "integer")))
  96      ((fun "integer, dimension(:) :: name1, name2(:, :)") (("name1" "integer"
  97                                                             ("dimension" . 1))
  98                                                            ("name2" "integer"
  99                                                             ("dimension" . 2))))
 100      ((fun "integer, pointer :: name(:, :)") (("name" "integer" "pointer"
 101                                                ("dimension" . 2))))
 102      ((fun "integer, pointer :: NAmE => null()") (("name" "integer" "pointer"))))))
 103
 104
 105 (deftest splits ()
 106   (test-check
 107    ((f90-count-commas ",") 1)
 108    ((f90-count-commas "(,)") 0)
 109    ((f90-count-commas "a, b, size(c, d)") 2)
 110    ((f90-count-commas "a, b, size(c, d)" 1) 3)
 111    ((f90-split-arglist "a,B") ("a" "b"))
 112    ((f90-split-arglist "foo, dimension(1, size(a, b))")
 113     ("foo" "dimension(1, size(a, b))"))
 114    ((f90-parse-names-list "a=1, B=>null()") ("a" "b"))))
 115
 116 (deftest all ()
 117   (test-combine-results
 118    (test-run-test 'type-modifiers)
 119    (test-run-test 'parse-declaration)
 120    (test-run-test 'splits)))