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