[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-107-g7e822
|
From: |
Andy Wingo |
|
Subject: |
[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-107-g7e822b3 |
|
Date: |
Mon, 23 Apr 2012 19:47:42 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7e822b32d2a165a027fd1de4d59fdfae568599bf
The branch, stable-2.0 has been updated
via 7e822b32d2a165a027fd1de4d59fdfae568599bf (commit)
via b064d565141ca777778fa38e0fe98c0aed834eb9 (commit)
via d10f7b572c0ca1ccef87f9c46069daa30946e0cf (commit)
from 7a4188c4492736f7afd7304a01eaebc3474ccdee (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 7e822b32d2a165a027fd1de4d59fdfae568599bf
Author: Andy Wingo <address@hidden>
Date: Mon Apr 23 04:42:09 2012 -0400
modernize (benchmark-suite lib)
* benchmark-suite/benchmark-suite/lib.scm: Rewrite to be more modern,
using parameters, records, and higher precision timers. Since this
file was never installed, this is an acceptable interface change.
(run-benchmark): Run the thunk once before going into the benchmark.
Adapt to new `report' interface.
(report): Change to expect only one argument, a <benchmark-result>
object.
(print-result): Adapt. The result is in the same format as before.
(print-user-result): Adapt. The result is different from before, but
as this is just printed on stdout and not logged, there should be no
problem.
(calibrate-benchmark-framework): Pull initialization into a function.
commit b064d565141ca777778fa38e0fe98c0aed834eb9
Author: Andy Wingo <address@hidden>
Date: Mon Apr 23 04:27:34 2012 -0400
avoid inexact iteration count in benchmarks
* benchmark-suite/benchmarks/arithmetic.bm:
* benchmark-suite/benchmarks/r6rs-arithmetic.bm: Use #e1e7 for the
iteration count, instead of the flonum 1e7.
commit d10f7b572c0ca1ccef87f9c46069daa30946e0cf
Author: Andy Wingo <address@hidden>
Date: Sat Apr 21 17:06:48 2012 -0400
move (test-suite lib) to lower dir; cleans up uninstalled paths.
* check-guile.in:
* test-suite/Makefile.am:
* test-suite/test-suite/lib.scm:
* benchmark-guile.in:
* benchmark-suite/Makefile.am:
* benchmark-suite/benchmark-suite/lib.scm: Lower the lib modules in the
source tree. This lets us remove top_srcdir and top_builddir from the
uninstalled paths.
* test-suite/tests/asm-to-bytecode.test:
* test-suite/tests/brainfuck.test:
* test-suite/tests/compiler.test:
* test-suite/tests/ftw.test:
* test-suite/tests/gc.test:
* test-suite/tests/match.test:
* test-suite/tests/rnrs-libraries.test:
* test-suite/tests/rnrs-test-a.scm:
* test-suite/tests/sxml.match.test: Adapt to not expect that module
names be prefixed with "test-suite".
-----------------------------------------------------------------------
Summary of changes:
benchmark-guile.in | 1 +
benchmark-suite/Makefile.am | 3 +-
benchmark-suite/{ => benchmark-suite}/lib.scm | 442 +++++++++++-------------
benchmark-suite/benchmarks/arithmetic.bm | 14 +-
benchmark-suite/benchmarks/r6rs-arithmetic.bm | 8 +-
check-guile.in | 1 +
meta/uninstalled-env.in | 12 +-
test-suite/Makefile.am | 4 +-
test-suite/{ => test-suite}/lib.scm | 0
test-suite/tests/asm-to-bytecode.test | 2 +-
test-suite/tests/brainfuck.test | 2 +-
test-suite/tests/compiler.test | 4 +-
test-suite/tests/ftw.test | 10 +-
test-suite/tests/gc.test | 2 +-
test-suite/tests/match.test | 4 +-
test-suite/tests/rnrs-libraries.test | 16 +-
test-suite/tests/rnrs-test-a.scm | 4 +-
test-suite/tests/sxml.match.test | 4 +-
18 files changed, 252 insertions(+), 281 deletions(-)
rename benchmark-suite/{ => benchmark-suite}/lib.scm (51%)
rename test-suite/{ => test-suite}/lib.scm (100%)
diff --git a/benchmark-guile.in b/benchmark-guile.in
index 572e008..8378e9d 100644
--- a/benchmark-guile.in
+++ b/benchmark-guile.in
@@ -41,6 +41,7 @@ if [ ! -f guile-procedures.txt ] ; then
fi
exec $guile \
+ -L "$BENCHMARK_SUITE_DIR" \
-e main -s "$BENCHMARK_SUITE_DIR/guile-benchmark" \
--benchmark-suite "$BENCHMARK_SUITE_DIR/benchmarks" \
--log-file benchmark-guile.log "$@"
diff --git a/benchmark-suite/Makefile.am b/benchmark-suite/Makefile.am
index f29743f..9fa5568 100644
--- a/benchmark-suite/Makefile.am
+++ b/benchmark-suite/Makefile.am
@@ -18,5 +18,6 @@ SCM_BENCHMARKS = benchmarks/0-reference.bm \
benchmarks/write.bm \
benchmarks/strings.bm
-EXTRA_DIST = guile-benchmark lib.scm $(SCM_BENCHMARKS) \
+EXTRA_DIST = guile-benchmark benchmark-suite/lib.scm \
+ $(SCM_BENCHMARKS) \
ChangeLog-2008
diff --git a/benchmark-suite/lib.scm b/benchmark-suite/benchmark-suite/lib.scm
similarity index 51%
rename from benchmark-suite/lib.scm
rename to benchmark-suite/benchmark-suite/lib.scm
index 4ba0e3e..ae57cc0 100644
--- a/benchmark-suite/lib.scm
+++ b/benchmark-suite/benchmark-suite/lib.scm
@@ -1,5 +1,5 @@
;;;; benchmark-suite/lib.scm --- generic support for benchmarking
-;;;; Copyright (C) 2002, 2006, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2002, 2006, 2011, 2012 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -17,31 +17,33 @@
;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (benchmark-suite lib)
- :export (
-
- ;; Controlling the execution.
- iteration-factor
- scale-iterations
-
- ;; Running benchmarks.
- run-benchmark
- benchmark
-
- ;; Naming groups of benchmarks in a regular fashion.
- with-benchmark-prefix with-benchmark-prefix* current-benchmark-prefix
- format-benchmark-name
-
- ;; Computing timing results
- benchmark-time-base
- benchmark-total-time benchmark-user-time benchmark-system-time
- benchmark-frame-time benchmark-core-time
- benchmark-user-time\interpreter benchmark-core-time\interpreter
-
- ;; Reporting results in various ways.
- register-reporter unregister-reporter reporter-registered?
- make-log-reporter
- full-reporter
- user-reporter))
+ #:use-module (srfi srfi-9)
+ #:export (;; Controlling the execution.
+ iteration-factor
+ scale-iterations
+
+ ;; Running benchmarks.
+ run-benchmark
+ benchmark
+
+ ;; Naming groups of benchmarks in a regular fashion.
+ with-benchmark-prefix with-benchmark-prefix*
+ current-benchmark-prefix format-benchmark-name
+
+ ;; <benchmark-result> accessors
+ benchmark-result:name
+ benchmark-result:iterations
+ benchmark-result:real-time
+ benchmark-result:run-time
+ benchmark-result:gc-time
+ benchmark-result:core-time
+
+ ;; Reporting results in various ways.
+ report current-reporter
+ register-reporter unregister-reporter reporter-registered?
+ make-log-reporter
+ full-reporter
+ user-reporter))
;;;; If you're using Emacs's Scheme mode:
@@ -214,81 +216,71 @@
;;;; TIME CALCULATION
;;;;
-;;;; The library uses the guile functions (times) and (gc-run-time) to
-;;;; determine the execution time for a single benchmark. Based on these
-;;;; functions, the values of BEFORE, AFTER and GC-TIME are computed, which
-;;;; are then passed to the reporter functions. All three values BEFORE,
-;;;; AFTER and GC-TIME include the time needed to executed the benchmark code
-;;;; itself, but also the surrounding code that implements the loop to run the
-;;;; benchmark code for the given number of times. This is undesirable, since
-;;;; one would prefer to only get the timing data for the benchmarking code.
+;;;; The library uses the guile functions `get-internal-run-time',
+;;;; `get-internal-real-time', and `gc-run-time' to determine the
+;;;; execution time for a single benchmark. Based on these functions,
+;;;; Guile makes a <benchmark-result>, a record containing the elapsed
+;;;; run time, real time, gc time, and possibly other metrics. These
+;;;; times include the time needed to executed the benchmark code
+;;;; itself, but also the surrounding code that implements the loop to
+;;;; run the benchmark code for the given number of times. This is
+;;;; undesirable, since one would prefer to only get the timing data for
+;;;; the benchmarking code.
;;;;
;;;; To cope with this, the benchmarking framework uses a trick: During
-;;;; initialization of the library, the time for executing an empty benchmark
-;;;; is measured and stored. This is an estimate for the time needed by the
-;;;; benchmarking framework itself. For later benchmarks, this time can then
-;;;; be subtracted from the measured execution times.
-;;;;
-;;;; In order to simplify the time calculation for users who want to write
-;;;; their own reporters, benchmarking framework provides the following
-;;;; definitions:
-;;;;
-;;;; benchmark-time-base : This variable holds the number of time units that
-;;;; make up a second. By deviding the results of each of the functions
-;;;; below by this value, you get the corresponding time in seconds. For
-;;;; example (/ (benchmark-total-time before after) benchmark-time-base)
-;;;; will give you the total time in seconds.
-;;;; benchmark-total-time : this function takes two arguments BEFORE and AFTER
-;;;; and computes the total time between the two timestamps. The result
-;;;; of this function is what the time command of the unix command line
-;;;; would report as real time.
-;;;; benchmark-user-time : this function takes two arguments BEFORE and AFTER
-;;;; and computes the time spent in the benchmarking process between the
-;;;; two timestamps. That means, the time consumed by other processes
-;;;; running on the same machine is not part of the resulting time,
-;;;; neither is time spent within the operating system. The result of
-;;;; this function is what the time command of the unix command line would
-;;;; report as user time.
-;;;; benchmark-system-time : similar to benchmark-user-time, but here the time
-;;;; spent within the operating system is given. The result of this
-;;;; function is what the time command of the unix command line would
-;;;; report as system time.
-;;;; benchmark-frame-time : this function takes the argument ITERATIONS. It
-;;;; reports the part of the user time that is consumed by the
-;;;; benchmarking framework itself to run some benchmark for the given
-;;;; number of iterations. You can think of this as the time that would
-;;;; still be consumed, even if the benchmarking code itself was empty.
-;;;; This value does not include any time for garbage collection, even if
-;;;; it is the benchmarking framework which is responsible for causing a
-;;;; garbage collection.
-;;;; benchmark-core-time : this function takes three arguments ITERATIONS,
-;;;; BEFORE and AFTER. It reports the part of the user time that is
-;;;; actually spent within the benchmarking code. That is, the time
-;;;; needed for the benchmarking framework is subtracted from the user
-;;;; time. This value, however, includes all garbage collection times,
-;;;; even if some part of the gc-time had actually to be attributed to the
-;;;; benchmarking framework.
-;;;; benchmark-user-time\interpreter : this function takes three arguments
-;;;; BEFORE AFTER and GC-TIME. It reports the part of the user time that
-;;;; is spent in the interpreter (and not in garbage collection).
-;;;; benchmark-core-time\interpreter : this function takes four arguments
-;;;; ITERATIONS, BEFORE, AFTER. and GC-TIME. It reports the part of the
-;;;; benchmark-core-time that is spent in the interpreter (and not in
-;;;; garbage collection). This value is most probably the one you are
-;;;; interested in, except if you are doing some garbage collection
-;;;; checks.
-;;;;
-;;;; There is no function to calculate the garbage-collection time, since the
-;;;; garbage collection time is already passed as an argument GC-TIME to the
-;;;; reporter functions.
+;;;; initialization of the library, the time for executing an empty
+;;;; benchmark is measured and stored. This is an estimate for the time
+;;;; needed by the benchmarking framework itself. For later benchmarks,
+;;;; this time can then be subtracted from the measured execution times.
+;;;; Note that for very short benchmarks, this may result in a negative
+;;;; number.
+;;;;
+;;;; The benchmarking framework provides the following accessors for
+;;;; <benchmark-result> values. Note that all time values are in
+;;;; internal time units; divide by internal-time-units-per-second to
+;;;; get seconds.
+;;;;
+;;;; benchmark-result:name : Return the name of the benchmark.
+;;;;
+;;;; benchmark-result:iterations : Return the number of iterations that
+;;;; this benchmark ran for.
+;;;;
+;;;; benchmark-result:real-time : Return the clock time elapsed while
+;;;; this benchmark executed.
+;;;;
+;;;; benchmark-result:run-time : Return the CPU time elapsed while this
+;;;; benchmark executed, both in user and kernel space.
+;;;;
+;;;; benchmark-result:gc-time : Return the approximate amount of time
+;;;; spent in garbage collection while this benchmark executed, both
+;;;; in user and kernel space.
+;;;;
+;;;; benchmark-result:core-time : Like benchmark-result:run-time, but
+;;;; also estimates the time spent by the framework for the number
+;;;; of iterations, and subtracts off that time from the result.
+;;;;
+
+;;;; This module is used when benchmarking different Guiles, and so it
+;;;; should run on all the Guiles of interest. Currently this set
+;;;; includes Guile 1.8, so be careful with introducing features that
+;;;; only Guile 2.0 supports.
;;;; MISCELLANEOUS
;;;;
+(define-record-type <benchmark-result>
+ (make-benchmark-result name iterations real-time run-time gc-time)
+ benchmark-result?
+ (name benchmark-result:name)
+ (iterations benchmark-result:iterations)
+ (real-time benchmark-result:real-time)
+ (run-time benchmark-result:run-time)
+ (gc-time benchmark-result:gc-time))
+
;;; Perform a division and convert the result to inexact.
-(define (i/ a b)
- (exact->inexact (/ a b)))
+(define (->seconds time)
+ (/ time 1.0 internal-time-units-per-second))
;;; Scale the number of iterations according to the given scaling factor.
(define iteration-factor 1)
@@ -296,36 +288,49 @@
(let* ((i (inexact->exact (round (* iterations iteration-factor)))))
(if (< i 1) 1 i)))
+;;; Parameters.
+(cond-expand
+ (srfi-39 #t)
+ (else (use-modules (srfi srfi-39))))
;;;; CORE FUNCTIONS
;;;;
;;; The central routine for executing benchmarks.
;;; The idea is taken from Greg, the GNUstep regression test environment.
-(define run-benchmark #f)
-(let ((benchmark-running #f))
- (define (local-run-benchmark name iterations thunk)
- (if benchmark-running
- (error "Nested calls to run-benchmark are not permitted.")
- (let ((benchmark-name (full-name name))
- (iterations (scale-iterations iterations)))
- (set! benchmark-running #t)
- (let ((before #f) (after #f) (gc-time #f))
- (gc)
- (set! gc-time (gc-run-time))
- (set! before (times))
- (do ((i 0 (+ i 1)))
- ((= i iterations))
- (thunk))
- (set! after (times))
- (set! gc-time (- (gc-run-time) gc-time))
- (report benchmark-name iterations before after gc-time))
- (set! benchmark-running #f))))
- (set! run-benchmark local-run-benchmark))
+(define benchmark-running? (make-parameter #f))
+(define (run-benchmark name iterations thunk)
+ (if (benchmark-running?)
+ (error "Nested calls to run-benchmark are not permitted."))
+ (if (not (and (integer? iterations) (exact? iterations)))
+ (error "Expected exact integral number of iterations"))
+ (parameterize ((benchmark-running? #t))
+ ;; Warm up the benchmark first. This will resolve any toplevel-ref
+ ;; forms.
+ (thunk)
+ (gc)
+ (let* ((before-gc-time (gc-run-time))
+ (before-real-time (get-internal-real-time))
+ (before-run-time (get-internal-run-time)))
+ (do ((i iterations (1- i)))
+ ((zero? i))
+ (thunk))
+ (let ((after-run-time (get-internal-run-time))
+ (after-real-time (get-internal-real-time))
+ (after-gc-time (gc-run-time)))
+ (report (make-benchmark-result (full-name name) iterations
+ (- after-real-time before-real-time)
+ (- after-run-time before-run-time)
+ (- after-gc-time before-gc-time)))))))
;;; A short form for benchmarks.
-(defmacro benchmark (name iterations body . rest)
- `(run-benchmark ,name ,iterations (lambda () ,body ,@rest)))
+(cond-expand
+ (guile-2
+ (define-syntax-rule (benchmark name iterations body body* ...)
+ (run-benchmark name iterations (lambda () body body* ...))))
+ (else
+ (defmacro benchmark (name iterations body . rest)
+ `(run-benchmark ,name ,iterations (lambda () ,body ,@rest)))))
;;;; BENCHMARK NAMES
@@ -333,31 +338,21 @@
;;;; Turn a benchmark name into a nice human-readable string.
(define (format-benchmark-name name)
- (call-with-output-string
- (lambda (port)
- (let loop ((name name)
- (separator ""))
- (if (pair? name)
- (begin
- (display separator port)
- (display (car name) port)
- (loop (cdr name) ": ")))))))
+ (string-join name ": "))
;;;; For a given benchmark-name, deliver the full name including all prefixes.
(define (full-name name)
(append (current-benchmark-prefix) (list name)))
-;;; A fluid containing the current benchmark prefix, as a list.
-(define prefix-fluid (make-fluid '()))
-(define (current-benchmark-prefix)
- (fluid-ref prefix-fluid))
+;;; A parameter containing the current benchmark prefix, as a list.
+(define current-benchmark-prefix
+ (make-parameter '()))
;;; Postpend PREFIX to the current name prefix while evaluting THUNK.
;;; The name prefix is only changed within the dynamic scope of the
;;; call to with-benchmark-prefix*. Return the value returned by THUNK.
(define (with-benchmark-prefix* prefix thunk)
- (with-fluids ((prefix-fluid
- (append (fluid-ref prefix-fluid) (list prefix))))
+ (parameterize ((current-benchmark-prefix (full-name prefix)))
(thunk)))
;;; (with-benchmark-prefix PREFIX BODY ...)
@@ -365,77 +360,58 @@
;;; The name prefix is only changed within the dynamic scope of the
;;; with-benchmark-prefix expression. Return the value returned by the last
;;; BODY expression.
-(defmacro with-benchmark-prefix (prefix . body)
- `(with-benchmark-prefix* ,prefix (lambda () ,@body)))
+(cond-expand
+ (guile-2
+ (define-syntax-rule (with-benchmark-prefix prefix body body* ...)
+ (with-benchmark-prefix* prefix (lambda () body body* ...))))
+ (else
+ (defmacro with-benchmark-prefix (prefix . body)
+ `(with-benchmark-prefix* ,prefix (lambda () ,@body)))))
-;;;; TIME CALCULATION
+;;;; Benchmark results
;;;;
-(define benchmark-time-base
- internal-time-units-per-second)
-
-(define time-base ;; short-cut, not exported
- benchmark-time-base)
-
-(define frame-time/iteration
+(define *calibration-result*
"<will be set during initialization>")
-(define (benchmark-total-time before after)
- (- (tms:clock after) (tms:clock before)))
-
-(define (benchmark-user-time before after)
- (- (tms:utime after) (tms:utime before)))
+(define (benchmark-overhead iterations accessor)
+ (* (/ iterations 1.0 (benchmark-result:iterations *calibration-result*))
+ (accessor *calibration-result*)))
-(define (benchmark-system-time before after)
- (- (tms:stime after) (tms:stime before)))
-
-(define (benchmark-frame-time iterations)
- (* iterations frame-time/iteration))
-
-(define (benchmark-core-time iterations before after)
- (- (benchmark-user-time before after) (benchmark-frame-time iterations)))
-
-(define (benchmark-user-time\interpreter before after gc-time)
- (- (benchmark-user-time before after) gc-time))
-
-(define (benchmark-core-time\interpreter iterations before after gc-time)
- (- (benchmark-core-time iterations before after) gc-time))
+(define (benchmark-result:core-time result)
+ (- (benchmark-result:run-time result)
+ (benchmark-overhead (benchmark-result:iterations result)
+ benchmark-result:run-time)))
;;;; REPORTERS
;;;;
-;;; The global list of reporters.
-(define reporters '())
+;;; The global set of reporters.
+(define report-hook (make-hook 1))
+
+(define (default-reporter result)
+ (if (hook-empty? report-hook)
+ (user-reporter result)
+ (run-hook report-hook result)))
-;;; The default reporter, to be used only if no others exist.
-(define default-reporter #f)
+(define current-reporter
+ (make-parameter default-reporter))
-;;; Add the procedure REPORTER to the current set of reporter functions.
-;;; Signal an error if that reporter procedure object is already registered.
(define (register-reporter reporter)
- (if (memq reporter reporters)
- (error "register-reporter: reporter already registered: " reporter))
- (set! reporters (cons reporter reporters)))
+ (add-hook! report-hook reporter))
-;;; Remove the procedure REPORTER from the current set of reporter
-;;; functions. Signal an error if REPORTER is not currently registered.
(define (unregister-reporter reporter)
- (if (memq reporter reporters)
- (set! reporters (delq! reporter reporters))
- (error "unregister-reporter: reporter not registered: " reporter)))
+ (remove-hook! report-hook reporter))
;;; Return true iff REPORTER is in the current set of reporter functions.
(define (reporter-registered? reporter)
- (if (memq reporter reporters) #t #f))
+ (if (memq reporter (hook->list report-hook)) #t #f))
;;; Send RESULT to all currently registered reporter functions.
-(define (report . args)
- (if (pair? reporters)
- (for-each (lambda (reporter) (apply reporter args))
- reporters)
- (apply default-reporter args)))
+(define (report result)
+ ((current-reporter) result))
;;;; Some useful standard reporters:
@@ -444,26 +420,22 @@
;;;; User reporters write some interesting results to the standard output.
;;; Display a single benchmark result to the given port
-(define (print-result port name iterations before after gc-time)
- (let* ((name (format-benchmark-name name))
- (total-time (benchmark-total-time before after))
- (user-time (benchmark-user-time before after))
- (system-time (benchmark-system-time before after))
- (frame-time (benchmark-frame-time iterations))
- (benchmark-time (benchmark-core-time iterations before after))
- (user-time\interpreter
- (benchmark-user-time\interpreter before after gc-time))
- (benchmark-core-time\interpreter
- (benchmark-core-time\interpreter iterations before after gc-time)))
+(define (print-result port result)
+ (let ((name (format-benchmark-name (benchmark-result:name result)))
+ (iterations (benchmark-result:iterations result))
+ (real-time (benchmark-result:real-time result))
+ (run-time (benchmark-result:run-time result))
+ (gc-time (benchmark-result:gc-time result))
+ (core-time (benchmark-result:core-time result)))
(write (list name iterations
- 'total (i/ total-time time-base)
- 'user (i/ user-time time-base)
- 'system (i/ system-time time-base)
- 'frame (i/ frame-time time-base)
- 'benchmark (i/ benchmark-time time-base)
- 'user/interp (i/ user-time\interpreter time-base)
- 'bench/interp (i/ benchmark-core-time\interpreter time-base)
- 'gc (i/ gc-time time-base))
+ 'total (->seconds real-time)
+ 'user (->seconds run-time)
+ 'system 0
+ 'frame (->seconds (- run-time core-time))
+ 'benchmark (->seconds core-time)
+ 'user/interp (->seconds (- run-time gc-time))
+ 'bench/interp (->seconds (- core-time gc-time))
+ 'gc (->seconds gc-time))
port)
(newline port)))
@@ -472,58 +444,50 @@
(define (make-log-reporter file)
(let ((port (if (output-port? file) file
(open-output-file file))))
- (lambda args
- (apply print-result port args)
+ (lambda (result)
+ (print-result port result)
(force-output port))))
;;; A reporter that reports all results to the user.
-(define (full-reporter . args)
- (apply print-result (current-output-port) args))
+(define (full-reporter result)
+ (print-result (current-output-port) result))
;;; Display interesting results of a single benchmark to the given port
-(define (print-user-result port name iterations before after gc-time)
- (let* ((name (format-benchmark-name name))
- (user-time (benchmark-user-time before after))
- (benchmark-time (benchmark-core-time iterations before after))
- (benchmark-core-time\interpreter
- (benchmark-core-time\interpreter iterations before after gc-time)))
- (write (list name iterations
- 'user (i/ user-time time-base)
- 'benchmark (i/ benchmark-time time-base)
- 'bench/interp (i/ benchmark-core-time\interpreter time-base)
- 'gc (i/ gc-time time-base))
+(define (print-user-result port result)
+ (let ((name (format-benchmark-name (benchmark-result:name result)))
+ (iterations (benchmark-result:iterations result))
+ (real-time (benchmark-result:real-time result))
+ (run-time (benchmark-result:run-time result))
+ (gc-time (benchmark-result:gc-time result))
+ (core-time (benchmark-result:core-time result)))
+ (write (list name iterations
+ 'real (->seconds real-time)
+ 'real/iteration (->seconds (/ real-time iterations))
+ 'run/iteration (->seconds (/ run-time iterations))
+ 'core/iteration (->seconds (/ core-time iterations))
+ 'gc (->seconds gc-time))
port)
(newline port)))
;;; A reporter that reports interesting results to the user.
-(define (user-reporter . args)
- (apply print-user-result (current-output-port) args))
+(define (user-reporter result)
+ (print-user-result (current-output-port) result))
;;;; Initialize the benchmarking system:
;;;;
-;;; First, display version information
-(display ";; running guile version " (current-output-port))
-(display (version) (current-output-port))
-(newline (current-output-port))
-
-;;; Second, make sure the benchmarking routines are compiled.
-(define (null-reporter . args) #t)
-(set! default-reporter null-reporter)
-(benchmark "empty initialization benchmark" 2 #t)
-
-;;; Third, initialize the system constants
-(display ";; calibrating the benchmarking framework..." (current-output-port))
-(newline (current-output-port))
-(define (initialization-reporter name iterations before after gc-time)
- (let* ((frame-time (- (tms:utime after) (tms:utime before) gc-time 3)))
- (set! frame-time/iteration (/ frame-time iterations))
- (display ";; framework time per iteration: " (current-output-port))
- (display (i/ frame-time/iteration time-base) (current-output-port))
- (newline (current-output-port))))
-(set! default-reporter initialization-reporter)
-(benchmark "empty initialization benchmark" 524288 #t)
-
-;;; Finally, set the default reporter
-(set! default-reporter user-reporter)
+(define (calibrate-benchmark-framework)
+ (display ";; running guile version ")
+ (display (version))
+ (newline)
+ (display ";; calibrating the benchmarking framework...")
+ (newline)
+ (parameterize ((current-reporter
+ (lambda (result)
+ (set! *calibration-result* result)
+ (display ";; calibration: ")
+ (print-user-result (current-output-port) result))))
+ (benchmark "empty initialization benchmark" 10000000 #t)))
+
+(calibrate-benchmark-framework)
diff --git a/benchmark-suite/benchmarks/arithmetic.bm
b/benchmark-suite/benchmarks/arithmetic.bm
index c64f6c2..e0a9bf3 100644
--- a/benchmark-suite/benchmarks/arithmetic.bm
+++ b/benchmark-suite/benchmarks/arithmetic.bm
@@ -1,7 +1,7 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;; Integer arithmetic.
;;;
-;;; Copyright 2010 Free Software Foundation, Inc.
+;;; Copyright 2010, 2012 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public License
@@ -48,20 +48,20 @@
(with-benchmark-prefix "fixnum"
- (benchmark "1+" 1e7
+ (benchmark "1+" #e1e7
(repeat (1+ <>) 2 100))
- (benchmark "1-" 1e7
+ (benchmark "1-" #e1e7
(repeat (1- <>) 2 100))
- (benchmark "+" 1e7
+ (benchmark "+" #e1e7
(repeat (+ 2 <>) 7 100))
- (benchmark "-" 1e7
+ (benchmark "-" #e1e7
(repeat (- 2 <>) 7 100))
- (benchmark "*" 1e7
+ (benchmark "*" #e1e7
(repeat (* 1 <>) 1 100))
- (benchmark "/" 1e7
+ (benchmark "/" #e1e7
(repeat (/ 2 <>) 1 100)))
diff --git a/benchmark-suite/benchmarks/r6rs-arithmetic.bm
b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
index 4c9b8e6..309f066 100644
--- a/benchmark-suite/benchmarks/r6rs-arithmetic.bm
+++ b/benchmark-suite/benchmarks/r6rs-arithmetic.bm
@@ -1,7 +1,7 @@
;;; -*- mode: scheme; coding: utf-8; -*-
;;; R6RS-specific arithmetic benchmarks
;;;
-;;; Copyright (C) 2011 Free Software Foundation, Inc.
+;;; Copyright (C) 2011, 2012 Free Software Foundation, Inc.
;;;
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public
@@ -24,12 +24,12 @@
(with-benchmark-prefix "fixnum"
- (benchmark "fixnum? [yes]" 1e7
+ (benchmark "fixnum? [yes]" #e1e7
(fixnum? 10000))
(let ((n (+ most-positive-fixnum 100)))
- (benchmark "fixnum? [no]" 1e7
+ (benchmark "fixnum? [no]" #e1e7
(fixnum? n)))
- (benchmark "fxxor [2]" 1e7
+ (benchmark "fxxor [2]" #e1e7
(fxxor 3 8)))
diff --git a/check-guile.in b/check-guile.in
index 995199d..214deec 100644
--- a/check-guile.in
+++ b/check-guile.in
@@ -43,6 +43,7 @@ fi
exec $guile \
--debug \
+ -L "$TEST_SUITE_DIR" \
--no-auto-compile -e main -s "$TEST_SUITE_DIR/guile-test" \
--test-suite "$TEST_SUITE_DIR/tests" \
--log-file check-guile.log "$@"
diff --git a/meta/uninstalled-env.in b/meta/uninstalled-env.in
index 5fa0db0..567c6e2 100644
--- a/meta/uninstalled-env.in
+++ b/meta/uninstalled-env.in
@@ -1,6 +1,6 @@
#!/bin/sh
-# Copyright (C) 2003, 2006, 2008, 2009, 2010, 2011 Free Software
Foundation
+# Copyright (C) 2003, 2006, 2008, 2009, 2010, 2011, 2012 Free Software
Foundation
#
# This file is part of GUILE.
#
@@ -57,12 +57,12 @@ if test "@cross_compiling@" = "no"
then
if [ x"$GUILE_LOAD_PATH" = x ]
then
-
GUILE_LOAD_PATH="${top_srcdir}/module:${top_srcdir}/guile-readline:${top_srcdir}"
+ GUILE_LOAD_PATH="${top_srcdir}/module:${top_srcdir}/guile-readline"
if test "${top_srcdir}" != "${top_builddir}"; then
-
GUILE_LOAD_PATH="$GUILE_LOAD_PATH:${top_builddir}/module:${top_builddir}/guile-readline:${top_builddir}"
+
GUILE_LOAD_PATH="$GUILE_LOAD_PATH:${top_builddir}/module:${top_builddir}/guile-readline"
fi
else
- for d in "/module" "/guile-readline" ""
+ for d in "/module" "/guile-readline"
do
# This hair prevents double inclusion.
# The ":" prevents prefix aliasing.
@@ -82,9 +82,9 @@ then
if test "x$GUILE_LOAD_COMPILED_PATH" = "x"
then
-
GUILE_LOAD_COMPILED_PATH="${top_builddir}/module:${top_builddir}/guile-readline:${top_builddir}"
+
GUILE_LOAD_COMPILED_PATH="${top_builddir}/module:${top_builddir}/guile-readline"
else
- for d in "/module" "/guile-readline" ""
+ for d in "/module" "/guile-readline"
do
# This hair prevents double inclusion.
# The ":" prevents prefix aliasing.
diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index a2f6def..c87af17 100644
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -1,7 +1,7 @@
## Process this file with automake to produce Makefile.in.
##
## Copyright 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
-## 2010, 2011 Software Foundation, Inc.
+## 2010, 2011, 2012 Software Foundation, Inc.
##
## This file is part of GUILE.
##
@@ -165,7 +165,7 @@ SCM_TESTS = tests/00-initial-env.test \
EXTRA_DIST = \
guile-test \
- lib.scm \
+ test-suite/lib.scm \
$(SCM_TESTS) \
tests/rnrs-test-a.scm
ChangeLog-2008
diff --git a/test-suite/lib.scm b/test-suite/test-suite/lib.scm
similarity index 100%
rename from test-suite/lib.scm
rename to test-suite/test-suite/lib.scm
diff --git a/test-suite/tests/asm-to-bytecode.test
b/test-suite/tests/asm-to-bytecode.test
index d36b33d..4ea3dd3 100644
--- a/test-suite/tests/asm-to-bytecode.test
+++ b/test-suite/tests/asm-to-bytecode.test
@@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-(define-module (test-suite tests asm-to-bytecode)
+(define-module (tests asm-to-bytecode)
#:use-module (rnrs bytevectors)
#:use-module ((rnrs io ports) #:select (open-bytevector-output-port))
#:use-module (test-suite lib)
diff --git a/test-suite/tests/brainfuck.test b/test-suite/tests/brainfuck.test
index f612fb5..cdbceaa 100644
--- a/test-suite/tests/brainfuck.test
+++ b/test-suite/tests/brainfuck.test
@@ -14,7 +14,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-(define-module (test-suite tests brainfuck)
+(define-module (tests brainfuck)
#:use-module (test-suite lib)
#:use-module (system base compile))
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index ee688c0..619b167 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
;;;; compiler.test --- tests for the compiler -*- scheme -*-
-;;;; Copyright (C) 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -15,7 +15,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-(define-module (test-suite tests compiler)
+(define-module (tests compiler)
#:use-module (test-suite lib)
#:use-module (test-suite guile-test)
#:use-module (system base compile)
diff --git a/test-suite/tests/ftw.test b/test-suite/tests/ftw.test
index be983a1..805c779 100644
--- a/test-suite/tests/ftw.test
+++ b/test-suite/tests/ftw.test
@@ -90,6 +90,9 @@
(define %test-dir
(string-append %top-srcdir "/test-suite"))
+(define %test-suite-lib-dir
+ (string-append %top-srcdir "/test-suite/test-suite"))
+
(define (make-file-tree dir tree)
"Make file system TREE at DIR."
(define (touch file)
@@ -152,7 +155,8 @@
(let ((enter? (lambda (n s r)
;; Enter only `test-suite/tests/'.
(if (member `(down ,%test-dir) r)
- (string=? (basename n) "tests")
+ (or (string=? (basename n) "tests")
+ (string=? (basename n) "test-suite"))
(string=? (basename n) "test-suite"))))
(leaf (lambda (n s r) (cons `(leaf ,n) r)))
(down (lambda (n s r) (cons `(down ,n) r)))
@@ -167,7 +171,7 @@
((('down (? (cut string=? <> %test-dir)))
between ...
('up (? (cut string=? <> %test-dir))))
- (and (any (match-lambda (('leaf (= basename "lib.scm")) #t) (_ #f))
+ (and (any (match-lambda (('down (= basename "test-suite")) #t) (_ #f))
between)
(any (match-lambda (('down (= basename "tests")) #t) (_ #f))
between)
@@ -195,7 +199,7 @@
(up (lambda (n s r) (cons `(up ,n) r)))
(skip (lambda (n s r) (cons `(skip ,n) r)))
(error (lambda (n s e r) (cons `(error ,n) r)))
- (name (string-append %test-dir "/lib.scm")))
+ (name (string-append %test-suite-lib-dir "/lib.scm")))
(equal? (file-system-fold enter? leaf down up skip error '() name)
`((leaf ,name)))))
diff --git a/test-suite/tests/gc.test b/test-suite/tests/gc.test
index e13c8f7..a969752 100644
--- a/test-suite/tests/gc.test
+++ b/test-suite/tests/gc.test
@@ -16,7 +16,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-(define-module (test-suite tests gc)
+(define-module (tests gc)
#:use-module (ice-9 documentation)
#:use-module (test-suite lib)
#:use-module ((system base compile) #:select (compile)))
diff --git a/test-suite/tests/match.test b/test-suite/tests/match.test
index 8b19ff7..6bf5bdd 100644
--- a/test-suite/tests/match.test
+++ b/test-suite/tests/match.test
@@ -1,6 +1,6 @@
;;;; match.test --- (ice-9 match) -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -205,4 +205,4 @@
(test-end (syntax-rules ()
((_) #t))))
(with-test-prefix "upstream tests"
- (include-from-path "test-suite/tests/match.test.upstream")))
+ (include-from-path "tests/match.test.upstream")))
diff --git a/test-suite/tests/rnrs-libraries.test
b/test-suite/tests/rnrs-libraries.test
index e162714..e961c28 100644
--- a/test-suite/tests/rnrs-libraries.test
+++ b/test-suite/tests/rnrs-libraries.test
@@ -1,5 +1,5 @@
;;;; rnrs-libraries.test --- test library and import forms -*- scheme -*-
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -15,7 +15,7 @@
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
-(define-module (test-suite tests rnrs-libraries)
+(define-module (tests rnrs-libraries)
#:use-module (test-suite lib))
;; First, check that Guile modules are r6rs modules.
@@ -71,7 +71,7 @@
(pass-if "import"
(eval '(begin
- (import (test-suite tests rnrs-test-a))
+ (import (tests rnrs-test-a))
#t)
(current-module)))
@@ -79,18 +79,18 @@
(not (module-local-variable (current-module) 'double)))
(pass-if "resolve-interface"
- (module? (resolve-interface '(test-suite tests rnrs-test-a))))
+ (module? (resolve-interface '(tests rnrs-test-a))))
- (set! iface (resolve-interface '(test-suite tests rnrs-test-a)))
+ (set! iface (resolve-interface '(tests rnrs-test-a)))
(pass-if "resolve-interface (2)"
- (eq? iface (resolve-interface '(test-suite tests rnrs-test-a))))
+ (eq? iface (resolve-interface '(tests rnrs-test-a))))
(pass-if "resolve-r6rs-interface"
- (eq? iface (resolve-r6rs-interface '(test-suite tests rnrs-test-a))))
+ (eq? iface (resolve-r6rs-interface '(tests rnrs-test-a))))
(pass-if "resolve-r6rs-interface (2)"
- (eq? iface (resolve-r6rs-interface '(library (test-suite tests
rnrs-test-a)))))
+ (eq? iface (resolve-r6rs-interface '(library (tests rnrs-test-a)))))
(pass-if "module uses"
(and (memq iface (module-uses (current-module))) #t))
diff --git a/test-suite/tests/rnrs-test-a.scm b/test-suite/tests/rnrs-test-a.scm
index 7b46fd6..474069b 100644
--- a/test-suite/tests/rnrs-test-a.scm
+++ b/test-suite/tests/rnrs-test-a.scm
@@ -1,6 +1,6 @@
;;; test of defining rnrs libraries
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
@@ -17,7 +17,7 @@
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-(library (test-suite tests rnrs-test-a)
+(library (tests rnrs-test-a)
(export double)
(import (guile))
diff --git a/test-suite/tests/sxml.match.test b/test-suite/tests/sxml.match.test
index b3dbbe7..fcb089f 100644
--- a/test-suite/tests/sxml.match.test
+++ b/test-suite/tests/sxml.match.test
@@ -1,6 +1,6 @@
;;;; sxml.simple.test --- (sxml simple) -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -42,4 +42,4 @@
;; FIXME: The `xyzpq' variable in there is originally named `x' but using that
;; name triggers a psyntax "identifier out of context" error.
-(include-from-path "test-suite/tests/sxml-match-tests.ss")
+(include-from-path "tests/sxml-match-tests.ss")
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.5-107-g7e822b3,
Andy Wingo <=