From d8e5d6b07dd8e69a2bc715357ac029937664580e Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 13 Sep 2006 23:20:44 +0000 Subject: [PATCH] lift out common benchmark support svn: r4326 --- .../tests/mzscheme/benchmarks/common/auto.ss | 98 ++--------------- collects/tests/mzscheme/benchmarks/rx/auto.ss | 85 ++------------ .../mzscheme/benchmarks/utils/auto-drive.ss | 104 ++++++++++++++++++ 3 files changed, 118 insertions(+), 169 deletions(-) mode change 100644 => 100755 collects/tests/mzscheme/benchmarks/rx/auto.ss create mode 100644 collects/tests/mzscheme/benchmarks/utils/auto-drive.ss diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index 40e2af1afa..a56e3e4d1d 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/collects/tests/mzscheme/benchmarks/common/auto.ss @@ -5,7 +5,7 @@ exec mzscheme -qu "$0" ${1+"$@"} (module auto mzscheme (require (lib "process.ss") - (lib "cmdline.ss") + "../utils/auto-drive.ss" (lib "list.ss") (lib "compile.ss") (lib "inflate.ss") @@ -226,8 +226,6 @@ exec mzscheme -qu "$0" ${1+"$@"} takr triangle)) - (define num-iterations 3) - (define (run-benchmark impl bm) (let ([i (ormap (lambda (i) (and (eq? impl (impl-name i)) @@ -254,96 +252,14 @@ exec mzscheme -qu "$0" ${1+"$@"} ((impl-clean-up i) bm))) (flush-output))) - (define (rprintf . args) - (apply printf args) - (when (current-output-file) - (with-output-to-file (current-output-file) - (lambda () - (apply printf args)) - 'append))) - - (define no-implementations (map (lambda (s) - (cons (string->symbol (format "no-~a" s)) - s)) - (map impl-name impls))) - (define no-benchmarks (map (lambda (s) - (cons (string->symbol (format "no-~a" s)) - s)) - benchmarks)) - - (define run-benchmarks #f) - (define run-implementations #f) - - (define default-benchmarks benchmarks) - (define default-implementations (remq* obsolte-impls - (map impl-name impls))) - - (define current-output-file (make-parameter #f)) - ;; Extract command-line arguments -------------------- - (define args - (command-line - "auto" - (current-command-line-arguments) - (once-each - [("--show") "show implementations and benchmarks" - (printf "Implementations:\n") - (for-each (lambda (impl) - (printf " ~a\n" impl)) - default-implementations) - (for-each (lambda (impl) - (printf " ~a [skipped by default]\n" impl)) - obsolte-impls) - (printf "Benchmarks:\n") - (for-each (lambda (bm) - (printf " ~a\n" bm)) - benchmarks)] - [("-o" "--out") filename "append output to " - (current-output-file filename)] - [("-n" "--iters") n "set number of run iterations" - (let ([v (string->number n)]) - (unless (and (number? v) - (exact? v) - (positive? v)) - (error 'auto "bad interation count: ~a" n)) - (set! num-iterations v))]) - (args impl-or-benchmark impl-or-benchmark))) - - ;; Process arguments ------------------------------ - - (for-each (lambda (arg) - (let ([s (string->symbol arg)]) - (cond - [(memq s (map impl-name impls)) - (set! run-implementations - (append (or run-implementations null) - (list s)))] - [(assq s no-implementations) - => (lambda (a) - (set! run-implementations - (remq (cdr a) - (or run-implementations default-implementations))))] - [(memq s benchmarks) - (set! run-benchmarks - (append (or run-benchmarks null) - (list s)))] - [(assq s no-benchmarks) - => (lambda (a) - (set! run-benchmarks - (remq (cdr a) - (or run-benchmarks default-benchmarks))))] - [else - (error 'auto "mysterious argument: ~a" arg)]))) - args) - - (define actual-benchmarks-to-run - (or run-benchmarks - benchmarks)) - - (define actual-implementations-to-run - (or run-implementations - default-implementations)) + (define-values (actual-benchmarks-to-run + actual-implementations-to-run + num-iterations) + (process-command-line benchmarks + (map impl-name impls) obsolte-impls + 3)) ;; Benchmark-specific setup -------------------- diff --git a/collects/tests/mzscheme/benchmarks/rx/auto.ss b/collects/tests/mzscheme/benchmarks/rx/auto.ss old mode 100644 new mode 100755 index dd5ac25f0e..12a64dfa88 --- a/collects/tests/mzscheme/benchmarks/rx/auto.ss +++ b/collects/tests/mzscheme/benchmarks/rx/auto.ss @@ -8,7 +8,7 @@ exec mzscheme -qu "$0" ${1+"$@"} (lib "port.ss") (lib "list.ss") (lib "date.ss") - (lib "cmdline.ss")) + "../utils/auto-drive.ss") (define (test-mzscheme input rx iterations) (let ([rx (byte-pregexp rx)]) @@ -151,88 +151,17 @@ exec mzscheme -qu "$0" ${1+"$@"} (list 'perl test-perl) (list 'pcre test-pcre))) - (define impls (map car testers)) - - (define no-benchmarks (map (lambda (s) - (cons (string->symbol (format "no-~a" s)) - s)) - benchmark-names)) - (define no-implementations (map (lambda (s) - (cons (string->symbol (format "no-~a" s)) - s)) - impls)) - - (define run-benchmarks #f) - (define run-implementations #f) - - (define default-benchmarks benchmark-names) - - (define default-implementations impls) - (define current-output-file (make-parameter #f)) - ;; Extract command-line arguments -------------------- - (define args - (command-line - "auto" - (current-command-line-arguments) - (once-each - [("--show") "show implementations and benchmarks" - (printf "Implementations:\n") - (for-each (lambda (impl) - (printf " ~a\n" impl)) - default-implementations) - (printf "Benchmarks: 1 - ~a\n" - (length inputs))] - [("-o" "--out") filename "append output to " - (current-output-file filename)]) - (args impl-or-benchmark impl-or-benchmark))) - - ;; Process arguments ------------------------------ - - (for-each (lambda (arg) - (let ([s (string->symbol arg)]) - (cond - [(memq s impls) - (set! run-implementations - (append (or run-implementations null) - (list s)))] - [(assq s no-implementations) - => (lambda (a) - (set! run-implementations - (remq (cdr a) - (or run-implementations default-implementations))))] - [(memq s benchmark-names) - (set! run-benchmarks - (append (or run-benchmarks null) - (list s)))] - [(assq s no-benchmarks) - => (lambda (a) - (set! run-benchmarks - (remq (cdr a) - (or run-benchmarks default-benchmarks))))] - [else - (error 'auto "mysterious argument: ~a" arg)]))) - args) - - (define actual-benchmarks-to-run - (or run-benchmarks - default-benchmarks)) - - (define actual-implementations-to-run - (or run-implementations - default-implementations)) + (define-values (actual-benchmarks-to-run + actual-implementations-to-run + num-iterations) + (process-command-line benchmark-names + (map car testers) null + 1)) ;; Run benchmarks ------------------------------- - (define (rprintf . args) - (apply printf args) - (when (current-output-file) - (with-output-to-file (current-output-file) - (lambda () - (apply printf args)) - 'append))) - (define (run who which) (let ([t (assoc (symbol->string which) inputs)]) (let-values ([(index input rx iterations skips) (apply values t)]) diff --git a/collects/tests/mzscheme/benchmarks/utils/auto-drive.ss b/collects/tests/mzscheme/benchmarks/utils/auto-drive.ss new file mode 100644 index 0000000000..3df7242765 --- /dev/null +++ b/collects/tests/mzscheme/benchmarks/utils/auto-drive.ss @@ -0,0 +1,104 @@ + +(module auto-drive mzscheme + (require (lib "process.ss") + (lib "cmdline.ss") + (lib "list.ss") + (lib "compile.ss") + (lib "inflate.ss") + (lib "date.ss") + (lib "file.ss" "dynext")) + + (provide process-command-line + rprintf) + + (define current-output-file (make-parameter #f)) + + (define (process-command-line benchmarks + implementations non-default-implementations + num-iterations) + + (define no-implementations (map (lambda (s) + (cons (string->symbol (format "no-~a" s)) + s)) + implementations)) + (define no-benchmarks (map (lambda (s) + (cons (string->symbol (format "no-~a" s)) + s)) + benchmarks)) + + (define run-benchmarks #f) + (define run-implementations #f) + + (define default-benchmarks benchmarks) + (define default-implementations (remq* non-default-implementations implementations)) + + ;; Extract command-line arguments -------------------- + + (define args + (command-line + "auto" + (current-command-line-arguments) + (once-each + [("--show") "show implementations and benchmarks" + (printf "Implementations:\n") + (for-each (lambda (impl) + (printf " ~a\n" impl)) + default-implementations) + (for-each (lambda (impl) + (printf " ~a [skipped by default]\n" impl)) + non-default-implementations) + (printf "Benchmarks:\n") + (for-each (lambda (bm) + (printf " ~a\n" bm)) + benchmarks)] + [("-o" "--out") filename "append output to " + (current-output-file filename)] + [("-n" "--iters") n "set number of run iterations" + (let ([v (string->number n)]) + (unless (and (number? v) + (exact? v) + (positive? v)) + (error 'auto "bad interation count: ~a" n)) + (set! num-iterations v))]) + (args impl-or-benchmark impl-or-benchmark))) + + ;; Process arguments ------------------------------ + + (for-each (lambda (arg) + (let ([s (string->symbol arg)]) + (cond + [(memq s implementations) + (set! run-implementations + (append (or run-implementations null) + (list s)))] + [(assq s no-implementations) + => (lambda (a) + (set! run-implementations + (remq (cdr a) + (or run-implementations default-implementations))))] + [(memq s benchmarks) + (set! run-benchmarks + (append (or run-benchmarks null) + (list s)))] + [(assq s no-benchmarks) + => (lambda (a) + (set! run-benchmarks + (remq (cdr a) + (or run-benchmarks default-benchmarks))))] + [else + (error 'auto "mysterious argument: ~a" arg)]))) + args) + + (values (or run-benchmarks + benchmarks) + (or run-implementations + default-implementations) + num-iterations)) + + (define (rprintf . args) + (apply printf args) + (when (current-output-file) + (with-output-to-file (current-output-file) + (lambda () + (apply printf args)) + 'append))))