aboutsummaryrefslogtreecommitdiffstats
path: root/lib/tools
diff options
context:
space:
mode:
Diffstat (limited to 'lib/tools')
-rw-r--r--lib/tools/doc/src/notes.xml16
-rw-r--r--lib/tools/emacs/erlang-test.el107
-rw-r--r--lib/tools/emacs/erlang.el309
-rw-r--r--lib/tools/emacs/test.erl.indented13
-rw-r--r--lib/tools/emacs/test.erl.orig13
-rw-r--r--lib/tools/src/cover.erl155
-rw-r--r--lib/tools/src/eprof.erl16
-rw-r--r--lib/tools/src/fprof.erl24
-rw-r--r--lib/tools/src/lcnt.erl107
-rw-r--r--lib/tools/src/tags.erl4
-rw-r--r--lib/tools/src/xref_base.erl217
-rw-r--r--lib/tools/src/xref_utils.erl8
-rw-r--r--lib/tools/vsn.mk2
13 files changed, 645 insertions, 346 deletions
diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml
index 979fa5e0ab..3a6ac37eef 100644
--- a/lib/tools/doc/src/notes.xml
+++ b/lib/tools/doc/src/notes.xml
@@ -31,22 +31,6 @@
</header>
<p>This document describes the changes made to the Tools application.</p>
-<section><title>Tools 2.8.4</title>
-
- <section><title>Fixed Bugs and Malfunctions</title>
- <list>
- <item>
- <p>
- Update fprof to use the new 'spawned' trace event to
- determine when a process has been created.</p>
- <p>
- Own Id: OTP-13499</p>
- </item>
- </list>
- </section>
-
-</section>
-
<section><title>Tools 2.8.3</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el
new file mode 100644
index 0000000000..a5aab04953
--- /dev/null
+++ b/lib/tools/emacs/erlang-test.el
@@ -0,0 +1,107 @@
+;;; erlang-test.el -*- lexical-binding: t; coding: utf-8-unix -*-
+
+;;; Unit tests for erlang.el.
+
+;; Author: Johan Claesson
+;; Created: 2016-05-07
+;; Keywords: erlang, languages
+
+;; %CopyrightBegin%
+;;
+;; Copyright Ericsson AB 2016. All Rights Reserved.
+;;
+;; Licensed under the Apache License, Version 2.0 (the "License");
+;; you may not use this file except in compliance with the License.
+;; You may obtain a copy of the License at
+;;
+;; http://www.apache.org/licenses/LICENSE-2.0
+;;
+;; Unless required by applicable law or agreed to in writing, software
+;; distributed under the License is distributed on an "AS IS" BASIS,
+;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;; See the License for the specific language governing permissions and
+;; limitations under the License.
+;;
+;; %CopyrightEnd%
+
+
+;;; Commentary:
+
+;; This library require GNU Emacs 25 or later.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(defvar erlang-test-code
+ '((nil . "-module(erlang_test).")
+ (nil . "-import(lists, [map/2]).")
+ (nil . "-compile(export_all).")
+ ("SYMBOL" . "-define(SYMBOL, value).")
+ ("MACRO" . "-define(MACRO(X), X + X).")
+ ("struct" . "-record(struct, {until,maps,are,everywhere}).")
+ ("function". "function() -> #struct{}."))
+ "Alist of erlang test code.
+Each entry have the format (TAGNAME . ERLANG_CODE). If TAGNAME
+is nil there is no definitions in the ERLANG_CODE. The
+ERLANG_CODE is a single line of erlang code. These lines will be
+concatenated to form an erlang file to test on.")
+
+
+(ert-deftest erlang-test-tags ()
+ (let* ((dir (make-temp-file "erlang-test" t))
+ (erlang-file (expand-file-name "erlang_test.erl" dir))
+ (tags-file (expand-file-name "TAGS" dir))
+ tags-file-name tags-table-list erlang-buffer)
+ (unwind-protect
+ (progn
+ (erlang-test-create-erlang-file erlang-file)
+ (erlang-test-compile-tags erlang-file tags-file)
+ (setq erlang-buffer (find-file-noselect erlang-file))
+ (with-current-buffer erlang-buffer
+ (setq-local tags-file-name tags-file))
+ ;; PENDING - setting global tags-file-name is a workaround
+ ;; for GNU Emacs bug23164.
+ (setq tags-file-name tags-file)
+ (erlang-test-xref-find-definitions erlang-file erlang-buffer))
+ (when (buffer-live-p erlang-buffer)
+ (kill-buffer erlang-buffer))
+ (let ((tags-buffer (find-buffer-visiting tags-file)))
+ (when (buffer-live-p tags-buffer)
+ (kill-buffer tags-buffer)))
+ (when (file-exists-p dir)
+ (delete-directory dir t)))))
+
+(defun erlang-test-create-erlang-file (erlang-file)
+ (with-temp-file erlang-file
+ (cl-loop for (_ . code) in erlang-test-code
+ do (insert code "\n"))))
+
+(defun erlang-test-compile-tags (erlang-file tags-file)
+ (should (zerop (call-process "etags" nil nil nil
+ "-o" tags-file
+ erlang-file))))
+
+(defun erlang-test-xref-find-definitions (erlang-file erlang-buffer)
+ (cl-loop for (tagname . code) in erlang-test-code
+ for line = 1 then (1+ line)
+ do (when tagname
+ (switch-to-buffer erlang-buffer)
+ (xref-find-definitions tagname)
+ (erlang-test-verify-pos erlang-file line)
+ (xref-find-definitions (concat "erlang_test:" tagname))
+ (erlang-test-verify-pos erlang-file line)))
+ (xref-find-definitions "erlang_test:")
+ (erlang-test-verify-pos erlang-file 1))
+
+(defun erlang-test-verify-pos (expected-file expected-line)
+ (should (string-equal (file-truename expected-file)
+ (file-truename (buffer-file-name))))
+ (should (eq expected-line (line-number-at-pos)))
+ (should (= (point-at-bol) (point))))
+
+
+(provide 'erlang-test)
+
+;;; erlang-test.el ends here
diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el
index 0a3fc0ddff..3d20d86f43 100644
--- a/lib/tools/emacs/erlang.el
+++ b/lib/tools/emacs/erlang.el
@@ -70,8 +70,8 @@
;; `debug-on-error' to `t'. Repeat the error and enclose the debug
;; information in your bug-report.
;;
-;; To set the variable you can use the following command:
-;; M-x set-variable RET debug-on-error RET t RET
+;; To toggle the variable you can use the following command:
+;; M-x toggle-debug-on-error RET
;;; Code:
(eval-when-compile (require 'cl))
@@ -1068,8 +1068,14 @@ behaviour.")
"Font lock keyword highlighting a function header.")
(defface erlang-font-lock-exported-function-name-face
- '((default (:inherit font-lock-function-name-face)))
- "Face used for highlighting exported functions.")
+ (if (featurep 'xemacs)
+ (progn
+ (require 'font-lock)
+ `((t (:foreground ,(face-foreground 'font-lock-function-name-face))
+ (:background ,(face-background 'font-lock-function-name-face)))))
+ '((default (:inherit font-lock-function-name-face))))
+ "Face used for highlighting exported functions."
+ :group 'erlang)
(defvar erlang-font-lock-exported-function-name-face
'erlang-font-lock-exported-function-name-face)
@@ -1338,11 +1344,15 @@ Lock syntax table. The effect is that `apply' in the atom
(defun erlang-version ()
"Return the current version of Erlang mode."
(interactive)
- (if (interactive-p)
+ (if (erlang-interactive-p)
(message "Erlang mode version %s, written by Anders Lindgren"
erlang-version))
erlang-version)
+(defun erlang-interactive-p ()
+ (if (fboundp 'called-interactively-p)
+ (called-interactively-p 'interactive)
+ (funcall (symbol-function 'interactive-p))))
;;;###autoload
(define-derived-mode erlang-mode prog-mode "Erlang"
@@ -1415,7 +1425,11 @@ Other commands:
(erlang-tags-init)
(erlang-font-lock-init)
(erlang-skel-init)
- (tempo-use-tag-list 'erlang-tempo-tags)
+ (when (fboundp 'tempo-use-tag-list)
+ (tempo-use-tag-list 'erlang-tempo-tags))
+ (when (boundp 'xref-backend-functions)
+ (add-hook 'xref-backend-functions #'erlang-etags--xref-backend nil t))
+ (run-hooks 'erlang-mode-hook)
(if (zerop (buffer-size))
(run-hooks 'erlang-new-file-hook)))
@@ -1536,7 +1550,9 @@ Other commands:
table)))
(set (make-local-variable 'font-lock-syntax-table)
erlang-font-lock-syntax-table)
- (set (make-local-variable 'font-lock-beginning-of-syntax-function)
+ (set (make-local-variable (if (boundp 'syntax-begin-function)
+ 'syntax-begin-function
+ 'font-lock-beginning-of-syntax-function))
'erlang-beginning-of-clause)
(make-local-variable 'font-lock-keywords)
(let ((level (cond ((boundp 'font-lock-maximum-decoration)
@@ -2244,6 +2260,7 @@ mode with the command `M-x erlang-mode RET'.")))
;; This code is based on the package `tempo' which is part of modern
;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.)
+(defvar erlang-skel)
(defun erlang-skel-init ()
"Generate the skeleton functions and menu items.
The variable `erlang-skel' contains the name and descriptions of
@@ -2970,8 +2987,9 @@ Return nil if inside string, t if in a comment."
(current-column)))
;; Type and Spec indentation
((eq (car stack-top) '::)
- (if (looking-at "}")
- ;; Closing record definition with types
+ (if (looking-at "[},)]")
+ ;; Closing function spec, record definition with types,
+ ;; or a comma at the start of the line
;; pop stack and recurse
(erlang-calculate-stack-indent indent-point
(cons (erlang-pop stack) (cdr state)))
@@ -3742,6 +3760,12 @@ In the future the list may contain more elements."
(if (assoc fk (cdr (car imports)))
(setq mod (car (car imports)))
(setq imports (cdr imports))))
+ (cond ((eq (preceding-char) ?#)
+ (setq fk (concat "-record(" fk)))
+ ((eq (preceding-char) ??)
+ (setq fk (concat "-define(" fk)))
+ ((and (null mod) (not (member fk erlang-int-bifs)))
+ (setq mod (erlang-get-module))))
(setq res (list mod fk)))))
(store-match-data md)
res)))
@@ -3812,20 +3836,19 @@ exported function."
(defun erlang-check-module-name-init ()
"Initialize the functionality to compare file and module names.
-Unless we have `before-save-hook', we redefine the function
+Unless we have `before-save-hook', we advice the function
`set-visited-file-name' since it clears the variable
-`local-write-file-hooks'. The original function definition is
-stored in `erlang-orig-set-visited-file-name'."
+`local-write-file-hooks'."
(if (boundp 'before-save-hook)
- ;; If we have that, `make-local-hook' is obsolete.
(add-hook 'before-save-hook 'erlang-check-module-name nil t)
(require 'advice)
- (unless (ad-advised-definition-p 'set-visited-file-name)
- (defadvice set-visited-file-name (after erlang-set-visited-file-name
- activate)
- (if (eq major-mode 'erlang-mode)
- (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
- (add-hook 'local-write-file-hooks 'erlang-check-module-name)))
+ (when (fboundp 'ad-advised-definition-p)
+ (unless (ad-advised-definition-p 'set-visited-file-name)
+ (defadvice set-visited-file-name (after erlang-set-visited-file-name
+ activate)
+ (if (eq major-mode 'erlang-mode)
+ (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
+ (add-hook 'local-write-file-hooks 'erlang-check-module-name))))
(defun erlang-check-module-name ()
@@ -3902,7 +3925,7 @@ non-whitespace characters following the point on the current line."
(newline)
(if (condition-case nil
(progn (erlang-indent-line) t)
- (error (if (bolp) (delete-backward-char 1))))
+ (error (if (bolp) (delete-char -1))))
(if (not (bolp))
(save-excursion
(insert " ->"))
@@ -3914,7 +3937,7 @@ non-whitespace characters following the point on the current line."
(beginning-of-line)
(newline
erlang-electric-semicolon-insert-blank-lines))))
- (error (if (bolp) (delete-backward-char 1))))))))
+ (error (if (bolp) (delete-char -1))))))))
(defun erlang-electric-comma (&optional arg)
@@ -3944,7 +3967,7 @@ non-whitespace characters following the point on the current line."
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1))))))
+ (error (if (bolp) (delete-char -1))))))
(defun erlang-electric-lt (&optional arg)
"Insert a less-than sign, and optionally mark it as an open paren."
@@ -4030,7 +4053,7 @@ non-whitespace characters following the point on the current line."
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1))))))
+ (error (if (bolp) (delete-char -1))))))
;; Then it's just a plain greater-than.
(t
@@ -4070,7 +4093,7 @@ After being split/merged into `erlang-after-arrow' and
(newline)
(condition-case nil
(erlang-indent-line)
- (error (if (bolp) (delete-backward-char 1)))))))
+ (error (if (bolp) (delete-char -1)))))))
(defun erlang-electric-newline (&optional arg)
@@ -4546,6 +4569,11 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(current-buffer))) ; Return the new buffer.
+
+
+
+
+
;; Process interactive arguments for erlang-find-tag-*.
;;
;; Negative arguments work only for `etags', not `tags'. This is not
@@ -4639,9 +4667,25 @@ Tags can be given on the forms `tag', `module:', `module:tag'."
(set (make-local-variable 'find-tag-regexp-search-function)
'erlang-tags-regexp-search-forward)
(set (make-local-variable 'find-tag-tag-order)
- '(erlang-tag-match-module-p))
+ (mapcar #'erlang-make-order-function-aware-of-modules
+ erlang-tags-orig-tag-order))
(set (make-local-variable 'find-tag-regexp-tag-order)
- '(erlang-tag-match-module-regexp-p))))
+ (mapcar #'erlang-make-order-function-aware-of-modules
+ erlang-tags-orig-regexp-tag-order))))
+
+(defun erlang-make-order-function-aware-of-modules (f)
+ `(lambda (tag)
+ (let (mod)
+ (when (string-match ":" tag)
+ (setq mod (substring tag 0 (match-beginning 0)))
+ (setq tag (substring tag (match-end 0) nil)))
+ (and (funcall ',f tag)
+ (or (null mod)
+ (erlang-tag-at-point-match-module-p mod))))))
+
+(defun erlang-tag-at-point-match-module-p (mod)
+ (string-equal mod (erlang-get-module-from-file-name
+ (funcall (symbol-function 'file-of-tag)))))
(defun erlang-tags-remove-module-check ()
@@ -4718,37 +4762,6 @@ for a tag on the form `module:tag'."
(funcall erlang-tags-orig-regexp-search-function
tag bound noerror count)))
-
-;; t if point is at a tag line that matches TAG, containing
-;; module information. Assumes that all other order functions
-;; are stored in `erlang-tags-orig-[regex]-tag-order'.
-
-(defun erlang-tag-match-module-p (tag)
- (erlang-tag-match-module-common-p tag erlang-tags-orig-tag-order))
-
-(defun erlang-tag-match-module-regexp-p (tag)
- (erlang-tag-match-module-common-p tag erlang-tags-orig-regexp-tag-order))
-
-(defun erlang-tag-match-module-common-p (tag order)
- (let ((mod nil)
- (found nil))
- (if (string-match ":" tag)
- (progn
- (setq mod (substring tag 0 (match-beginning 0)))
- (setq tag (substring tag (match-end 0) nil))))
- (while (and order (not found))
- (setq found
- (and (not (memq (car order)
- '(erlang-tag-match-module-p
- erlang-tag-match-module-regexp-p)))
- (funcall (car order) tag)))
- (setq order (cdr order)))
- (and found
- (or (null mod)
- (string= mod (erlang-get-module-from-file-name
- (file-of-tag)))))))
-
-
;;; Tags completion, Emacs 19 `etags' specific.
;;;
;;; The basic idea is to create a second completion table `erlang-tags-
@@ -4786,10 +4799,10 @@ about Erlang modules."
(cond ((and erlang-tags-installed
(fboundp 'etags-tags-completion-table)
(fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+
- ;; This depends on the advice called erlang-replace-tags-table
- ;; above. It is not enough to let-bind
- ;; tags-completion-table-function since that will not override
- ;; the buffer-local value in the TAGS buffer.
+ ;; This depends on the advice called
+ ;; erlang-replace-tags-table above. It is not enough to
+ ;; let-bind tags-completion-table-function since that may be
+ ;; overwritten in etags-recognize-tags-table.
(let ((find-tag-default-function 'erlang-find-tag-for-completion))
(complete-tag)))
((and erlang-tags-installed
@@ -4911,6 +4924,132 @@ about Erlang modules."
(progress-reporter-update progress-reporter (point))))))
table))
+
+;;; Xref backend erlang-etags
+
+;; In GNU Emacs 25 xref was introduced. It is a framework for cross
+;; referencing commands, in particular commands for finding
+;; definitions. It does not replace etags. It rather resides on top
+;; of it and provides user-friendly commands. The idea is that the
+;; user commands should be the same regardless of what backend does
+;; the actual finding of definitions.
+
+;; The backend below is a wrapper around the built-in etags backend.
+;; It adds awareness of the module:tag syntax in a similar way that is
+;; done above for the old etags commands.
+
+
+(defun erlang-etags--xref-backend () 'erlang-etags)
+
+(defun erlang-soft-require (feature)
+ (when (locate-library (symbol-name feature))
+ (require feature)))
+
+(and (erlang-soft-require 'xref)
+ (erlang-soft-require 'cl-generic)
+ ;; The purpose of using eval here is to avoid compilation
+ ;; warnings in emacsen without cl-defmethod.
+ (eval
+ '(progn
+ (cl-defmethod xref-backend-identifier-at-point
+ ((_backend (eql erlang-etags)))
+ (erlang-find-tag-default))
+
+ (cl-defmethod xref-backend-definitions
+ ((_backend (eql erlang-etags)) identifier)
+ (erlang-xref-find-definitions identifier))
+
+ (cl-defmethod xref-backend-apropos
+ ((_backend (eql erlang-etags)) identifier)
+ (erlang-xref-find-definitions identifier t))
+
+ ;; PENDING - This remains to be properly implemented.
+ (cl-defmethod xref-backend-identifier-completion-table
+ ((_backend (eql erlang-etags)))
+ (tags-lazy-completion-table)))))
+
+
+(defun erlang-xref-find-definitions (identifier &optional is-regexp)
+ (let ((id-list (split-string identifier ":")))
+ (cond
+ ;; Handle "tag"
+ ((null (cdr id-list))
+ (erlang-xref-find-definitions-tag identifier is-regexp))
+ ;; Handle "module:"
+ ((string-equal (cadr id-list) "")
+ (erlang-xref-find-definitions-module (car id-list)))
+ ;; Handle "module:tag"
+ (t
+ (erlang-xref-find-definitions-module-tag (car id-list)
+ (cadr id-list)
+ is-regexp)))))
+
+(defun erlang-xref-find-definitions-tag (tag is-regexp)
+ "Find all definitions of TAG and reorder them so that
+definitions in the currently visited file comes first."
+ (when (fboundp 'etags--xref-find-definitions)
+ (let* ((current-file (and (buffer-file-name)
+ (file-truename (buffer-file-name))))
+ (xrefs (etags--xref-find-definitions tag is-regexp))
+ local-xrefs non-local-xrefs)
+ (while xrefs
+ (if (string-equal (erlang-xref-truename-file (car xrefs))
+ current-file)
+ (push (car xrefs) local-xrefs)
+ (push (car xrefs) non-local-xrefs))
+ (setq xrefs (cdr xrefs)))
+ (append (reverse local-xrefs)
+ (reverse non-local-xrefs)))))
+
+(defun erlang-xref-find-definitions-module (module)
+ (and (fboundp 'xref-make)
+ (fboundp 'xref-make-file-location)
+ (let* ((first-time t)
+ xrefs matching-files)
+ (save-excursion
+ (while (visit-tags-table-buffer (not first-time))
+ (setq first-time nil)
+ (let ((files (tags-table-files)))
+ (while files
+ (let* ((file (car files))
+ (m (erlang-get-module-from-file-name file)))
+ (when (and m (string-equal m module))
+ (unless (member file matching-files)
+ (push file
+ matching-files)
+ (push (xref-make file
+ (xref-make-file-location file 1 0))
+ xrefs))))
+ (setq files (cdr files))))))
+ (nreverse xrefs))))
+
+(defun erlang-xref-find-definitions-module-tag (module tag is-regexp)
+ "Find all definitions of TAG and filter away definitions
+outside of MODULE."
+ (when (fboundp 'etags--xref-find-definitions)
+ (let ((xrefs (etags--xref-find-definitions tag is-regexp))
+ xrefs-in-module)
+ (while xrefs
+ (when (string-equal module (erlang-xref-module (car xrefs)))
+ (push (car xrefs) xrefs-in-module))
+ (setq xrefs (cdr xrefs)))
+ xrefs-in-module)))
+
+(defun erlang-xref-module (xref)
+ (erlang-get-module-from-file-name (erlang-xref-file xref)))
+
+(defun erlang-xref-truename-file (xref)
+ (let ((file (erlang-xref-file xref)))
+ (and file
+ (file-truename file))))
+
+(defun erlang-xref-file (xref)
+ (and (fboundp 'xref-location-group)
+ (fboundp 'xref-item-location)
+ (xref-location-group (xref-item-location xref))))
+
+
+
;;;
;;; Prepare for other methods to run an Erlang slave process.
;;;
@@ -5309,8 +5448,7 @@ frame will become deselected before the next command."
()
(or (inferior-erlang-running-p)
(error "No inferior Erlang shell is running"))
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(let ((msg nil))
(while (save-excursion
(goto-char (process-mark inferior-erlang-process))
@@ -5330,8 +5468,7 @@ frame will become deselected before the next command."
The empty command resembles hitting RET. This is useful in some
situations, for instance if a crash or error report from sasl
has been printed after the last prompt."
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(if (> (point-max) 1)
;; make sure we get a prompt if buffer contains data
(if (save-excursion
@@ -5397,7 +5534,7 @@ Return the position after the newly inserted command."
(boundp 'comint-last-output-start))
(save-excursion
(goto-char
- (if (interactive-p)
+ (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start)))
(while (progn (skip-chars-forward "^\C-h")
@@ -5416,7 +5553,7 @@ Return the position after the newly inserted command."
(let ((pmark (process-mark (get-buffer-process (current-buffer)))))
(save-excursion
(goto-char
- (if (interactive-p)
+ (if (erlang-interactive-p)
(symbol-value 'comint-last-input-end)
(symbol-value 'comint-last-output-start)))
(while (re-search-forward "\r+$" pmark t)
@@ -5443,23 +5580,21 @@ There exists two workarounds for this bug:
(save-some-buffers)
(inferior-erlang-prepare-for-input)
(let* ((dir (inferior-erlang-compile-outdir))
-;;; (file (file-name-nondirectory (buffer-file-name)))
(noext (substring (erlang-local-buffer-file-name) 0 -4))
(opts (append (list (cons 'outdir dir))
(if current-prefix-arg
(list 'debug_info 'export_all))
erlang-compile-extra-opts))
end)
- (save-excursion
- (set-buffer inferior-erlang-buffer)
- (compilation-forget-errors))
+ (with-current-buffer inferior-erlang-buffer
+ (when (fboundp 'compilation-forget-errors)
+ (compilation-forget-errors)))
(setq end (inferior-erlang-send-command
(inferior-erlang-compute-compile-command noext opts)
nil))
(sit-for 0)
(inferior-erlang-wait-prompt)
- (save-excursion
- (set-buffer inferior-erlang-buffer)
+ (with-current-buffer inferior-erlang-buffer
(setq compilation-error-list nil)
(set-marker compilation-parsing-end end))
(setq compilation-last-buffer inferior-erlang-buffer)))
@@ -5499,7 +5634,8 @@ unless the optional NO-DISPLAY is non-nil."
(let ((ccfn erlang-compile-command-function-alist)
(res (inferior-erlang-compute-erl-compile-command module-name opts))
ccfn-entry
- done)
+ done
+ result)
(if (not (null (erlang-local-buffer-file-name)))
(while (and (not done) (not (null ccfn)))
(setq ccfn-entry (car ccfn))
@@ -5629,12 +5765,14 @@ unless the optional NO-DISPLAY is non-nil."
(tramp-tramp-file-p (buffer-file-name))))
(defun erlang-tramp-get-localname ()
- (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
- (if (fboundp 'tramp-file-name-localname)
- (tramp-file-name-localname tramp-info)
- ;; In old versions of tramp, it was `tramp-file-name-path'
- ;; instead of the newer `tramp-file-name-localname'
- (tramp-file-name-path tramp-info))))
+ (when (fboundp 'tramp-dissect-file-name)
+ (let ((tramp-info (tramp-dissect-file-name (buffer-file-name))))
+ (if (fboundp 'tramp-file-name-localname)
+ (tramp-file-name-localname tramp-info)
+ ;; In old versions of tramp, it was `tramp-file-name-path'
+ ;; instead of the newer `tramp-file-name-localname'
+ (when (fboundp 'tramp-file-name-path)
+ (tramp-file-name-path tramp-info))))))
;; `next-error' only accepts buffers with major mode `compilation-mode'
;; or with the minor mode `compilation-minor-mode' activated.
@@ -5651,16 +5789,14 @@ Capable of finding error messages in an inferior Erlang buffer."
(and (boundp 'compilation-last-buffer)
compilation-last-buffer))))
(if (and (bufferp buf)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(and (eq major-mode 'erlang-shell-mode)
(setq major-mode 'compilation-mode))))
(unwind-protect
(progn
(setq done t)
(next-error argp))
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(setq major-mode 'erlang-shell-mode))))
(or done
(next-error argp))))
@@ -5763,7 +5899,7 @@ Simplified version of a combination `defalias' and `make-obsolete',
it assumes that NEWDEF is loaded."
(defalias sym (symbol-function newdef))
(if (fboundp 'make-obsolete)
- (make-obsolete sym newdef)))
+ (make-obsolete sym newdef "long ago")))
(erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent)
@@ -5781,11 +5917,8 @@ it assumes that NEWDEF is loaded."
(erlang-obsolete 'name-of-erlang-function 'erlang-name-of-function)
-;; Fixme: shouldn't redefine `set-visited-file-name' anyhow -- see above.
(defconst erlang-unload-hook
(list (lambda ()
- (defalias 'set-visited-file-name
- 'erlang-orig-set-visited-file-name)
(when (featurep 'advice)
(ad-unadvise 'Man-notify-when-ready)
(ad-unadvise 'set-visited-file-name)))))
diff --git a/lib/tools/emacs/test.erl.indented b/lib/tools/emacs/test.erl.indented
index 6913068133..7a1ff6a954 100644
--- a/lib/tools/emacs/test.erl.indented
+++ b/lib/tools/emacs/test.erl.indented
@@ -70,6 +70,9 @@ foo() ->
234,
d}).
+-record(record5, { a = 1 :: integer()
+ , b = foobar :: atom()
+ }).
-define(MACRO_1, macro).
-define(MACRO_2(_), macro).
@@ -144,6 +147,12 @@ foo() ->
-type t25() :: #rec3{f123 :: [t24() |
1|2|3|4|a|b|c|d|
nonempty_maybe_improper_list(integer, any())]}.
+-type t26() :: #rec4{ a :: integer()
+ , b :: any()
+ }.
+-type t27() :: { integer()
+ , atom()
+ }.
-type t99() ::
{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14(),
t15(),t20(),t21(), t22(),t25()}.
@@ -179,6 +188,10 @@ foo() ->
| {'error', {'no_process', term()}
| {'no_such_group', term()}}.
+-spec add( X :: integer()
+ , Y :: integer()
+ ) -> integer().
+
-opaque attributes_data() ::
[{'column', column()} | {'line', info_line()} |
{'text', string()}] | {line(),column()}.
diff --git a/lib/tools/emacs/test.erl.orig b/lib/tools/emacs/test.erl.orig
index 621948cbe1..2552c71baf 100644
--- a/lib/tools/emacs/test.erl.orig
+++ b/lib/tools/emacs/test.erl.orig
@@ -70,6 +70,9 @@ foo() ->
234,
d}).
+-record(record5, { a = 1 :: integer()
+, b = foobar :: atom()
+}).
-define(MACRO_1, macro).
-define(MACRO_2(_), macro).
@@ -144,6 +147,12 @@ nonempty_maybe_improper_list('integer', any())|
-type t25() :: #rec3{f123 :: [t24() |
1|2|3|4|a|b|c|d|
nonempty_maybe_improper_list(integer, any())]}.
+-type t26() :: #rec4{ a :: integer()
+, b :: any()
+}.
+-type t27() :: { integer()
+, atom()
+}.
-type t99() ::
{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14(),
t15(),t20(),t21(), t22(),t25()}.
@@ -179,6 +188,10 @@ t15(),t20(),t21(), t22(),t25()}.
| {'error', {'no_process', term()}
| {'no_such_group', term()}}.
+-spec add( X :: integer()
+, Y :: integer()
+) -> integer().
+
-opaque attributes_data() ::
[{'column', column()} | {'line', info_line()} |
{'text', string()}] | {line(),column()}.
diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl
index 69331732bf..92c10cc306 100644
--- a/lib/tools/src/cover.erl
+++ b/lib/tools/src/cover.erl
@@ -573,7 +573,7 @@ call(Request) ->
Ref = erlang:monitor(process,?SERVER),
receive {'DOWN', Ref, _Type, _Object, noproc} ->
erlang:demonitor(Ref),
- start(),
+ {ok,_} = start(),
call(Request)
after 0 ->
?SERVER ! {self(),Request},
@@ -589,7 +589,9 @@ call(Request) ->
end.
reply(From, Reply) ->
- From ! {?SERVER,Reply}.
+ From ! {?SERVER,Reply},
+ ok.
+
is_from(From) ->
is_pid(From).
@@ -615,9 +617,11 @@ remote_call(Node,Request) ->
end.
remote_reply(Proc,Reply) when is_pid(Proc) ->
- Proc ! {?SERVER,Reply};
+ Proc ! {?SERVER,Reply},
+ ok;
remote_reply(MainNode,Reply) ->
- {?SERVER,MainNode} ! {?SERVER,Reply}.
+ {?SERVER,MainNode} ! {?SERVER,Reply},
+ ok.
%%%----------------------------------------------------------------------
%%% cover_server on main node
@@ -627,14 +631,16 @@ init_main(Starter) ->
register(?SERVER,self()),
%% Having write concurrancy here gives a 40% performance boost
%% when collect/1 is called.
- ets:new(?COVER_TABLE, [set, public, named_table
- ,{write_concurrency, true}
- ]),
- ets:new(?COVER_CLAUSE_TABLE, [set, public, named_table]),
- ets:new(?BINARY_TABLE, [set, public, named_table]),
- ets:new(?COLLECTION_TABLE, [set, public, named_table]),
- ets:new(?COLLECTION_CLAUSE_TABLE, [set, public, named_table]),
- net_kernel:monitor_nodes(true),
+ ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table,
+ {write_concurrency, true}]),
+ ?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public,
+ named_table]),
+ ?BINARY_TABLE = ets:new(?BINARY_TABLE, [set, public, named_table]),
+ ?COLLECTION_TABLE = ets:new(?COLLECTION_TABLE, [set, public,
+ named_table]),
+ ?COLLECTION_CLAUSE_TABLE = ets:new(?COLLECTION_CLAUSE_TABLE, [set, public,
+ named_table]),
+ ok = net_kernel:monitor_nodes(true),
Starter ! {?SERVER,started},
main_process_loop(#main_state{}).
@@ -672,7 +678,7 @@ main_process_loop(State) ->
Imported = do_import_to_table(Fd,File,
State#main_state.imported),
reply(From, ok),
- file:close(Fd),
+ ok = file:close(Fd),
main_process_loop(State#main_state{imported=Imported});
{error,Reason} ->
reply(From, {error, {cant_open_file,File,Reason}}),
@@ -870,11 +876,12 @@ main_process_loop(State) ->
init_remote(Starter,MainNode) ->
register(?SERVER,self()),
- ets:new(?COVER_TABLE, [set, public, named_table
- %% write_concurrency here makes otp_8270 break :(
- %,{write_concurrency, true}
- ]),
- ets:new(?COVER_CLAUSE_TABLE, [set, public, named_table]),
+ %% write_concurrency here makes otp_8270 break :(
+ ?COVER_TABLE = ets:new(?COVER_TABLE, [set, public, named_table
+ %,{write_concurrency, true}
+ ]),
+ ?COVER_CLAUSE_TABLE = ets:new(?COVER_CLAUSE_TABLE, [set, public,
+ named_table]),
Starter ! {self(),started},
remote_process_loop(#remote_state{main_node=MainNode}).
@@ -907,11 +914,11 @@ remote_process_loop(State) ->
'_' -> [M || {M,_} <- State#remote_state.compiled];
_ -> Modules0
end,
- spawn(fun() ->
- ?SPAWN_DBG(remote_collect,
- {Modules, CollectorPid, From}),
- do_collect(Modules, CollectorPid, From)
- end),
+ spawn(fun() ->
+ ?SPAWN_DBG(remote_collect,
+ {Modules, CollectorPid, From}),
+ do_collect(Modules, CollectorPid, From)
+ end),
remote_process_loop(State);
{remote,stop} ->
@@ -952,13 +959,13 @@ remote_process_loop(State) ->
end.
do_collect(Modules, CollectorPid, From) ->
- pmap(
- fun(Module) ->
- Pattern = {#bump{module=Module, _='_'}, '$1'},
- MatchSpec = [{Pattern,[{'=/=','$1',0}],['$_']}],
- Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE),
- send_chunks(Match, CollectorPid, [])
- end,Modules),
+ _ = pmap(
+ fun(Module) ->
+ Pattern = {#bump{module=Module, _='_'}, '$1'},
+ MatchSpec = [{Pattern,[{'=/=','$1',0}],['$_']}],
+ Match = ets:select(?COVER_TABLE,MatchSpec,?CHUNK_SIZE),
+ send_chunks(Match, CollectorPid, [])
+ end,Modules),
CollectorPid ! done,
remote_reply(From, ok).
@@ -994,20 +1001,20 @@ get_downs(Mons) ->
end.
reload_originals(Compiled) ->
- Modules = [M || {M,_} <- Compiled],
- pmap(fun do_reload_original/1, Modules).
+ _ = pmap(fun do_reload_original/1, [M || {M,_} <- Compiled]),
+ ok.
do_reload_original(Module) ->
case code:which(Module) of
?TAG ->
- code:purge(Module), % remove code marked as 'old'
- code:delete(Module), % mark cover compiled code as 'old'
+ _ = code:purge(Module), % remove code marked as 'old'
+ _ = code:delete(Module), % mark cover compiled code as 'old'
%% Note: original beam code must be loaded before the cover
%% compiled code is purged, in order to for references to
%% 'fun M:F/A' and %% 'fun F/A' funs to be correct (they
%% refer to (M:)F/A in the *latest* version of the module)
- code:load_file(Module), % load original code
- code:purge(Module); % remove cover compiled code
+ _ = code:load_file(Module), % load original code
+ _ = code:purge(Module); % remove cover compiled code
_ ->
ignore
end.
@@ -1219,12 +1226,13 @@ remote_reset(Module,Nodes) ->
%% Collect data from remote nodes - used for analyse or stop(Node)
remote_collect(Modules,Nodes,Stop) ->
- pmap(fun(Node) ->
- ?SPAWN_DBG(remote_collect,
- {Modules, Nodes, Stop}),
- do_collection(Node, Modules, Stop)
- end,
- Nodes).
+ _ = pmap(
+ fun(Node) ->
+ ?SPAWN_DBG(remote_collect,
+ {Modules, Nodes, Stop}),
+ do_collection(Node, Modules, Stop)
+ end, Nodes),
+ ok.
do_collection(Node, Module, Stop) ->
CollectorPid = spawn(fun collector_proc/0),
@@ -1260,8 +1268,8 @@ insert_in_collection_table([]) ->
insert_in_collection_table(Key,Val) ->
case ets:member(?COLLECTION_TABLE,Key) of
true ->
- ets:update_counter(?COLLECTION_TABLE,
- Key,Val);
+ _ = ets:update_counter(?COLLECTION_TABLE, Key,Val),
+ ok;
false ->
%% Make sure that there are no race conditions from ets:member
case ets:insert_new(?COLLECTION_TABLE,{Key,Val}) of
@@ -2421,7 +2429,7 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
"<body style='background-color: white;"
" color: black'>\n"
"<pre>\n"],
- file:write(OutFd,Header);
+ ok = file:write(OutFd,Header);
true -> ok
end,
@@ -2435,7 +2443,7 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
string:right(integer_to_list(H), 2, $0),
string:right(integer_to_list(Mi), 2, $0),
string:right(integer_to_list(S), 2, $0)]),
- file:write(OutFd,
+ ok = file:write(OutFd,
["File generated from ",ErlFile," by COVER ",
Timestamp,"\n\n"
"**************************************"
@@ -2447,14 +2455,13 @@ do_analyse_to_file1(Module, OutFile, ErlFile, HTML) ->
CovLines = lists:keysort(1,ets:select(?COLLECTION_TABLE, MS)),
print_lines(Module, CovLines, InFd, OutFd, 1, HTML),
- if
- HTML ->
- file:write(OutFd, "</pre>\n</body>\n</html>\n");
+ if HTML ->
+ ok = file:write(OutFd, "</pre>\n</body>\n</html>\n");
true -> ok
end,
- file:close(OutFd),
- file:close(InFd),
+ ok = file:close(OutFd),
+ ok = file:close(InFd),
{ok, OutFile};
@@ -2472,34 +2479,33 @@ print_lines(Module, CovLines, InFd, OutFd, L, HTML) ->
eof ->
ignore;
{ok,"%"++_=Line} -> %Comment line - not executed.
- file:write(OutFd, [tab(),escape_lt_and_gt(Line, HTML)]),
+ ok = file:write(OutFd, [tab(),escape_lt_and_gt(Line, HTML)]),
print_lines(Module, CovLines, InFd, OutFd, L+1, HTML);
{ok,RawLine} ->
Line = escape_lt_and_gt(RawLine,HTML),
case CovLines of
[{L,N}|CovLines1] ->
%% N = lists:foldl(fun([Ni], Nacc) -> Nacc+Ni end, 0, Ns),
- if
- N=:=0, HTML=:=true ->
- LineNoNL = Line -- "\n",
- Str = " 0",
- %%Str = string:right("0", 6, 32),
- RedLine = ["<font color=red>",Str,fill1(),
- LineNoNL,"</font>\n"],
- file:write(OutFd, RedLine);
- N<1000000 ->
- Str = string:right(integer_to_list(N), 6, 32),
- file:write(OutFd, [Str,fill1(),Line]);
- N<10000000 ->
- Str = integer_to_list(N),
- file:write(OutFd, [Str,fill2(),Line]);
- true ->
- Str = integer_to_list(N),
- file:write(OutFd, [Str,fill3(),Line])
- end,
+ if N=:=0, HTML=:=true ->
+ LineNoNL = Line -- "\n",
+ Str = " 0",
+ %%Str = string:right("0", 6, 32),
+ RedLine = ["<font color=red>",Str,fill1(),
+ LineNoNL,"</font>\n"],
+ ok = file:write(OutFd, RedLine);
+ N < 1000000 ->
+ Str = string:right(integer_to_list(N), 6, 32),
+ ok = file:write(OutFd, [Str,fill1(),Line]);
+ N < 10000000 ->
+ Str = integer_to_list(N),
+ ok = file:write(OutFd, [Str,fill2(),Line]);
+ true ->
+ Str = integer_to_list(N),
+ ok = file:write(OutFd, [Str,fill3(),Line])
+ end,
print_lines(Module, CovLines1, InFd, OutFd, L+1, HTML);
_ ->
- file:write(OutFd, [tab(),Line]),
+ ok = file:write(OutFd, [tab(),Line]),
print_lines(Module, CovLines, InFd, OutFd, L+1, HTML)
end
end.
@@ -2539,7 +2545,7 @@ do_export(Module, OutFile, From, State) ->
{error,{not_cover_compiled,Module}}
end
end,
- file:close(Fd),
+ ok = file:close(Fd),
reply(From, Reply);
{error,Reason} ->
reply(From, {error, {cant_open_file,OutFile,Reason}})
@@ -2581,10 +2587,9 @@ write(Element,Fd) ->
case byte_size(Bin) of
Size when Size > 255 ->
SizeBin = term_to_binary({'$size',Size}),
- file:write(Fd,
- <<(byte_size(SizeBin)):8,SizeBin/binary,Bin/binary>>);
+ ok = file:write(Fd, <<(byte_size(SizeBin)):8,SizeBin/binary,Bin/binary>>);
Size ->
- file:write(Fd,<<Size:8,Bin/binary>>)
+ ok = file:write(Fd,<<Size:8,Bin/binary>>)
end,
ok.
diff --git a/lib/tools/src/eprof.erl b/lib/tools/src/eprof.erl
index 07e995993b..3ae899a078 100644
--- a/lib/tools/src/eprof.erl
+++ b/lib/tools/src/eprof.erl
@@ -74,7 +74,6 @@
start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []).
stop() -> gen_server:call(?MODULE, stop, infinity).
-
analyze() ->
analyze(procs).
@@ -112,7 +111,7 @@ profile(Rootset, M, F, A, Pattern) when is_list(Rootset), is_atom(M), is_atom(F)
%% Returns when M:F/A has terminated
profile(Rootset, M, F, A, Pattern, Options) ->
- start(),
+ ok = start_internal(),
gen_server:call(?MODULE, {profile_start, Rootset, Pattern, {M,F,A}, Options}, infinity).
dump() ->
@@ -127,7 +126,7 @@ start_profiling(Rootset) ->
start_profiling(Rootset, Pattern) ->
start_profiling(Rootset, Pattern, ?default_options).
start_profiling(Rootset, Pattern, Options) ->
- start(),
+ ok = start_internal(),
gen_server:call(?MODULE, {profile_start, Rootset, Pattern, undefined, Options}, infinity).
stop_profiling() ->
@@ -251,9 +250,9 @@ handle_call({logfile, File}, _From, #state{ fd = OldFd } = S) ->
{ok, Fd} ->
case OldFd of
undefined -> ok;
- OldFd -> file:close(OldFd)
+ OldFd -> ok = file:close(OldFd)
end,
- {reply, ok, S#state{ fd = Fd}};
+ {reply, ok, S#state{fd = Fd}};
Error ->
{reply, Error, S}
end;
@@ -521,3 +520,10 @@ format(Fd, Format, Strings) ->
divide(_,0) -> 0.0;
divide(T,N) -> T/N.
+
+start_internal() ->
+ case start() of
+ {ok, _} -> ok;
+ {error, {already_started,_}} -> ok;
+ Error -> Error
+ end.
diff --git a/lib/tools/src/fprof.erl b/lib/tools/src/fprof.erl
index b21eedc625..8db23dd151 100644
--- a/lib/tools/src/fprof.erl
+++ b/lib/tools/src/fprof.erl
@@ -1003,7 +1003,7 @@ handle_req(#analyse{dest = Dest,
already_open ->
ok;
ok ->
- file:close(DestPid)
+ ok = file:close(DestPid)
end,
State
end;
@@ -1364,7 +1364,7 @@ tracer_loop(Parent, Handler, State) ->
Trace when element(1, Trace) =:= trace_ts ->
tracer_loop(Parent, Handler, Handler(Trace, State));
{'EXIT', Parent, Reason} ->
- handler(end_of_trace, State),
+ _ = handler(end_of_trace, State),
exit(Reason);
_ ->
tracer_loop(Parent, Handler, State)
@@ -1450,12 +1450,10 @@ end_of_trace(Table, TS) ->
Procs = get(),
put(table, Table),
?dbg(2, "get() -> ~p~n", [Procs]),
- lists:map(
- fun ({Pid, _}) when is_pid(Pid) ->
- trace_exit(Table, Pid, TS)
- end,
- Procs),
- erase(),
+ _ = lists:map(fun ({Pid, _}) when is_pid(Pid) ->
+ trace_exit(Table, Pid, TS)
+ end, Procs),
+ _ = erase(),
ok.
@@ -2047,7 +2045,7 @@ trace_exit(Table, Pid, TS) ->
[] ->
ok;
[_ | _] = Stack ->
- trace_return_to_int(Table, Pid, undefined, TS, Stack),
+ _ = trace_return_to_int(Table, Pid, undefined, TS, Stack),
ok
end,
ok.
@@ -2173,7 +2171,7 @@ trace_clock(_Table, _Pid, _T,
[[{suspend, _}], [{suspend, _}] | _]=_Stack, _Clock) ->
?dbg(9, "trace_clock(Table, ~w, ~w, ~w, ~w)~n",
[_Pid, _T, _Stack, _Clock]),
- void;
+ ok;
trace_clock(Table, Pid, T,
[[{garbage_collect, TS0}], [{suspend, _}]], Clock) ->
trace_clock_1(Table, Pid, T, TS0, undefined, garbage_collect, Clock);
@@ -2188,7 +2186,7 @@ trace_clock(Table, Pid, T, [[{Func0, TS0}], [{Func1, _} | _] | _], Clock) ->
trace_clock(Table, Pid, T, [[{Func0, TS0}]], Clock) ->
trace_clock_1(Table, Pid, T, TS0, undefined, Func0, Clock);
trace_clock(_, _, _, [], _) ->
- void.
+ ok.
trace_clock_1(Table, Pid, _, _, Caller, suspend, #clocks.own) ->
clock_add(Table, {Pid, Caller, suspend}, #clocks.own, 0);
@@ -2202,7 +2200,7 @@ trace_clock_1(Table, Pid, T, TS, Caller, Func, Clock) ->
clock_add(Table, Id, Clock, T) ->
?dbg(1, "clock_add(Table, ~w, ~w, ~w)~n", [Id, Clock, T]),
- try ets:update_counter(Table, Id, {Clock, T})
+ try ets:update_counter(Table, Id, {Clock, T}), ok
catch
error:badarg ->
ets:insert(Table, #clocks{id = Id}),
@@ -2211,7 +2209,7 @@ clock_add(Table, Id, Clock, T) ->
true -> ?dbg(0, "Negative counter value ~p ~p ~p ~p~n",
[X, Id, Clock, T])
end,
- X
+ ok
end.
clocks_add(Table, #clocks{id = Id} = Clocks) ->
diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl
index 78407a651a..23d66b084e 100644
--- a/lib/tools/src/lcnt.erl
+++ b/lib/tools/src/lcnt.erl
@@ -23,67 +23,57 @@
-author("Björn-Egil Dahlberg").
%% gen_server callbacks
--export([
- init/1,
- handle_call/3,
- handle_cast/2,
- handle_info/2,
- terminate/2,
- code_change/3
- ]).
+-export([init/1,
+ handle_call/3,
+ handle_cast/2,
+ handle_info/2,
+ terminate/2,
+ code_change/3]).
%% start/stop
--export([
- start/0,
- stop/0
- ]).
+-export([start/0,
+ stop/0]).
%% erts_debug:lock_counters api
--export([
- rt_collect/0,
- rt_collect/1,
- rt_clear/0,
- rt_clear/1,
- rt_opt/1,
- rt_opt/2
- ]).
+-export([rt_collect/0,
+ rt_collect/1,
+ rt_clear/0,
+ rt_clear/1,
+ rt_opt/1,
+ rt_opt/2]).
%% gen_server call api
--export([
- raw/0,
- collect/0,
- collect/1,
- clear/0,
- clear/1,
- conflicts/0,
- conflicts/1,
- locations/0,
- locations/1,
- inspect/1,
- inspect/2,
- histogram/1,
- histogram/2,
- information/0,
- swap_pid_keys/0,
- % set options
- set/1,
- set/2,
-
- load/1,
- save/1
- ]).
+-export([raw/0,
+ collect/0,
+ collect/1,
+ clear/0,
+ clear/1,
+ conflicts/0,
+ conflicts/1,
+ locations/0,
+ locations/1,
+ inspect/1,
+ inspect/2,
+ histogram/1,
+ histogram/2,
+ information/0,
+ swap_pid_keys/0,
+ % set options
+ set/1,
+ set/2,
+
+ load/1,
+ save/1]).
%% convenience
--export([
- apply/3,
- apply/2,
- apply/1,
- all_conflicts/0,
- all_conflicts/1,
- pid/2, pid/3,
- port/1, port/2
- ]).
+-export([apply/3,
+ apply/2,
+ apply/1,
+ all_conflicts/0,
+ all_conflicts/1,
+ pid/2, pid/3,
+ port/1, port/2]).
-define(version, "1.0").
@@ -135,6 +125,13 @@ start() -> gen_server:start({local, ?MODULE}, ?MODULE, [], []).
stop() -> gen_server:call(?MODULE, stop, infinity).
init([]) -> {ok, #state{ locks = [], duration = 0 } }.
+start_internal() ->
+ case start() of
+ {ok,_} -> ok;
+ {error, {already_started,_}} -> ok;
+ Error -> Error
+ end.
+
%% -------------------------------------------------------------------- %%
%%
%% API erts_debug:lock_counters
@@ -184,7 +181,7 @@ raw() -> call(raw).
set(Option, Value) -> call({set, Option, Value}).
set({Option, Value}) -> call({set, Option, Value}).
save(Filename) -> call({save, Filename}).
-load(Filename) -> start(), call({load, Filename}).
+load(Filename) -> ok = start_internal(), call({load, Filename}).
call(Msg) -> gen_server:call(?MODULE, Msg, infinity).
@@ -195,7 +192,7 @@ call(Msg) -> gen_server:call(?MODULE, Msg, infinity).
%% -------------------------------------------------------------------- %%
apply(M,F,As) when is_atom(M), is_atom(F), is_list(As) ->
- lcnt:start(),
+ ok = start_internal(),
Opt = lcnt:rt_opt({copy_save, true}),
lcnt:clear(),
Res = erlang:apply(M,F,As),
@@ -207,7 +204,7 @@ apply(Fun) when is_function(Fun) ->
lcnt:apply(Fun, []).
apply(Fun, As) when is_function(Fun) ->
- lcnt:start(),
+ ok = start_internal(),
Opt = lcnt:rt_opt({copy_save, true}),
lcnt:clear(),
Res = erlang:apply(Fun, As),
diff --git a/lib/tools/src/tags.erl b/lib/tools/src/tags.erl
index 2bc1865503..b833d96c19 100644
--- a/lib/tools/src/tags.erl
+++ b/lib/tools/src/tags.erl
@@ -101,7 +101,7 @@ files(Files, Options) ->
case open_out(Options) of
{ok, Os} ->
files_loop(Files, Os),
- close_out(Os),
+ ok = close_out(Os),
ok;
_ ->
error
@@ -169,7 +169,7 @@ filename(Name, Os) ->
case file:open(Name, [read]) of
{ok, Desc} ->
Acc = module(Desc, [], [], {1, 0}),
- file:close(Desc),
+ ok = file:close(Desc),
genout(Os, Name, Acc),
ok;
_ ->
diff --git a/lib/tools/src/xref_base.erl b/lib/tools/src/xref_base.erl
index 70eb107781..bb9815f9b0 100644
--- a/lib/tools/src/xref_base.erl
+++ b/lib/tools/src/xref_base.erl
@@ -669,16 +669,45 @@ do_add_directory(Dir, AppName, Bui, Rec, Ver, War, State) ->
warnings(War, unreadable, Unreadable),
case Errors of
[] ->
- do_add_modules(FileNames, AppName, Bui, Ver, War, State, []);
+ do_add_modules(FileNames, AppName, Bui, Ver, War, State);
[Error | _] ->
throw(Error)
end.
-do_add_modules([], _AppName, _OB, _OV, _OW, State, Modules) ->
+do_add_modules(Files, AppName, OB, OV, OW, State0) ->
+ NFiles = length(Files),
+ Reader = fun(SplitName, State) ->
+ _Pid = read_module(SplitName, AppName, OB, OV, OW, State)
+ end,
+ N = parallelism(),
+ Files1 = start_readers(Files, Reader, State0, N),
+ %% Increase the number of readers towards the end to decrease the
+ %% waiting time for the collecting process:
+ Nx = N,
+ add_mods(Files1, Reader, State0, [], NFiles, Nx).
+
+add_mods(_, _ReaderFun, State, Modules, 0, _Nx) ->
{ok, sort(Modules), State};
-do_add_modules([File | Files], AppName, OB, OV, OW, State, Modules) ->
- {ok, M, NewState} = do_add_module(File, AppName, OB, OV, OW, State),
- do_add_modules(Files, AppName, OB, OV, OW, NewState, M ++ Modules).
+add_mods(Files, ReaderFun, State, Modules, N, Nx) ->
+ {I, Nx1} = case Nx > 0 of
+ false -> {1, Nx};
+ true -> {2, Nx - 1}
+ end,
+ Files1 = start_readers(Files, ReaderFun, State, I),
+ {ok, M, NewState} = process_module(State),
+ add_mods(Files1, ReaderFun, NewState, M ++ Modules, N - 1, Nx1).
+
+start_readers([SplitName|Files], ReaderFun, State, N) when N > 0 ->
+ _Pid = ReaderFun(SplitName, State),
+ start_readers(Files, ReaderFun, State, N - 1);
+start_readers(Files, _ReaderFun, _State, _) ->
+ Files.
+
+parallelism() ->
+ case erlang:system_info(multi_scheduling) of
+ enabled -> erlang:system_info(schedulers_online);
+ _ -> 1
+ end.
%% -> {ok, Module, State} | throw(Error)
do_add_a_module(File, AppName, Builtins, Verbose, Warnings, State) ->
@@ -692,50 +721,75 @@ do_add_a_module(File, AppName, Builtins, Verbose, Warnings, State) ->
%% -> {ok, Module, State} | throw(Error)
%% Options: verbose, warnings, builtins
-do_add_module({Dir, Basename}, AppName, Builtins, Verbose, Warnings, State) ->
- File = filename:join(Dir, Basename),
- {ok, M, Bad, NewState} =
- do_add_module1(Dir, File, AppName, Builtins, Verbose, Warnings, State),
- filter(fun({Tag,B}) -> warnings(Warnings, Tag, [[File,B]]) end, Bad),
- {ok, M, NewState}.
-
-do_add_module1(Dir, File, AppName, Builtins, Verbose, Warnings, State) ->
- message(Verbose, reading_beam, [File]),
- Mode = State#xref.mode,
+do_add_module(SplitName, AppName, Builtins, Verbose, Warnings, State) ->
+ _Pid = read_module(SplitName, AppName, Builtins, Verbose, Warnings, State),
+ process_module(State).
+
+read_module(SplitName, AppName, Builtins, Verbose, Warnings, State) ->
Me = self(),
- Fun = fun() -> Me ! {self(), abst(File, Builtins, Mode)} end,
- case xref_utils:subprocess(Fun, [link, {min_heap_size,100000}]) of
+ #xref{mode = Mode} = State,
+ Fun =
+ fun() ->
+ Me ! {?MODULE,
+ read_a_module(SplitName, AppName, Builtins, Verbose,
+ Warnings, Mode)}
+ end,
+ spawn_opt(Fun, [link, {min_heap_size, 1000000}, {priority, high}]).
+
+read_a_module({Dir, BaseName}, AppName, Builtins, Verbose, Warnings, Mode) ->
+ File = filename:join(Dir, BaseName),
+ case abst(File, Builtins, Mode) of
{ok, _M, no_abstract_code} when Verbose ->
- message(Verbose, skipped_beam, []),
- {ok, [], [], State};
+ message(Verbose, no_debug_info, [File]),
+ no;
{ok, _M, no_abstract_code} when not Verbose ->
message(Warnings, no_debug_info, [File]),
- {ok, [], [], State};
+ no;
{ok, M, Data, UnresCalls0} ->
- %% Remove duplicates. Identical unresolved calls on the
- %% same line are counted as _one_ unresolved call.
- UnresCalls = usort(UnresCalls0),
- message(Verbose, done, []),
- NoUnresCalls = length(UnresCalls),
- case NoUnresCalls of
- 0 -> ok;
- 1 -> warnings(Warnings, unresolved_summary1, [[M]]);
- N -> warnings(Warnings, unresolved_summary, [[M, N]])
- end,
- T = case xref_utils:file_info(File) of
- {ok, {_, _, _, Time}} -> Time;
- Error -> throw(Error)
- end,
- XMod = #xref_mod{name = M, app_name = AppName, dir = Dir,
- mtime = T, builtins = Builtins,
- no_unresolved = NoUnresCalls},
- do_add_module(State, XMod, UnresCalls, Data);
+ message(Verbose, done, [File]),
+ %% Remove duplicates. Identical unresolved calls on the
+ %% same line are counted as _one_ unresolved call.
+ UnresCalls = usort(UnresCalls0),
+ NoUnresCalls = length(UnresCalls),
+ case NoUnresCalls of
+ 0 -> ok;
+ 1 -> warnings(Warnings, unresolved_summary1, [[M]]);
+ N -> warnings(Warnings, unresolved_summary, [[M, N]])
+ end,
+ case xref_utils:file_info(File) of
+ {ok, {_, _, _, Time}} ->
+ XMod = #xref_mod{name = M, app_name = AppName,
+ dir = Dir, mtime = Time,
+ builtins = Builtins,
+ no_unresolved = NoUnresCalls},
+ {ok, PrepMod, Bad} =
+ prepare_module(Mode, XMod, UnresCalls, Data),
+ foreach(fun({Tag,B}) ->
+ warnings(Warnings, Tag,
+ [[File,B]])
+ end, Bad),
+ {ok, PrepMod};
+ Error -> Error
+ end;
Error ->
message(Verbose, error, []),
- throw(Error)
+ Error
end.
-abst(File, Builtins, Mode) when Mode =:= functions ->
+process_module(State) ->
+ receive
+ {?MODULE, Reply} ->
+ case Reply of
+ no ->
+ {ok, [], State};
+ {ok, PrepMod} ->
+ finish_module(PrepMod, State);
+ Error ->
+ throw(Error)
+ end
+ end.
+
+abst(File, Builtins, _Mode = functions) ->
case beam_lib:chunks(File, [abstract_code, exports, attributes]) of
{ok, {M,[{abstract_code,NoA},_X,_A]}} when NoA =:= no_abstract_code ->
{ok, M, NoA};
@@ -762,7 +816,7 @@ abst(File, Builtins, Mode) when Mode =:= functions ->
Error when element(1, Error) =:= error ->
Error
end;
-abst(File, Builtins, Mode) when Mode =:= modules ->
+abst(File, Builtins, _Mode = modules) ->
case beam_lib:chunks(File, [exports, imports, attributes]) of
{ok, {Mod, [{exports,X0}, {imports,I0}, {attributes,At}]}} ->
X1 = mfa_exports(X0, At, Mod),
@@ -856,19 +910,13 @@ deprecated_flag(_) -> undefined.
%% dom CallAt = LC U XC
%% Attrs is collected from the attribute 'xref' (experimental).
do_add_module(S, XMod, Unres, Data) ->
- M = XMod#xref_mod.name,
- case dict:find(M, S#xref.modules) of
- {ok, OldXMod} ->
- BF2 = module_file(XMod),
- BF1 = module_file(OldXMod),
- throw_error({module_clash, {M, BF1, BF2}});
- error ->
- do_add_module(S, M, XMod, Unres, Data)
- end.
+ #xref{mode = Mode} = S,
+ Mode = S#xref.mode,
+ {ok, PrepMod, Bad} = prepare_module(Mode, XMod, Unres, Data),
+ {ok, Ms, NS} = finish_module(PrepMod, S),
+ {ok, Ms, Bad, NS}.
-%%do_add_module(S, M, _XMod, _Unres, Data)->
-%% {ok, M, [], S};
-do_add_module(S, M, XMod, Unres0, Data) when S#xref.mode =:= functions ->
+prepare_module(_Mode = functions, XMod, Unres0, Data) ->
{DefAt0, LPreCAt0, XPreCAt0, LC0, XC0, X0, Attrs, Depr} = Data,
%% Bad is a list of bad values of 'xref' attributes.
{ALC0,AXC0,Bad0} = Attrs,
@@ -904,26 +952,27 @@ do_add_module(S, M, XMod, Unres0, Data) when S#xref.mode =:= functions ->
LC = union(LC1, ALC),
{DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X),
+ {EE, ECallAt} = inter_graph(X, L, LC, XC, CallAt),
+ {ok, {functions, XMod, [DefAt,L,X,LCallAt,XCallAt,CallAt,LC,XC,EE,ECallAt,
+ DF1,DF_11,DF_21,DF_31], NoCalls, Unres},
+ DBad++Bad};
+prepare_module(_Mode = modules, XMod, _Unres, Data) ->
+ {X0, I0, Depr} = Data,
+ X1 = xref_utils:xset(X0, [tspec(func)]),
+ I1 = xref_utils:xset(I0, [tspec(func)]),
+ {DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X1),
+ {ok, {modules, XMod, [X1,I1,DF1,DF_11,DF_21,DF_31]}, DBad}.
- %% {EE, ECallAt} = inter_graph(X, L, LC, XC, LCallAt, XCallAt),
- Self = self(),
- Fun = fun() -> inter_graph(Self, X, L, LC, XC, CallAt) end,
- {EE, ECallAt} =
- xref_utils:subprocess(Fun, [link, {min_heap_size,100000}]),
-
+finish_module({functions, XMod, List, NoCalls, Unres}, S) ->
+ ok = check_module(XMod, S),
[DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,LC2,XC2,EE2,ECallAt2,
- DF2,DF_12,DF_22,DF_32] =
- pack([DefAt,L,X,LCallAt,XCallAt,CallAt,LC,XC,EE,ECallAt,
- DF1,DF_11,DF_21,DF_31]),
-
- %% Foo = [DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,LC2,XC2,EE2,ECallAt2,
- %% DF2,DF_12,DF_22,DF_32],
- %% io:format("{~p, ~p, ~p},~n", [M, pack:lsize(Foo), pack:usize(Foo)]),
+ DF2,DF_12,DF_22,DF_32] = pack(List),
LU = range(LC2),
LPredefined = predefined_funs(LU),
+ M = XMod#xref_mod.name,
MS = xref_utils:xset(M, atom),
T = from_sets({MS,DefAt2,L2,X2,LCallAt2,XCallAt2,CallAt2,
LC2,XC2,LU,EE2,ECallAt2,Unres,LPredefined,
@@ -934,19 +983,28 @@ do_add_module(S, M, XMod, Unres0, Data) when S#xref.mode =:= functions ->
XMod1 = XMod#xref_mod{data = T, info = Info},
S1 = S#xref{modules = dict:store(M, XMod1, S#xref.modules)},
- {ok, [M], DBad++Bad, take_down(S1)};
-do_add_module(S, M, XMod, _Unres, Data) when S#xref.mode =:= modules ->
- {X0, I0, Depr} = Data,
- X1 = xref_utils:xset(X0, [tspec(func)]),
- I1 = xref_utils:xset(I0, [tspec(func)]),
- {DF1,DF_11,DF_21,DF_31,DBad} = depr_mod(Depr, X1),
- [X2,I2,DF2,DF_12,DF_22,DF_32] = pack([X1,I1,DF1,DF_11,DF_21,DF_31]),
+ {ok, [M], take_down(S1)};
+finish_module({modules, XMod, List}, S) ->
+ ok = check_module(XMod, S),
+ [X2,I2,DF2,DF_12,DF_22,DF_32] = pack(List),
+ M = XMod#xref_mod.name,
MS = xref_utils:xset(M, atom),
T = from_sets({MS, X2, I2, DF2, DF_12, DF_22, DF_32}),
Info = [],
XMod1 = XMod#xref_mod{data = T, info = Info},
S1 = S#xref{modules = dict:store(M, XMod1, S#xref.modules)},
- {ok, [M], DBad, take_down(S1)}.
+ {ok, [M], take_down(S1)}.
+
+check_module(XMod, State) ->
+ M = XMod#xref_mod.name,
+ case dict:find(M, State#xref.modules) of
+ {ok, OldXMod} ->
+ BF2 = module_file(XMod),
+ BF1 = module_file(OldXMod),
+ throw_error({module_clash, {M, BF1, BF2}});
+ error ->
+ ok
+ end.
depr_mod({Depr,Bad0}, X) ->
%% Bad0 are badly formed deprecated attributes.
@@ -992,9 +1050,6 @@ no_info(X, L, LC, XC, EE, Unres, NoCalls, NoUnresCalls) ->
%% Note: this is overwritten in do_set_up():
{no_inter_function_calls, no_elements(EE)}].
-inter_graph(Pid, X, L, LC, XC, CallAt) ->
- Pid ! {self(), inter_graph(X, L, LC, XC, CallAt)}.
-
%% Inter Call Graph.
%inter_graph(_X, _L, _LC, _XC, _CallAt) ->
% {empty_set(), empty_set()};
@@ -1727,7 +1782,7 @@ pack(T) ->
NT = pack1(T),
%% true = T =:= NT,
%% io:format("erasing ~p elements...~n", [length(erase())]),
- erase(), % wasting heap (and time)...
+ _ = erase(), % wasting heap (and time)...
foreach(fun({K,V}) -> put(K, V) end, PD),
NT.
@@ -1766,10 +1821,6 @@ tpack(T, I, L) ->
message(true, What, Arg) ->
case What of
- reading_beam ->
- io:format("~ts... ", Arg);
- skipped_beam ->
- io:format("skipped (no debug information)~n", Arg);
no_debug_info ->
io:format("Skipping ~ts (no debug information)~n", Arg);
unresolved_summary1 ->
@@ -1791,7 +1842,7 @@ message(true, What, Arg) ->
set_up ->
io:format("Setting up...", Arg);
done ->
- io:format("done~n", Arg);
+ io:format("done reading ~ts~n", Arg);
error ->
io:format("error~n", Arg);
Else ->
diff --git a/lib/tools/src/xref_utils.erl b/lib/tools/src/xref_utils.erl
index f69aa70244..b0c168e018 100644
--- a/lib/tools/src/xref_utils.erl
+++ b/lib/tools/src/xref_utils.erl
@@ -47,8 +47,6 @@
-export([options/2]).
--export([subprocess/2]).
-
-export([format_error/1]).
-import(lists, [append/1, delete/2, filter/2, foldl/3, foreach/2,
@@ -512,12 +510,6 @@ find_beam(Culprit) ->
options(Options, Valid) ->
split_options(Options, [], [], [], Valid).
-subprocess(Fun, Opts) ->
- Pid = spawn_opt(Fun, Opts),
- receive
- {Pid, Reply} -> Reply
- end.
-
format_error({error, Module, Error}) ->
Module:format_error(Error);
format_error({file_error, FileName, Reason}) ->
diff --git a/lib/tools/vsn.mk b/lib/tools/vsn.mk
index 8c889cbe4e..70564f05c6 100644
--- a/lib/tools/vsn.mk
+++ b/lib/tools/vsn.mk
@@ -1 +1 @@
-TOOLS_VSN = 2.8.4
+TOOLS_VSN = 2.8.3
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-09 21:22:53 +0000