branch: elpa/flamegraph
commit 3fadfa01eca01c2fb03206b86ef5313c20cc4567
Author: Dmitry Gutov <[email protected]>
Commit: Dmitry Gutov <[email protected]>
Avoid descending into function-quoted callees
---
flamegraph.el | 21 ++++++++++++++++-----
test/flamegraph-tests.el | 47 +++++++++++++++++++++++++++++++++++++++++++++++
2 files changed, 63 insertions(+), 5 deletions(-)
diff --git a/flamegraph.el b/flamegraph.el
index b3134a44a6..753270ebf4 100644
--- a/flamegraph.el
+++ b/flamegraph.el
@@ -693,6 +693,18 @@ exists (top level)."
(cons beg (progn (forward-sexp) (point))))
(error nil))))
+(defun flamegraph--enclosing-head-form-region (pos)
+ "Return enclosing form region when POS is at that form's head.
+For an occurrence in `(foo ...)', POS on `foo' returns the form's
+region. For quoted or function-quoted references such as `'foo' or
+`#'foo' in another call's arguments, return nil: the occurrence can
+identify that frame, but it cannot anchor that frame's own callees."
+ (when-let* ((region (flamegraph--enclosing-form-region pos)))
+ (save-excursion
+ (goto-char (1+ (car region)))
+ (forward-comment (point-max))
+ (and (= (point) pos) region))))
+
(defun flamegraph--callee-name-acceptable-p (name)
"Whether NAME is plausibly a symbol we can usefully search in source.
Rejects empty strings and anything containing whitespace, brackets,
@@ -776,14 +788,13 @@ callees the snippet omits."
(setq found t)
(when (>= weight flamegraph-call-site-threshold)
(push (list mb me weight) regions))
- (when-let* ((sub
(flamegraph--enclosing-form-region
+ (when-let* ((sub
(flamegraph--enclosing-head-form-region
mb)))
;; Search K's own calls in this call's
;; arguments: from past the matched head to the
- ;; form end, clamped to REGION so a stray
- ;; enclosing form cannot widen it. Starting at
- ;; the head's end keeps a recursive callee from
- ;; re-matching its own name.
+ ;; form end, clamped to REGION. References in
+ ;; arguments, like #'foo, identify `foo' but do
+ ;; not expose `foo''s body at that site.
(walk k (cons me (min (cdr sub) (cdr region)))
nil)))))
(when (or found concealed-ok anonymous)
diff --git a/test/flamegraph-tests.el b/test/flamegraph-tests.el
index d118e64343..29b8917082 100644
--- a/test/flamegraph-tests.el
+++ b/test/flamegraph-tests.el
@@ -96,6 +96,21 @@
(should (equal (buffer-substring-no-properties (car r) (cdr r))
"(bar (baz))")))))
+(ert-deftest flamegraph-test-enclosing-head-form-region ()
+ "Only a form head can anchor that form's argument region."
+ (with-temp-buffer
+ (emacs-lisp-mode)
+ (insert "(foo #'bar (baz))")
+ (goto-char (point-min))
+ (re-search-forward "\\_<foo\\_>")
+ (should (flamegraph--enclosing-head-form-region (match-beginning 0)))
+ (goto-char (point-min))
+ (re-search-forward "\\_<bar\\_>")
+ (should-not (flamegraph--enclosing-head-form-region (match-beginning 0)))
+ (goto-char (point-min))
+ (re-search-forward "\\_<baz\\_>")
+ (should (flamegraph--enclosing-head-form-region (match-beginning 0)))))
+
;;; Walker — `flamegraph--collect-nested-call-sites'
(defmacro flamegraph-test--with-elisp-source (src &rest body)
@@ -344,6 +359,38 @@ under `wrap'. `not-in-source' is `leaf''s body -> not
shown."
(should (gethash leaf shown))
(should-not (gethash hidden shown)))))
+(ert-deftest flamegraph-test-walker-quoted-function-does-not-anchor-body ()
+ "A `#'callee' argument identifies CALLEE but not CALLEE's body.
+Calls in the same argument list still belong to the surrounding call's
+region."
+ (flamegraph-test--with-elisp-source
+ "(defun outer ()
+ (apply #'callee buffer
+ (list (argument-call))))"
+ (let* ((callee-body (profiler-make-calltree :entry 'callee-body
+ :count 10))
+ (callee (profiler-make-calltree :entry 'callee :count 10
+ :children (list callee-body)))
+ (argument-call (profiler-make-calltree :entry 'argument-call
+ :count 2))
+ (list-node (profiler-make-calltree :entry 'list :count 2
+ :children (list argument-call)))
+ (apply-node (profiler-make-calltree :entry 'apply :count 12
+ :children (list callee
+ list-node)))
+ (outer (profiler-make-calltree :entry 'outer :count 12
+ :children (list apply-node)))
+ (shown (make-hash-table :test 'eq))
+ (regions (flamegraph--collect-nested-call-sites
+ outer (point-min) (point-max) shown)))
+ (should (equal (flamegraph-test--region-texts regions)
+ '("apply" "callee" "list" "argument-call")))
+ (should (gethash apply-node shown))
+ (should (gethash callee shown))
+ (should-not (gethash callee-body shown))
+ (should (gethash list-node shown))
+ (should (gethash argument-call shown)))))
+
(ert-deftest flamegraph-test-walker-below-threshold-dropped ()
"Callees below `flamegraph-call-site-threshold' are dropped with subtree.
hot at 50% is kept; cold at 1% (and its child) are not."
