diff --git a/doc/ref/statprof.texi b/doc/ref/statprof.texi index c481ac72e..5b99fb6b8 100644 --- a/doc/ref/statprof.texi +++ b/doc/ref/statprof.texi @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the GNU Guile Reference Manual. -@c Copyright (C) 2013 Free Software Foundation, Inc. +@c Copyright (C) 2013, 2015 Free Software Foundation, Inc. @c See the file guile.texi for copying conditions. @node Statprof @@ -220,7 +220,7 @@ The return value is a list of nodes, each of which is of the type: @end defun @anchor{statprof statprof}@defun statprof thunk [#:loop] [#:hz] [#:count-calls?] [#:full-stacks?] -Profiles the execution of @var{thunk}. +Profile the execution of @var{thunk}, and return its return values. The stack will be sampled @var{hz} times per second, and the thunk itself will be called @var{loop} times. @@ -236,7 +236,8 @@ retrieve the last-stored stacks. @end defun @anchor{statprof with-statprof}@defspec with-statprof args -Profiles the expressions in its body. +Profile the expressions in the body, and return the body's return +value. Keyword arguments: diff --git a/module/statprof.scm b/module/statprof.scm index 961f769e4..e613aad2d 100644 --- a/module/statprof.scm +++ b/module/statprof.scm @@ -1,7 +1,7 @@ ;;;; (statprof) -- a statistical profiler for Guile ;;;; -*-scheme-*- ;;;; -;;;; Copyright (C) 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc. +;;;; Copyright (C) 2009, 2010, 2011, 2013-2015 Free Software Foundation, Inc. ;;;; Copyright (C) 2004, 2009 Andy Wingo ;;;; Copyright (C) 2001 Rob Browning ;;;; @@ -829,15 +829,16 @@ The return value is a list of nodes, each of which is of the type: equal?)))) (define (call-thunk thunk) - (thunk) - (values)) + (call-with-values (lambda () (thunk)) + (lambda results + (apply values results)))) (define* (statprof thunk #:key (loop 1) (hz 100) (count-calls? #f) (port (current-output-port)) full-stacks?) - "Profiles the execution of @var{thunk}. + "Profile the execution of @var{thunk}, and return its return values. -The stack will be sampled @var{hz} times per second, and the thunk itself will -be called @var{loop} times. +The stack will be sampled @var{hz} times per second, and the thunk +itself will be called @var{loop} times. If @var{count-calls?} is true, all procedure calls will be recorded. This operation is somewhat expensive." @@ -853,15 +854,16 @@ operation is somewhat expensive." (statprof-start state)) (lambda () (let lp ((i loop)) - (unless (zero? i) + (unless (= i 1) (call-thunk thunk) - (lp (1- i))))) + (lp (1- i)))) + (call-thunk thunk)) (lambda () (statprof-stop state) (statprof-display port state)))))) (define-macro (with-statprof . args) - "Profiles the expressions in its body. + "Profile the expressions in the body, and return the body's return values. Keyword arguments: diff --git a/test-suite/tests/statprof.test b/test-suite/tests/statprof.test index b8607eb44..b799f58d3 100644 --- a/test-suite/tests/statprof.test +++ b/test-suite/tests/statprof.test @@ -45,6 +45,19 @@ (throw 'unresolved) (apply throw args)))))) +(pass-if-equal "return values" + '(42 77) + (call-with-values + (lambda () + (with-output-to-port (%make-void-port "w") + (lambda () + (with-statprof + (let loop ((i 10000)) + (if (zero? i) + (values 42 77) + (loop (1- i)))))))) + list)) + (pass-if "statistical sample counts within expected range" (when-implemented ;; test to see that if we call 3 identical functions equally, they