diff options
Diffstat (limited to 'lib/tools')
| -rw-r--r-- | lib/tools/doc/src/lcnt.xml | 10 | ||||
| -rw-r--r-- | lib/tools/doc/src/lcnt_chapter.xml | 30 | ||||
| -rw-r--r-- | lib/tools/doc/src/make.xml | 2 | ||||
| -rw-r--r-- | lib/tools/doc/src/notes.xml | 2 | ||||
| -rw-r--r-- | lib/tools/emacs/erlang-test.el | 2 | ||||
| -rw-r--r-- | lib/tools/emacs/erlang.el | 446 | ||||
| -rw-r--r-- | lib/tools/emacs/erldoc.el | 2 | ||||
| -rw-r--r-- | lib/tools/src/lcnt.erl | 2 | ||||
| -rw-r--r-- | lib/tools/src/make.erl | 2 | ||||
| -rw-r--r-- | lib/tools/src/tools.app.src | 2 | ||||
| -rw-r--r-- | lib/tools/src/xref_reader.erl | 2 | ||||
| -rw-r--r-- | lib/tools/test/Makefile | 2 | ||||
| -rw-r--r-- | lib/tools/test/lcnt_SUITE.erl | 85 | ||||
| -rw-r--r-- | lib/tools/test/make_SUITE.erl | 2 | ||||
| -rw-r--r-- | lib/tools/test/xref_SUITE.erl | 2 |
15 files changed, 224 insertions, 369 deletions
diff --git a/lib/tools/doc/src/lcnt.xml b/lib/tools/doc/src/lcnt.xml index 9c8ce148e9..6e66a957ab 100644 --- a/lib/tools/doc/src/lcnt.xml +++ b/lib/tools/doc/src/lcnt.xml @@ -38,7 +38,7 @@ <modulesummary>A runtime system Lock Profiling tool.</modulesummary> <description> <p>The <c>lcnt</c> module is used to profile the internal ethread locks in the - Erlang Runtime System. With <c>lcnt</c> enabled, Internal counters in the + Erlang Runtime System. With <c>lcnt</c> enabled, internal counters in the runtime system are updated each time a lock is taken. The counters stores information about the number of acquisition tries and the number of collisions that has occurred during the acquisition tries. The counters also record the @@ -47,17 +47,17 @@ <p> The data produced by the lock counters will give an estimate on how well the runtime system will behave from a parallelizable view point for the - scenarios tested. This tool was mainly developed to help erlang runtime + scenarios tested. This tool was mainly developed to help Erlang runtime developers iron out potential and generic bottlenecks. </p> <p>Locks in the emulator are named after what type of resource they protect and where in the emulator they are initialized, those are lock 'classes'. Most of those locks are also instantiated several times, and given unique identifiers, to increase locking granularity. Typically an instantiated lock protects a disjunct set of - the resource, i.e ets-tables, processes or ports. In other cases it protects a - specific range of a resource, e.g. <c>pix_lock</c> which protects index to process + the resource, for example ets tables, processes or ports. In other cases it protects a + specific range of a resource, for example <c>pix_lock</c> which protects index to process mappings, and is given a unique number within the class. A unique lock in <c>lcnt</c> - is referenced by a name (class) and an identifier, <c>{Name, Id}</c>. + is referenced by a name (class) and an identifier: <c>{Name, Id}</c>. </p> <p>Some locks in the system are static and protects global resources, for example <c>bif_timers</c> and the <c>run_queue</c> locks. Other locks are dynamic and not diff --git a/lib/tools/doc/src/lcnt_chapter.xml b/lib/tools/doc/src/lcnt_chapter.xml index 6cfdb5cf1b..1981d66117 100644 --- a/lib/tools/doc/src/lcnt_chapter.xml +++ b/lib/tools/doc/src/lcnt_chapter.xml @@ -42,42 +42,32 @@ completed its access to the resource and unlocked it. The <c>lcnt</c> tool measures these lock conflicts. </p> <p> - Locks has an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it + Locks have an inherent cost in execution time and memory space. It takes time initialize, destroy, aquiring or releasing locks. To decrease lock contention it some times necessary to use finer grained locking strategies. This will usually also increase the locking overhead and hence there is a tradeoff between lock contention and overhead. In general, lock contention increases with the number of threads running concurrently. The <c>lcnt</c> tool does not measure locking overhead. </p> <section> <title> Enabling lock-counting </title> - <p>For investigation of locks in the emulator we use an internal tool called <c>lcnt</c> (short for lock-count). The VM needs to be compiled with this option enabled. To enable this, use:</p> + <p>For investigation of locks in the emulator we use an internal tool called <c>lcnt</c> (short for lock-count). The VM needs to be compiled with this option enabled. + To compile a lock-counting VM along with a normal VM, use:</p> <pre> cd $ERL_TOP -./configure --enable-lock-counter - </pre> - - <p> - Another way to enable this alongside a normal VM is to compile it at emulator directory level, much like a debug build. To compile it this way do the following, - </p> - <pre> -cd $ERL_TOP/erts/emulator -make lcnt FLAVOR=smp - </pre> - <p> and then starting Erlang with,</p> +./configure --enable-lock-counter</pre> + <p>Start the lock-counting VM like this:</p> <pre> -$ERL_TOP/bin/cerl -lcnt - </pre> - <p>To verify that you lock-counting enabled check that <c>[lock-counting]</c> appears in the status text when the VM is started.</p> +$ERL_TOP/bin/erl -emu_type lcnt</pre> + <p>To verify that lock counting is enabled check that <c>[lock-counting]</c> appears in the status text when the VM is started.</p> <pre> -Erlang R13B03 (erts-5.7.4) [source] [64-bit] [smp:8:8] [rq:8] [async-threads:0] [hipe] - [kernel-poll:false] [lock-counting] - </pre> +Erlang/OTP 20 [erts-9.0] [64-bit] [smp:8:8] [ds:8:8:10] [async-threads:10] [hipe] + [kernel-poll:false] [lock-counting]</pre> </section> <section> <title>Getting started</title> <p>Once you have a lock counting enabled VM the module <c>lcnt</c> can be used. The module is intended to be used from the current running nodes shell. To access remote nodes use <c>lcnt:clear(Node)</c> and <c>lcnt:collect(Node)</c>. </p> <p>All locks are continuously monitored and its statistics updated. Use <c>lcnt:clear/0</c> to initially clear all counters before running any specific tests. This command will also reset the duration timer internally.</p> - <p>To retrieve lock statistics information use, <c>lcnt:collect/0,1</c>. The collect operation will start a <c>lcnt</c> server if it not already started. All collected data will be built into an erlang term and uploaded to the server and a duration time will also be uploaded. This duration is the time between <c>lcnt:clear/0,1</c> and <c>lcnt:collect/0,1</c>.</p> + <p>To retrieve lock statistics information, use <c>lcnt:collect/0,1</c>. The collect operation will start a <c>lcnt</c> server if it not already started. All collected data will be built into an Erlang term and uploaded to the server and a duration time will also be uploaded. This duration is the time between <c>lcnt:clear/0,1</c> and <c>lcnt:collect/0,1</c>.</p> <p>Once the data is collected to the server it can be filtered, sorted and printed in many different ways.</p> <p>See the <seealso marker="lcnt">reference manual</seealso> for a description of each function.</p> diff --git a/lib/tools/doc/src/make.xml b/lib/tools/doc/src/make.xml index 6b878f72fb..123fcd4afc 100644 --- a/lib/tools/doc/src/make.xml +++ b/lib/tools/doc/src/make.xml @@ -5,7 +5,7 @@ <header> <copyright> <year>1996</year> - <year>2016</year> + <year>2017</year> <holder>Ericsson AB, All Rights Reserved</holder> </copyright> <legalnotice> diff --git a/lib/tools/doc/src/notes.xml b/lib/tools/doc/src/notes.xml index af20200d49..bc17fd5307 100644 --- a/lib/tools/doc/src/notes.xml +++ b/lib/tools/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>2004</year><year>2016</year> + <year>2004</year><year>2017</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> diff --git a/lib/tools/emacs/erlang-test.el b/lib/tools/emacs/erlang-test.el index ea5d637199..efe3d515e9 100644 --- a/lib/tools/emacs/erlang-test.el +++ b/lib/tools/emacs/erlang-test.el @@ -8,7 +8,7 @@ ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2016. All Rights Reserved. +;; Copyright Ericsson AB 2016-2017. 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. diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index 59b20c552e..438abc2d29 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -9,7 +9,7 @@ ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 1996-2016. All Rights Reserved. +;; Copyright Ericsson AB 1996-2017. 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. @@ -97,18 +97,6 @@ Erlang mode menu." :type '(restricted-sexp :match-alternatives (stringp 'nil)) :safe (lambda (val) (or (eq nil val) (stringp val)))) -(defconst erlang-xemacs-p (string-match "Lucid\\|XEmacs" emacs-version) - "Non-nil when running under XEmacs or Lucid Emacs.") - -(defvar erlang-xemacs-popup-menu '("Erlang Mode Commands" . nil) - "Common popup menu for all buffers in Erlang mode. - -This variable is destructively modified every time the Erlang menu -is modified. The effect is that all changes take effect in all -buffers in Erlang mode, just like under GNU Emacs. - -Never EVER set this variable!") - (defvar erlang-menu-items '(erlang-menu-base-items erlang-menu-skel-items erlang-menu-shell-items @@ -128,17 +116,14 @@ variable.") (defvar erlang-menu-base-items '(("Indent" (("Indent Line" erlang-indent-command) - ("Indent Region " erlang-indent-region - (if erlang-xemacs-p (mark) mark-active)) + ("Indent Region " erlang-indent-region mark-active) ("Indent Clause" erlang-indent-clause) ("Indent Function" erlang-indent-function) ("Indent Buffer" erlang-indent-current-buffer))) ("Edit" (("Fill Comment" erlang-fill-paragraph) - ("Comment Region" comment-region - (if erlang-xemacs-p (mark) mark-active)) - ("Uncomment Region" erlang-uncomment-region - (if erlang-xemacs-p (mark) mark-active)) + ("Comment Region" comment-region mark-active) + ("Uncomment Region" uncomment-region mark-active) nil ("Beginning of Function" erlang-beginning-of-function) ("End of Function" erlang-end-of-function) @@ -576,8 +561,7 @@ This is an elisp list of options. Each option can be either: - a string") (eval-and-compile - (defvar erlang-regexp-modern-p - (if (> emacs-major-version 21) t nil) + (defvar erlang-regexp-modern-p t "Non-nil when this version of Emacs uses a modern version of regexp. Supporting \_< and \_> This is determined by checking the version of Emacs used.")) @@ -836,6 +820,8 @@ resulting regexp is surrounded by \\_< and \\_>." "list_to_float" "list_to_integer" "list_to_pid" + "list_to_port" + "list_to_ref" "list_to_tuple" "load_module" "make_ref" @@ -854,12 +840,14 @@ resulting regexp is surrounded by \\_< and \\_>." "port_command" "port_connect" "port_control" + "port_to_list" "pre_loaded" "process_flag" "process_info" "processes" "purge_module" "put" + "ref_to_list" "register" "registered" "round" @@ -940,7 +928,6 @@ resulting regexp is surrounded by \\_< and \\_>." "get_cookie" "get_module_info" "get_stacktrace" - "hash" "has_prepared_code_on_load" "hibernate" "insert_element" @@ -967,14 +954,12 @@ resulting regexp is surrounded by \\_< and \\_>." "port_get_data" "port_info" "port_set_data" - "port_to_list" "ports" "posixtime_to_universaltime" "prepare_loading" "process_display" "raise" "read_timer" - "ref_to_list" "resume_process" "send" "send_after" @@ -1053,8 +1038,7 @@ behaviour.") (define-key map "\M-q" 'erlang-fill-paragraph) (unless (boundp 'beginning-of-defun-function) (define-key map "\M-\C-a" 'erlang-beginning-of-function) - (define-key map "\M-\C-e" 'erlang-end-of-function) - (define-key map '(meta control h) 'erlang-mark-function)) ; Xemacs + (define-key map "\M-\C-e" 'erlang-end-of-function)) (define-key map "\M-\t" 'erlang-complete-tag) (define-key map "\C-c\M-\t" 'tempo-complete-tag) (define-key map "\M-+" 'erlang-find-next-tag) @@ -1069,7 +1053,7 @@ behaviour.") (define-key map "\C-c\C-l" 'erlang-compile-display) (define-key map "\C-c\C-s" 'erlang-show-syntactic-information) (define-key map "\C-c\C-q" 'erlang-indent-function) - (define-key map "\C-c\C-u" 'erlang-uncomment-region) + (define-key map "\C-c\C-u" 'uncomment-region) (define-key map "\C-c\C-y" 'erlang-clone-arguments) (define-key map "\C-c\C-a" 'erlang-align-arrows) (define-key map "\C-c\C-z" 'erlang-shell-display) @@ -1112,12 +1096,7 @@ behaviour.") "Font lock keyword highlighting a function header.") (defface erlang-font-lock-exported-function-name-face - (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)))) + '((default (:inherit font-lock-function-name-face))) "Face used for highlighting exported functions." :group 'erlang) @@ -1329,11 +1308,7 @@ Example: The difference between this and the standard Erlang Mode syntax table is that `_' is treated as part of words by -this syntax table. - -Unfortunately, XEmacs hasn't got support for a special Font -Lock syntax table. The effect is that `apply' in the atom -`foo_apply' will be highlighted as a bif.") +this syntax table.") (defvar erlang-replace-etags-tags-completion-table nil "Internal flag used by advice `erlang-replace-tags-table'. @@ -1353,18 +1328,9 @@ replaced by `erlang-etags-tags-completion-table'.") (defvar next-error-last-buffer)) (eval-when-compile - (if (or (featurep 'bytecomp) - (featurep 'byte-compile)) - (progn - (cond ((string-match "Lucid\\|XEmacs" emacs-version) - (put 'comment-indent-hook 'byte-obsolete-variable nil) - ;; Do not warn for unused variables - ;; when compiling under XEmacs. - (setq byte-compile-warnings - '(free-vars unresolved callargs redefine)))) - (require 'comint) - (require 'tempo) - (require 'compile)))) + (require 'comint) + (require 'tempo) + (require 'compile)) (defun erlang-version () @@ -1446,8 +1412,7 @@ Other commands: (erlang-tags-init) (erlang-font-lock-init) (erlang-skel-init) - (when (fboundp 'tempo-use-tag-list) - (tempo-use-tag-list 'erlang-tempo-tags)) + (tempo-use-tag-list 'erlang-tempo-tags) (when (and (fboundp 'add-function) (fboundp 'erldoc-eldoc-function)) (or eldoc-documentation-function (setq-local eldoc-documentation-function #'ignore)) @@ -1506,8 +1471,7 @@ Other commands: ;; delsel/pending-del mode. Also, set up text properties for bit ;; syntax handling. (mapc #'(lambda (cmd) - (put cmd 'delete-selection t) ;for delsel (Emacs) - (put cmd 'pending-delete t)) ;for pending-del (XEmacs) + (put cmd 'delete-selection t)) ;for delsel (Emacs) '(erlang-electric-semicolon erlang-electric-comma erlang-electric-gt)) @@ -1545,8 +1509,6 @@ Other commands: (make-local-variable 'indent-region-function) (setq indent-region-function 'erlang-indent-region) (set (make-local-variable 'comment-indent-function) 'erlang-comment-indent) - (if (<= emacs-major-version 18) - (set (make-local-variable 'comment-indent-hook) 'erlang-comment-indent)) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'dabbrev-case-fold-search) nil) (set (make-local-variable 'imenu-prev-index-position-function) @@ -1753,7 +1715,7 @@ menu configuration is changed." (defun erlang-menu-install (name items keymap &optional popup) - "Install a menu in Emacs or XEmacs based on an abstract description. + "Install a menu in Emacs based on an abstract description. NAME is the name of the menu. @@ -1764,32 +1726,15 @@ same same form as ITEMS. The third optional element is an expression which is evaluated every time the menu is displayed. Should the expression evaluate to nil the menu item is ghosted. -KEYMAP is the keymap to add to menu to. (When using XEmacs, the menu -will only be visible when this menu is the global, the local, or an -activate minor mode keymap.) - -If POPUP is non-nil, the menu is bound to the XEmacs `mode-popup-menu' -variable, i.e. it will popup when pressing the right mouse button. +KEYMAP is the keymap to add to menu to. Please see the variable `erlang-menu-base-items'." - (cond (erlang-xemacs-p - (let ((menu (erlang-menu-xemacs name items keymap))) - ;; We add the menu to the global menubar. - ;;(funcall (symbol-function 'set-buffer-menubar) - ;; (symbol-value 'current-menubar)) - (funcall (symbol-function 'add-submenu) nil menu) - (setcdr erlang-xemacs-popup-menu (cdr menu)) - (if (and popup (boundp 'mode-popup-menu)) - (funcall (symbol-function 'set) - 'mode-popup-menu erlang-xemacs-popup-menu)))) - ((>= emacs-major-version 19) - (define-key keymap (vector 'menu-bar (intern name)) - (erlang-menu-make-keymap name items))) - (t nil))) + (define-key keymap (vector 'menu-bar (intern name)) + (erlang-menu-make-keymap name items))) (defun erlang-menu-make-keymap (name items) - "Build a menu for Emacs 19." + "Build a menu." (let ((menumap (funcall (symbol-function 'make-sparse-keymap) name)) (count 0) @@ -1827,54 +1772,6 @@ Please see the variable `erlang-menu-base-items'." (setq items (cdr items))) (cons name menumap))) - -(defun erlang-menu-xemacs (name items &optional keymap) - "Build a menu for XEmacs." - (let ((res '()) - first second third entry) - (while items - ;; Replace any occurrence of atoms by their value. - (while (and items (atom (car items)) (not (null (car items)))) - (if (and (boundp (car items)) - (listp (symbol-value (car items)))) - (setq items (append (reverse (symbol-value (car items))) - (cdr items))) - (setq items (cdr items)))) - (setq first (car-safe (car items))) - (setq second (car-safe (cdr-safe (car items)))) - (setq third (car-safe (cdr-safe (cdr-safe (car items))))) - (cond ((null first) - (setq res (cons "------" res))) - ((symbolp second) - (setq res (cons (vector first second (or third t)) res))) - ((and (consp second) (eq (car second) 'lambda)) - (setq res (cons (vector first (list 'call-interactively second) - (or third t)) res))) - (t - (setq res (cons (cons first - (cdr (erlang-menu-xemacs - first second))) - res)))) - (setq items (cdr items))) - (setq res (reverse res)) - ;; When adding a menu to a minor-mode keymap under Emacs, - ;; it disappears when the mode is disabled. The expression - ;; generated below imitates this behaviour. - ;; (This could be expressed much clearer using backquotes, - ;; but I don't want to pull in every package.) - (if keymap - (let ((expr (list 'or - (list 'eq keymap 'global-map) - (list 'eq keymap (list 'current-local-map)) - (list 'symbol-value - (list 'car-safe - (list 'rassq - keymap - 'minor-mode-map-alist)))))) - (setq res (cons ':included (cons expr res))))) - (cons name res))) - - (defun erlang-menu-substitute (items alist) "Substitute functions in menu described by ITEMS. @@ -2278,7 +2175,7 @@ mode with the command `M-x erlang-mode RET'."))) ;; Skeleton code: ;; This code is based on the package `tempo' which is part of modern -;; Emacsen. (GNU Emacs 19.25 (?) and XEmacs 19.14.) +;; Emacsen. (defvar erlang-skel) (defun erlang-skel-init () @@ -2289,36 +2186,33 @@ all skeletons. The skeleton routines are based on the `tempo' package. Should this package not be present, this function does nothing." (interactive) - (condition-case nil - (require 'tempo) - (error t)) - (if (featurep 'tempo) - (let ((skel erlang-skel) - (menu '())) - (while skel - (cond ((null (car skel)) - (setq menu (cons nil menu))) - (t - (funcall (symbol-function 'tempo-define-template) - (concat "erlang-" (nth 1 (car skel))) - ;; The tempo template used contains an `include' - ;; function call only, hence changes to the - ;; variables describing the templates take effect - ;; immdiately. - (list (list 'erlang-skel-include (nth 2 (car skel)))) - (nth 1 (car skel)) - (car (car skel)) - 'erlang-tempo-tags) - (setq menu (cons (erlang-skel-make-menu-item - (car skel)) menu)))) - (setq skel (cdr skel))) - (setq erlang-menu-skel-items - (list nil (list "Skeletons" (nreverse menu)))) - (setq erlang-menu-items - (erlang-menu-add-above 'erlang-menu-skel-items - 'erlang-menu-version-items - erlang-menu-items)) - (erlang-menu-init)))) + (require 'tempo) + (let ((skel erlang-skel) + (menu '())) + (while skel + (cond ((null (car skel)) + (setq menu (cons nil menu))) + (t + (funcall (symbol-function 'tempo-define-template) + (concat "erlang-" (nth 1 (car skel))) + ;; The tempo template used contains an `include' + ;; function call only, hence changes to the + ;; variables describing the templates take effect + ;; immediately. + (list (list 'erlang-skel-include (nth 2 (car skel)))) + (nth 1 (car skel)) + (car (car skel)) + 'erlang-tempo-tags) + (setq menu (cons (erlang-skel-make-menu-item + (car skel)) menu)))) + (setq skel (cdr skel))) + (setq erlang-menu-skel-items + (list nil (list "Skeletons" (nreverse menu)))) + (setq erlang-menu-items + (erlang-menu-add-above 'erlang-menu-skel-items + 'erlang-menu-version-items + erlang-menu-items)) + (erlang-menu-init))) (defun erlang-skel-make-menu-item (skel) (let ((func (intern (concat "tempo-template-erlang-" (nth 1 skel))))) @@ -3263,11 +3157,8 @@ With argument, do this that many times." (interactive) (push-mark (point)) (erlang-end-of-clause 1) - ;; Sets the region. In Emacs 19 and XEmacs, we want to activate - ;; the region. - (condition-case nil - (push-mark (point) nil t) - (error (push-mark (point)))) + ;; Sets the region. + (push-mark (point) nil t) (erlang-beginning-of-clause 1) ;; The above function deactivates the mark. (if (boundp 'deactivate-mark) @@ -3375,11 +3266,8 @@ With negative argument go towards the beginning of the buffer." (interactive) (push-mark (point)) (erlang-end-of-function 1) - ;; Sets the region. In Emacs 19 and XEmacs, we want to activate - ;; the region. - (condition-case nil - (push-mark (point) nil t) - (error (push-mark (point)))) + ;; Sets the region. + (push-mark (point) nil t) (erlang-beginning-of-function 1) ;; The above function deactivates the mark. (if (boundp 'deactivate-mark) @@ -3462,13 +3350,6 @@ and initial `%':s." (fill-prefix comment-fill-prefix)) (fill-paragraph justify)))))) - -(defun erlang-uncomment-region (beg end) - "Uncomment all commented lines in the region." - (interactive "r") - (uncomment-region beg end)) - - (defun erlang-generate-new-clause () "Create additional Erlang clause header. @@ -3917,9 +3798,9 @@ of arguments could be found, otherwise nil." (if (and (stringp str) (not (string-match (eval-when-compile (concat "\\`" erlang-atom-regexp "\\'")) str))) - (progn (if (fboundp 'replace-regexp-in-string) - (setq str (replace-regexp-in-string "'" "\\'" str t t ))) - (concat "'" str "'")) + (progn + (setq str (replace-regexp-in-string "'" "\\'" str t t )) + (concat "'" str "'")) str))) @@ -4314,9 +4195,7 @@ context, nil is returned." (let* ((lim (or lim (save-excursion (erlang-beginning-of-clause) (point)))) - (state (if (fboundp 'syntax-ppss) ; post Emacs 21.3 - (funcall (symbol-function 'syntax-ppss)) - (parse-partial-sexp lim (point))))) + (state (funcall (symbol-function 'syntax-ppss)))) (cond ((eq (nth 3 state) ?') 'atom) ((nth 3 state) 'string) @@ -4426,14 +4305,8 @@ This function is designed to be a member of a criteria list." ;;; Erlang tags support which is aware of erlang modules. -;; Not yet implemented under XEmacs. (Hint: The Emacs 19 etags -;; package works under XEmacs.) - (eval-when-compile - (if (or (featurep 'bytecomp) - (featurep 'byte-compile)) - (progn - (require 'etags)))) + (require 'etags)) ;; Variables: @@ -4477,28 +4350,16 @@ After calling this function, the tags functions are aware of Erlang modules. Tags can be entered on the for `module:tag' as well as on the old form `tag'. -In the completion list, `module:tag' and `module:' shows up. - -This function only works under Emacs 18 and Emacs 19. Currently, It -is not implemented under XEmacs. (Hint: The Emacs 19 etags module -works under XEmacs.)" +In the completion list, `module:tag' and `module:' shows up." (interactive) - (cond ((= emacs-major-version 18) - (require 'tags) - (erlang-tags-define-keys (current-local-map)) - (setq erlang-tags-installed t)) - (t - (require 'etags) - (set (make-local-variable 'find-tag-default-function) - 'erlang-find-tag-for-completion) - (if (>= emacs-major-version 25) - (add-hook 'xref-backend-functions - #'erlang-etags--xref-backend nil t) - ;; Test on a function available in the Emacs 19 version - ;; of tags but not in the XEmacs version. - (when (fboundp 'find-tag-noselect) - (erlang-tags-define-keys (current-local-map)) - (setq erlang-tags-installed t)))))) + (require 'etags) + (set (make-local-variable 'find-tag-default-function) + 'erlang-find-tag-for-completion) + (if (>= emacs-major-version 25) + (add-hook 'xref-backend-functions + #'erlang-etags--xref-backend nil t) + (erlang-tags-define-keys (current-local-map)) + (setq erlang-tags-installed t))) @@ -4635,8 +4496,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (while (null file) (or erlang-tags-file-list (save-excursion - (if (and (featurep 'etags) - (funcall + (if (and (funcall (symbol-function 'visit-tags-table-buffer) 'same) (funcall (symbol-function 'visit-tags-table-buffer) t)) @@ -4655,35 +4515,12 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (find-file-noselect file))))) ((string-match ":" modtagname) - (if (boundp 'find-tag-tag-order) - ;; Method one: Add module-recognising functions to the - ;; list of order functions. However, the tags system - ;; from Emacs 18, and derives thereof (read: XEmacs) - ;; hasn't got this feature. - (progn - (erlang-tags-install-module-check) - (unwind-protect - (funcall (symbol-function 'find-tag) - modtagname next-p regexp-p) - (erlang-tags-remove-module-check))) - ;; Method two: Call the tags system until a file matching - ;; the module is found. This could result in that many - ;; files are read. (e.g. The tag "foo:file" will take a - ;; while to process.) - (let* ((modname (substring modtagname 0 (match-beginning 0))) - (tagname (substring modtagname (match-end 0) nil)) - (last-tag tagname) - file) - (while - (progn - (funcall (symbol-function 'find-tag) tagname next-p regexp-p) - (setq next-p t) - ;; Determine the module form the file name. (The - ;; alternative, to check `-module', would make this - ;; code useless for non-Erlang programs.) - (setq file (erlang-get-module-from-file-name buffer-file-name)) - (not (and (stringp file) - (string= modname file)))))))) + (progn + (erlang-tags-install-module-check) + (unwind-protect + (funcall (symbol-function 'find-tag) + modtagname next-p regexp-p) + (erlang-tags-remove-module-check)))) (t (funcall (symbol-function 'find-tag) modtagname next-p regexp-p))) (current-buffer))) ; Return the new buffer. @@ -4713,9 +4550,7 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (prompt (if default (format "%s(default %s) " prompt default) prompt)) - (spec (if (featurep 'etags) - (completing-read prompt 'erlang-tags-complete-tag) - (read-string prompt)))) + (spec (completing-read prompt 'erlang-tags-complete-tag))) (list (if (equal spec "") (or default (error "There is no default tag")) spec))))) @@ -4732,23 +4567,12 @@ Tags can be given on the forms `tag', `module:', `module:tag'." "Install our own tag search functions." ;; Make sure our functions are installed in TAGS files loaded ;; into Emacs while searching. - (cond - ((>= emacs-major-version 20) - (setq erlang-tags-orig-format-functions - (symbol-value 'tags-table-format-functions)) - (funcall (symbol-function 'set) 'tags-table-format-functions - (cons 'erlang-tags-recognize-tags-table - erlang-tags-orig-format-functions)) - (setq erlang-tags-buffer-list '()) - ) - (t - (setq erlang-tags-orig-format-hooks - (symbol-value 'tags-table-format-hooks)) - (funcall (symbol-function 'set) 'tags-table-format-hooks - (cons 'erlang-tags-recognize-tags-table - erlang-tags-orig-format-hooks)) - (setq erlang-tags-buffer-list '()) - )) + (setq erlang-tags-orig-format-functions + (symbol-value 'tags-table-format-functions)) + (funcall (symbol-function 'set) 'tags-table-format-functions + (cons 'erlang-tags-recognize-tags-table + erlang-tags-orig-format-functions)) + (setq erlang-tags-buffer-list '()) ;; Install our functions in the TAGS files already resident. (save-excursion @@ -4810,17 +4634,9 @@ Tags can be given on the forms `tag', `module:', `module:tag'." (defun erlang-tags-remove-module-check () "Remove our own tags search functions." - (cond - ((>= emacs-major-version 20) - (funcall (symbol-function 'set) - 'tags-table-format-functions - erlang-tags-orig-format-functions) - ) - (t - (funcall (symbol-function 'set) - 'tags-table-format-hooks - erlang-tags-orig-format-hooks) - )) + (funcall (symbol-function 'set) + 'tags-table-format-functions + erlang-tags-orig-format-functions) ;; Remove our functions from the TAGS files. (Note that ;; `tags-table-computed-list' need not be the same list as when @@ -4888,21 +4704,19 @@ for a tag on the form `module:tag'." ;;; completion-table' containing all normal tags plus tags on the form ;;; `module:tag' and `module:'. -(when (and (locate-library "etags") - (require 'etags) - (fboundp 'etags-tags-completion-table) - (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ - (if (fboundp 'advice-add) - ;; Emacs 24.4+ +(if (fboundp 'advice-add) + ;; Emacs 24.4+ + (progn + (require 'etags) (advice-add 'etags-tags-completion-table :around - #'erlang-etags-tags-completion-table-advice) - ;; Emacs 23.1-24.3 - (defadvice etags-tags-completion-table (around - erlang-replace-tags-table - activate) - (if erlang-replace-etags-tags-completion-table - (setq ad-return-value (erlang-etags-tags-completion-table)) - ad-do-it)))) + #'erlang-etags-tags-completion-table-advice)) + ;; Emacs 23.1-24.3 + (defadvice etags-tags-completion-table (around + erlang-replace-tags-table + activate) + (if erlang-replace-etags-tags-completion-table + (setq ad-return-value (erlang-etags-tags-completion-table)) + ad-do-it))) (defun erlang-etags-tags-completion-table-advice (oldfun) (if erlang-replace-etags-tags-completion-table @@ -4916,28 +4730,9 @@ Completes to the set of names listed in the current tags table. Should the Erlang tags system be installed this command knows about Erlang modules." (interactive) - (condition-case nil - (require 'etags) - (error nil)) - (cond ((and (fboundp 'etags-tags-completion-table) - (fboundp 'tags-lazy-completion-table)) ; Emacs 23.1+ - (let ((erlang-replace-etags-tags-completion-table t)) - (complete-tag))) - ((and erlang-tags-installed - (fboundp 'complete-tag) - (fboundp 'tags-complete-tag)) ; Emacs 19-22 - (let ((orig-tags-complete-tag (symbol-function 'tags-complete-tag))) - (fset 'tags-complete-tag - (symbol-function 'erlang-tags-complete-tag)) - (unwind-protect - (complete-tag) - (fset 'tags-complete-tag orig-tags-complete-tag)))) - ((fboundp 'complete-tag) ; Emacs 19 - (complete-tag)) - ((fboundp 'tag-complete-symbol) ; XEmacs - (funcall (symbol-function 'tag-complete-symbol))) - (t - (error "This version of Emacs can't complete tags")))) + (require 'etags) + (let ((erlang-replace-etags-tags-completion-table t)) + (complete-tag))) (defun erlang-find-tag-for-completion () @@ -5079,6 +4874,7 @@ considered first when it is time to jump to the definition.") (and (erlang-soft-require 'xref) (erlang-soft-require 'cl-generic) (erlang-soft-require 'eieio) + (erlang-soft-require 'etags) ;; The purpose of using eval here is to avoid compilation ;; warnings in emacsen without cl-defmethod etc. (eval @@ -5435,13 +5231,11 @@ The following special commands are available: 'inferior-erlang-strip-delete nil t) (add-hook 'comint-output-filter-functions 'inferior-erlang-strip-ctrl-m nil t) - ;; Some older versions of comint don't have an input ring. - (if (fboundp 'comint-read-input-ring) - (progn - (setq comint-input-ring-file-name erlang-input-ring-file-name) - (comint-read-input-ring t) - (make-local-variable 'kill-buffer-hook) - (add-hook 'kill-buffer-hook 'comint-write-input-ring))) + + (setq comint-input-ring-file-name erlang-input-ring-file-name) + (comint-read-input-ring t) + (make-local-variable 'kill-buffer-hook) + (add-hook 'kill-buffer-hook 'comint-write-input-ring) ;; At least in Emacs 21, we need to be in `compilation-minor-mode' ;; for `next-error' to work. We can avoid it clobbering the shell ;; keys thus. @@ -5559,10 +5353,7 @@ editing control characters: \\{erlang-shell-mode-map}" (interactive (when current-prefix-arg - (list (if (fboundp 'read-shell-command) - ;; `read-shell-command' is a new function in Emacs 23. - (read-shell-command "Erlang command: ") - (read-string "Erlang command: "))))) + (list (read-shell-command "Erlang command: ")))) (require 'comint) (let (cmd opts) (if command @@ -5590,10 +5381,8 @@ editing control characters: (setq inferior-erlang-process (get-buffer-process inferior-erlang-buffer)) - (if (> 21 emacs-major-version) ; funcalls to avoid compiler warnings - (funcall (symbol-function 'set-process-query-on-exit-flag) - inferior-erlang-process nil) - (funcall (symbol-function 'process-kill-without-query) inferior-erlang-process)) + (funcall (symbol-function 'set-process-query-on-exit-flag) + inferior-erlang-process nil) (if erlang-inferior-shell-split-window (switch-to-buffer-other-window inferior-erlang-buffer) (switch-to-buffer inferior-erlang-buffer)) @@ -5661,7 +5450,7 @@ frame will become deselected before the next command." (defun inferior-erlang-window (&optional all-frames) "Return the window containing the inferior Erlang, or nil." (and (inferior-erlang-running-p) - (if (and all-frames (>= emacs-major-version 19)) + (if all-frames (get-buffer-window inferior-erlang-buffer t) (get-buffer-window inferior-erlang-buffer)))) @@ -5733,10 +5522,7 @@ Return the position after the newly inserted command." ;; has been sorted out in Emacs 21. -- fx (let ((comint-eol-on-send nil) (comint-input-filter (if hist comint-input-filter 'ignore))) - (if (and (not erlang-xemacs-p) - (>= emacs-major-version 22)) - (comint-send-input nil t) - (comint-send-input))) + (comint-send-input nil t)) ;; Adjust all windows whose points are incorrect. (if (null comint-process-echoes) (walk-windows @@ -6120,8 +5906,7 @@ Tab characters are counted by their visual width." 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 "long ago"))) + (make-obsolete sym newdef "long ago")) (erlang-obsolete 'calculate-erlang-indent 'erlang-calculate-indent) @@ -6141,9 +5926,8 @@ it assumes that NEWDEF is loaded." (defconst erlang-unload-hook (list (lambda () - (when (featurep 'advice) - (ad-unadvise 'Man-notify-when-ready) - (ad-unadvise 'set-visited-file-name))))) + (ad-unadvise 'Man-notify-when-ready) + (ad-unadvise 'set-visited-file-name)))) ;; The end... diff --git a/lib/tools/emacs/erldoc.el b/lib/tools/emacs/erldoc.el index 348800f880..770ab299ee 100644 --- a/lib/tools/emacs/erldoc.el +++ b/lib/tools/emacs/erldoc.el @@ -2,7 +2,7 @@ ;; %CopyrightBegin% ;; -;; Copyright Ericsson AB 2016. All Rights Reserved. +;; Copyright Ericsson AB 2016-2017. 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. diff --git a/lib/tools/src/lcnt.erl b/lib/tools/src/lcnt.erl index 864d62f6c5..d881fedbd5 100644 --- a/lib/tools/src/lcnt.erl +++ b/lib/tools/src/lcnt.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2010-2016. All Rights Reserved. +%% Copyright Ericsson AB 2010-2017. 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. diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl index 0363dee02d..ce30156db6 100644 --- a/lib/tools/src/make.erl +++ b/lib/tools/src/make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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. diff --git a/lib/tools/src/tools.app.src b/lib/tools/src/tools.app.src index 17b1d06686..12f0cfd2df 100644 --- a/lib/tools/src/tools.app.src +++ b/lib/tools/src/tools.app.src @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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. diff --git a/lib/tools/src/xref_reader.erl b/lib/tools/src/xref_reader.erl index 6c4a1c4d8e..88f92df35a 100644 --- a/lib/tools/src/xref_reader.erl +++ b/lib/tools/src/xref_reader.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2015. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. 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. diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index fe65d1484d..2b7b17afb3 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -1,7 +1,7 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 1997-2016. All Rights Reserved. +# Copyright Ericsson AB 1997-2017. 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. diff --git a/lib/tools/test/lcnt_SUITE.erl b/lib/tools/test/lcnt_SUITE.erl index d39a5deeab..2e48b11740 100644 --- a/lib/tools/test/lcnt_SUITE.erl +++ b/lib/tools/test/lcnt_SUITE.erl @@ -29,7 +29,8 @@ -export([t_load/1, t_conflicts/1, t_locations/1, - t_swap_keys/1]). + t_swap_keys/1, + smoke_lcnt/1]). init_per_testcase(_Case, Config) -> Config. @@ -43,7 +44,8 @@ suite() -> {timetrap,{minutes,4}}]. all() -> - [t_load, t_conflicts, t_locations, t_swap_keys]. + [t_load, t_conflicts, t_locations, t_swap_keys, + smoke_lcnt]. %%---------------------------------------------------------------------- %% Tests @@ -146,3 +148,82 @@ t_swap_keys_file([File|Files]) -> ok = lcnt:conflicts(), ok = lcnt:stop(), t_swap_keys_file(Files). + +%% Simple smoke test of actual lock-counting, if running on +%% a run-time with lock-counting enabled. + +smoke_lcnt(Config) -> + case erlang:system_info(build_type) of + lcnt -> + do_smoke_lcnt(Config); + _ -> + {skip,"Lock counting is not enabled"} + end. + +do_smoke_lcnt(Config) -> + PrivDir = proplists:get_value(priv_dir, Config), + SaveFile = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)), + {Time,ok} = timer:tc(fun() -> lcnt:apply(fun() -> big_bang(200) end) end), + io:format("~p ms\n", [Time]), + ok = lcnt:conflicts(), + ok = lcnt:save(SaveFile), + ok = lcnt:load(SaveFile), + ok = lcnt:conflicts(), + lcnt:stop(). + + +%%% +%%% A slightly modified version of Rickard Green's Big Bang benchmark. +%%% + +big_bang(N) when is_integer(N) -> + Procs = spawn_procs(N), + RMsgs = lists:map(fun (P) -> {done, P} end, Procs), + send_procs(Procs, {procs, Procs, self()}), + receive_msgs(RMsgs), + lists:foreach(fun (P) -> exit(P, normal) end, Procs). + +pinger([], [], true) -> + receive + {procs, Procs, ReportTo} -> + pinger(Procs, [], ReportTo) + end; +pinger([], [], false) -> + receive {ping, From} -> From ! {pong, self()} end, + pinger([],[],false); +pinger([], [], ReportTo) -> + ReportTo ! {done, self()}, + pinger([],[],false); +pinger([],[Po|Pos] = Pongers, ReportTo) -> + receive + {ping, From} -> + From ! {pong, self()}, + pinger([], Pongers, ReportTo); + {pong, Po} -> + pinger([], Pos, ReportTo) + end; +pinger([Pi|Pis], Pongers, ReportTo) -> + receive {ping, From} -> From ! {pong, self()} + after 0 -> ok + end, + Pi ! {ping, self()}, + pinger(Pis, [Pi|Pongers], ReportTo). + +spawn_procs(N) when N =< 0 -> + []; +spawn_procs(N) -> + [spawn_link(fun () -> pinger([], [], true) end) | spawn_procs(N-1)]. + +send_procs([], Msg) -> + Msg; +send_procs([P|Ps], Msg) -> + P ! Msg, + send_procs(Ps, Msg). + +receive_msgs([]) -> + ok; +receive_msgs([M|Ms]) -> + receive + M -> + receive_msgs(Ms) + end. diff --git a/lib/tools/test/make_SUITE.erl b/lib/tools/test/make_SUITE.erl index 2db5c6844a..2f6fe1c732 100644 --- a/lib/tools/test/make_SUITE.erl +++ b/lib/tools/test/make_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2016. All Rights Reserved. +%% Copyright Ericsson AB 1996-2017. 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. diff --git a/lib/tools/test/xref_SUITE.erl b/lib/tools/test/xref_SUITE.erl index b8e7113595..057449d4a2 100644 --- a/lib/tools/test/xref_SUITE.erl +++ b/lib/tools/test/xref_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2016. All Rights Reserved. +%% Copyright Ericsson AB 2000-2017. 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. |