1;;
2;; %CopyrightBegin%
3;;
4;; Copyright Ericsson AB 2009-2020. All Rights Reserved.
5;;
6;; Licensed under the Apache License, Version 2.0 (the "License");
7;; you may not use this file except in compliance with the License.
8;; You may obtain a copy of the License at
9;;
10;;     http://www.apache.org/licenses/LICENSE-2.0
11;;
12;; Unless required by applicable law or agreed to in writing, software
13;; distributed under the License is distributed on an "AS IS" BASIS,
14;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15;; See the License for the specific language governing permissions and
16;; limitations under the License.
17;;
18;; %CopyrightEnd%
19;;;
20;;; Purpose: Provide EUnit utilities.
21;;;
22;;; Author: Klas Johansson
23
24(eval-when-compile
25  (require 'cl-lib))
26(require 'erlang)
27
28(defvar erlang-eunit-src-candidate-dirs '("../src" ".")
29  "*Name of directories which to search for source files matching
30an EUnit test file.  The first directory in the list will be used,
31if there is no match.")
32
33(defvar erlang-eunit-test-candidate-dirs '("../test" ".")
34  "*Name of directories which to search for EUnit test files matching
35a source file.  The first directory in the list will be used,
36if there is no match.")
37
38(defvar erlang-eunit-autosave nil
39  "*Set to non-nil to automtically save unsaved buffers before running tests.
40This is useful, reducing the save-compile-load-test cycle to one keychord.")
41
42(defvar erlang-eunit-recent-info '((mode . nil) (module . nil) (test . nil) (cover . nil))
43  "Info about the most recent running of an EUnit test representation.")
44
45(defvar erlang-error-regexp-alist
46  '(("^\\([^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" . (1 2)))
47  "*Patterns for matching Erlang errors.")
48
49;;;
50;;; Switch between src/EUnit test buffers
51;;;
52(defun erlang-eunit-toggle-src-and-test-file-other-window ()
53  "Switch to the src file if the EUnit test file is the current
54buffer and vice versa"
55  (interactive)
56  (if (erlang-eunit-test-file-p buffer-file-name)
57      (erlang-eunit-open-src-file-other-window buffer-file-name)
58    (erlang-eunit-open-test-file-other-window buffer-file-name)))
59
60;;;
61;;; Open the EUnit test file which corresponds to a src file
62;;;
63(defun erlang-eunit-open-test-file-other-window (src-file-path)
64  "Open the EUnit test file which corresponds to a src file"
65  (find-file-other-window (erlang-eunit-test-filename src-file-path)))
66
67;;;
68;;; Open the src file which corresponds to the an EUnit test file
69;;;
70(defun erlang-eunit-open-src-file-other-window (test-file-path)
71  "Open the src file which corresponds to the an EUnit test file"
72  (find-file-other-window (erlang-eunit-src-filename test-file-path)))
73
74;;; Return the name and path of the EUnit test file
75;;, (input may be either the source filename itself or the EUnit test filename)
76(defun erlang-eunit-test-filename (file-path)
77  (if (erlang-eunit-test-file-p file-path)
78      file-path
79    (erlang-eunit-rewrite-filename file-path erlang-eunit-test-candidate-dirs)))
80
81;;; Return the name and path of the source file
82;;, (input may be either the source filename itself or the EUnit test filename)
83(defun erlang-eunit-src-filename (file-path)
84  (if (erlang-eunit-src-file-p file-path)
85      file-path
86    (erlang-eunit-rewrite-filename file-path erlang-eunit-src-candidate-dirs)))
87
88;;; Rewrite a filename from the src or test filename to the other
89(defun erlang-eunit-rewrite-filename (orig-file-path candidate-dirs)
90  (or (erlang-eunit-locate-buddy orig-file-path candidate-dirs)
91      (erlang-eunit-buddy-file-path orig-file-path (car candidate-dirs))))
92
93;;; Search for a file's buddy file (a source file's EUnit test file,
94;;; or an EUnit test file's source file) in a list of candidate
95;;; directories.
96(defun erlang-eunit-locate-buddy (orig-file-path candidate-dirs)
97  (when candidate-dirs
98    (let ((buddy-file-path (erlang-eunit-buddy-file-path
99                            orig-file-path
100                            (car candidate-dirs))))
101      (if (file-readable-p buddy-file-path)
102          buddy-file-path
103        (erlang-eunit-locate-buddy orig-file-path (cdr candidate-dirs))))))
104
105(defun erlang-eunit-buddy-file-path (orig-file-path buddy-dir-name)
106  (let* ((orig-dir-name   (file-name-directory orig-file-path))
107         (buddy-dir-name  (file-truename
108                           (filename-join orig-dir-name buddy-dir-name)))
109         (buddy-base-name (erlang-eunit-buddy-basename orig-file-path)))
110    (filename-join buddy-dir-name buddy-base-name)))
111
112;;; Return the basename of the buddy file:
113;;;     /tmp/foo/src/x.erl        --> x_tests.erl
114;;;     /tmp/foo/test/x_tests.erl --> x.erl
115(defun erlang-eunit-buddy-basename (file-path)
116  (let ((src-module-name (erlang-eunit-source-module-name file-path)))
117    (cond
118     ((erlang-eunit-src-file-p file-path)
119      (concat src-module-name "_tests.erl"))
120     ((erlang-eunit-test-file-p file-path)
121      (concat src-module-name ".erl")))))
122
123;;; Checks whether a file is a source file or not
124(defun erlang-eunit-src-file-p (file-path)
125  (not (erlang-eunit-test-file-p file-path)))
126
127;;; Checks whether a file is a EUnit test file or not
128(defun erlang-eunit-test-file-p (file-path)
129  (erlang-eunit-string-match-p "^\\(.+\\)_tests.erl$" file-path))
130
131;;; Return the module name of the source file
132;;;     /tmp/foo/src/x.erl        --> x
133;;;     /tmp/foo/test/x_tests.erl --> x
134(defun erlang-eunit-source-module-name (file-path)
135  (interactive)
136  (let ((module-name (erlang-eunit-module-name file-path)))
137    (if (string-match "^\\(.+\\)_tests$" module-name)
138        (substring module-name (match-beginning 1) (match-end 1))
139      module-name)))
140
141;;; Return the module name of the file
142;;;     /tmp/foo/src/x.erl        --> x
143;;;     /tmp/foo/test/x_tests.erl --> x_tests
144(defun erlang-eunit-module-name (file-path)
145  (interactive)
146  (file-name-sans-extension (file-name-nondirectory file-path)))
147
148;;; Older emacsen don't have string-match-p.
149(defun erlang-eunit-string-match-p (regexp string &optional start)
150  (if (fboundp 'string-match-p) ;; appeared in emacs 23
151      (string-match-p regexp string start)
152    (save-match-data ;; fallback for earlier versions of emacs
153      (string-match regexp string start))))
154
155;;; Join filenames
156(defun filename-join (dir file)
157  (if (or (= (elt file 0) ?/)
158          (= (car (last (append dir nil))) ?/))
159      (concat dir file)
160    (concat dir "/" file)))
161
162;;; Get info about the most recent running of EUnit
163(defun erlang-eunit-recent (key)
164  (cdr (assq key erlang-eunit-recent-info)))
165
166;;; Record info about the most recent running of EUnit
167;;; Known modes are 'module-mode and 'test-mode
168(defun erlang-eunit-record-recent (mode module test)
169  (setcdr (assq 'mode erlang-eunit-recent-info) mode)
170  (setcdr (assq 'module erlang-eunit-recent-info) module)
171  (setcdr (assq 'test erlang-eunit-recent-info) test))
172
173;;; Record whether the most recent running of EUnit included cover
174;;; compilation
175(defun erlang-eunit-record-recent-compile (under-cover)
176  (setcdr (assq 'cover erlang-eunit-recent-info) under-cover))
177
178;;; Determine options for EUnit.
179(defun erlang-eunit-opts ()
180  (if current-prefix-arg ", [verbose]" ""))
181
182;;; Determine current test function
183(defun erlang-eunit-current-test ()
184  (save-excursion
185    (erlang-end-of-function 1)
186    (erlang-beginning-of-function 1)
187    (erlang-name-of-function)))
188
189(defun erlang-eunit-simple-test-p (test-name)
190  (if (erlang-eunit-string-match-p "^\\(.+\\)_test$" test-name) t nil))
191
192(defun erlang-eunit-test-generator-p (test-name)
193  (if (erlang-eunit-string-match-p "^\\(.+\\)_test_$" test-name) t nil))
194
195;;; Run one EUnit test
196(defun erlang-eunit-run-test (module-name test-name)
197  (let ((command
198         (cond ((erlang-eunit-simple-test-p test-name)
199                (format "eunit:test({%s, %s}%s)."
200                        module-name test-name (erlang-eunit-opts)))
201               ((erlang-eunit-test-generator-p test-name)
202                (format "eunit:test({generator, %s, %s}%s)."
203                        module-name test-name (erlang-eunit-opts)))
204               (t (format "%% WARNING: '%s' is not a test function" test-name)))))
205    (erlang-eunit-record-recent 'test-mode module-name test-name)
206    (erlang-eunit-inferior-erlang-send-command command)))
207
208;;; Run EUnit tests for the current module
209(defun erlang-eunit-run-module-tests (module-name)
210  (let ((command (format "eunit:test(%s%s)." module-name (erlang-eunit-opts))))
211    (erlang-eunit-record-recent 'module-mode module-name nil)
212    (erlang-eunit-inferior-erlang-send-command command)))
213
214(defun erlang-eunit-compile-and-run-recent ()
215  "Compile the source and test files and repeat the most recent EUnit test run.
216
217With prefix arg, compiles for debug and runs tests with the verbose flag set."
218  (interactive)
219  (cl-case (erlang-eunit-recent 'mode)
220    ('test-mode
221     (erlang-eunit-compile-and-test
222      'erlang-eunit-run-test (list (erlang-eunit-recent 'module)
223                                   (erlang-eunit-recent 'test))))
224    ('module-mode
225     (erlang-eunit-compile-and-test
226      'erlang-eunit-run-module-tests (list (erlang-eunit-recent 'module))
227      (erlang-eunit-recent 'cover)))
228    (t (error "EUnit has not yet been run.  Please run a test first."))))
229
230(defun erlang-eunit-cover-compile ()
231  "Cover compile current module."
232  (interactive)
233  (let* ((erlang-compile-extra-opts
234          (append (list 'debug_info) erlang-compile-extra-opts))
235         (module-name
236          (erlang-add-quotes-if-needed
237           (erlang-eunit-module-name buffer-file-name)))
238         (compile-command
239          (format "cover:compile_beam(%s)." module-name)))
240    (erlang-compile)
241    (if (erlang-eunit-last-compilation-successful-p)
242        (erlang-eunit-inferior-erlang-send-command compile-command))))
243
244(defun erlang-eunit-analyze-coverage ()
245  "Analyze the data collected by cover tool for the module in the
246current buffer.
247
248Assumes that the module has been cover compiled prior to this
249call.  This function will do two things: print the number of
250covered and uncovered functions in the erlang shell and display a
251new buffer called *<module name> coverage* which shows the source
252code along with the coverage analysis results."
253  (interactive)
254  (let* ((module-name     (erlang-add-quotes-if-needed
255                           (erlang-eunit-module-name buffer-file-name)))
256         (tmp-filename    (make-temp-file "cover"))
257         (analyze-command (format "cover:analyze_to_file(%s, \"%s\"). "
258                                  module-name tmp-filename))
259         (buf-name        (format "*%s coverage*" module-name)))
260    (erlang-eunit-inferior-erlang-send-command analyze-command)
261    ;; The purpose of the following snippet is to get the result of the
262    ;; analysis from a file into a new buffer (or an old, if one with
263    ;; the specified name already exists).  Also we want the erlang-mode
264    ;; *and* view-mode to be enabled.
265    (save-excursion
266      (let ((buf (get-buffer-create (format "*%s coverage*" module-name))))
267        (set-buffer buf)
268        (setq buffer-read-only nil)
269        (insert-file-contents tmp-filename nil nil nil t)
270        (if (= (buffer-size) 0)
271            (kill-buffer buf)
272          ;; FIXME: this would be a good place to enable (emacs-mode)
273          ;;        to get some nice syntax highlighting in the
274          ;;        coverage report, but it doesn't play well with
275          ;;        flymake.  Leave it off for now.
276          (view-buffer buf))))
277    (delete-file tmp-filename)))
278
279(defun erlang-eunit-compile-and-run-current-test ()
280  "Compile the source and test files and run the current EUnit test.
281
282With prefix arg, compiles for debug and runs tests with the verbose flag set."
283  (interactive)
284  (let ((module-name (erlang-add-quotes-if-needed
285                      (erlang-eunit-module-name buffer-file-name)))
286        (test-name (erlang-eunit-current-test)))
287    (erlang-eunit-compile-and-test
288     'erlang-eunit-run-test (list module-name test-name))))
289
290(defun erlang-eunit-compile-and-run-module-tests ()
291  "Compile the source and test files and run all EUnit tests in the module.
292
293With prefix arg, compiles for debug and runs tests with the verbose flag set."
294  (interactive)
295  (let ((module-name (erlang-add-quotes-if-needed
296                      (erlang-eunit-source-module-name buffer-file-name))))
297    (erlang-eunit-compile-and-test
298     'erlang-eunit-run-module-tests (list module-name))))
299
300;;; Compile source and EUnit test file and finally run EUnit tests for
301;;; the current module
302(defun erlang-eunit-compile-and-test (test-fun test-args &optional under-cover)
303  "Compile the source and test files and run the EUnit test suite.
304
305If under-cover is set to t, the module under test is compile for
306code coverage analysis.  If under-cover is left out or not set,
307coverage analysis is disabled.  The result of the code coverage
308is both printed to the erlang shell (the number of covered vs
309uncovered functions in a module) and written to a buffer called
310*<module> coverage* (which shows the source code for the module
311and the number of times each line is covered).
312With prefix arg, compiles for debug and runs tests with the verbose flag set."
313  (erlang-eunit-record-recent-compile under-cover)
314  (let ((src-filename  (erlang-eunit-src-filename  buffer-file-name))
315        (test-filename (erlang-eunit-test-filename buffer-file-name)))
316
317    ;; The purpose of out-maneuvering `save-some-buffers', as is done
318    ;; below, is to ask the question about saving buffers only once,
319    ;; instead of possibly several: one for each file to compile,
320    ;; for instance for both x.erl and x_tests.erl.
321    (save-some-buffers erlang-eunit-autosave)
322    (cl-letf (((symbol-function 'save-some-buffers) #'ignore))
323
324      ;; Compilation of the source file is mandatory (the file must
325      ;; exist, otherwise the procedure is aborted).  Compilation of the
326      ;; test file on the other hand, is optional, since eunit tests may
327      ;; be placed in the source file instead.  Any compilation error
328      ;; will prevent the subsequent steps to be run (hence the `and')
329      (and (erlang-eunit-compile-file src-filename under-cover)
330           (if (file-readable-p test-filename)
331               (erlang-eunit-compile-file test-filename)
332             t)
333           (apply test-fun test-args)
334           (if under-cover
335               (with-current-buffer (find-file-noselect src-filename)
336                 (erlang-eunit-analyze-coverage)))))))
337
338(defun erlang-eunit-compile-and-run-module-tests-under-cover ()
339  "Compile the source and test files and run the EUnit test suite and measure
340code coverage.
341
342With prefix arg, compiles for debug and runs tests with the verbose flag set."
343  (interactive)
344  (let ((module-name (erlang-add-quotes-if-needed
345                      (erlang-eunit-source-module-name buffer-file-name))))
346    (erlang-eunit-compile-and-test
347     'erlang-eunit-run-module-tests (list module-name) t)))
348
349(defun erlang-eunit-compile-file (file-path &optional under-cover)
350  (if (file-readable-p file-path)
351      (with-current-buffer (find-file-noselect file-path)
352        ;; In order to run a code coverage analysis on a
353        ;; module, we have two options:
354        ;;
355        ;; * either compile the module with cover:compile instead of the
356        ;;   regular compiler
357        ;;
358        ;; * or first compile the module with the regular compiler (but
359        ;;   *with* debug_info) and then compile it for coverage
360        ;;   analysis using cover:compile_beam.
361        ;;
362        ;; We could accomplish the first by changing the
363        ;; erlang-compile-erlang-function to cover:compile, but there's
364        ;; a risk that that's used for other purposes.  Therefore, a
365        ;; safer alternative (although with more steps) is to add
366        ;; debug_info to the list of compiler options and go for the
367        ;; second alternative.
368        (if under-cover
369            (erlang-eunit-cover-compile)
370          (erlang-compile))
371        (erlang-eunit-last-compilation-successful-p))
372    (let ((msg (format "Could not read %s" file-path)))
373      (erlang-eunit-inferior-erlang-send-command
374       (format "%% WARNING: %s" msg))
375      (error msg))))
376
377(defun erlang-eunit-last-compilation-successful-p ()
378  (with-current-buffer inferior-erlang-buffer
379    (goto-char compilation-parsing-end)
380    (erlang-eunit-all-list-elems-fulfill-p
381     (lambda (re) (let ((continue t)
382                        (result   t))
383                    (while continue ; ignore warnings, stop at errors
384                      (if (re-search-forward re (point-max) t)
385                          (if (erlang-eunit-is-compilation-warning)
386                              t
387                            (setq result nil)
388                            (setq continue nil))
389                        (setq result t)
390                        (setq continue nil)))
391                    result))
392     (mapcar (lambda (e) (car e)) erlang-error-regexp-alist))))
393
394(defun erlang-eunit-is-compilation-warning ()
395  (erlang-eunit-string-match-p
396   "[0-9]+: Warning:"
397   (buffer-substring (line-beginning-position) (line-end-position))))
398
399(defun erlang-eunit-all-list-elems-fulfill-p (pred list)
400  (let ((matches-p t))
401    (while (and list matches-p)
402      (if (not (funcall pred (car list)))
403          (setq matches-p nil))
404      (setq list (cdr list)))
405    matches-p))
406
407;;; Evaluate a command in an erlang buffer
408(defun erlang-eunit-inferior-erlang-send-command (command)
409  "Evaluate a command in an erlang buffer."
410  (interactive "P")
411  (inferior-erlang-prepare-for-input)
412  (inferior-erlang-send-command command)
413  (sit-for 0) ;; redisplay
414  (inferior-erlang-wait-prompt))
415
416
417;;;====================================================================
418;;; Key bindings
419;;;====================================================================
420
421(defconst erlang-eunit-key-bindings
422  '(("\C-c\C-et" erlang-eunit-toggle-src-and-test-file-other-window)
423    ("\C-c\C-ek" erlang-eunit-compile-and-run-module-tests)
424    ("\C-c\C-ej" erlang-eunit-compile-and-run-current-test)
425    ("\C-c\C-el" erlang-eunit-compile-and-run-recent)
426    ("\C-c\C-ec" erlang-eunit-compile-and-run-module-tests-under-cover)
427    ("\C-c\C-ev" erlang-eunit-cover-compile)
428    ("\C-c\C-ea" erlang-eunit-analyze-coverage)))
429
430(defun erlang-eunit-add-key-bindings ()
431  (dolist (binding erlang-eunit-key-bindings)
432    (erlang-eunit-bind-key (car binding) (cadr binding))))
433
434(defun erlang-eunit-bind-key (key function)
435  (erlang-eunit-ensure-keymap-for-key key)
436  (local-set-key key function))
437
438(defun erlang-eunit-ensure-keymap-for-key (key-seq)
439  (let ((prefix-keys (butlast (append key-seq nil)))
440        (prefix-seq  ""))
441    (while prefix-keys
442      (setq prefix-seq (concat prefix-seq (make-string 1 (car prefix-keys))))
443      (setq prefix-keys (cdr prefix-keys))
444      (if (not (keymapp (lookup-key (current-local-map) prefix-seq)))
445          (local-set-key prefix-seq (make-sparse-keymap))))))
446
447(add-hook 'erlang-mode-hook 'erlang-eunit-add-key-bindings)
448
449
450(provide 'erlang-eunit)
451
452;; Local variables:
453;; coding: utf-8
454;; indent-tabs-mode: nil
455;; End:
456
457;; erlang-eunit.el ends here
458