1 ;;; f90-tests.el --- Tests for f90-interface-browser
3 ;; Copyright (C) 2013 Free Software Foundation, Inc.
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.
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.
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/>.
22 ;; FIXME: Convert to use ERT.
24 (defvar *test-name* nil)
26 (defvar *test-tests* (make-hash-table :test 'eq))
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
34 (setf (gethash ',name *test-tests*)
36 (let ((*test-name* (append *test-name* (list ',name))))
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 _
49 (defmacro test-combine-results (&rest forms)
50 "Combine the results (as booleans) of evaluating 'forms' in order."
51 (let ((result (make-symbol "result")))
53 ,@(cl-loop for f in forms collect `(unless ,f (setf ,result nil)))
56 (defun test-report-result (result res req)
57 "Report the results of a single test case. Called by 'check'."
59 (insert (format "%s ... %S: %S\n"
61 'face '(:weight bold :foreground "green"))
63 (insert (format "%s ... %S: %S is not %S\n"
65 'face '(:weight bold :foreground "red"))
70 (defun test-run-test (name)
71 (with-current-buffer (get-buffer-create "*test-results*")
72 (unless *test-running-tests*
74 (let ((*test-running-tests* t))
75 (funcall (gethash name *test-tests*)))
76 (pop-to-buffer (current-buffer))))
78 (deftest type-modifiers ()
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)))))
87 (deftest parse-declaration ()
88 (cl-flet ((fun (str) (with-temp-buffer
90 (goto-char (point-min))
91 (f90-parse-single-type-declaration))))
93 ((fun "integer :: name") (("name" "integer")))
94 ((fun "integer :: name1, name2") (("name1" "integer")
96 ((fun "integer, dimension(:) :: name1, name2(:, :)") (("name1" "integer"
100 ((fun "integer, pointer :: name(:, :)") (("name" "integer" "pointer"
102 ((fun "integer, pointer :: NAmE => null()") (("name" "integer" "pointer"))))))
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"))))
117 (test-combine-results
118 (test-run-test 'type-modifiers)
119 (test-run-test 'parse-declaration)
120 (test-run-test 'splits)))