From 8845e870cbdcdc6995a56d7a48b0787993bf1881 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Wed, 11 Nov 2009 14:01:18 +0000 Subject: [PATCH] test repairs for DrDr svn: r16694 --- .../tests/mzscheme/benchmarks/common/auto.ss | 23 +++-- .../mzscheme/benchmarks/mz/comprehensions.ss | 44 ---------- .../mzscheme/benchmarks/shootout/moments.ss | 87 ++++++++++--------- .../tests/mzscheme/benchmarks/shootout/run.ss | 5 +- 4 files changed, 61 insertions(+), 98 deletions(-) delete mode 100644 collects/tests/mzscheme/benchmarks/mz/comprehensions.ss diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss index 5d792874b2..315239f9b2 100755 --- a/collects/tests/mzscheme/benchmarks/common/auto.ss +++ b/collects/tests/mzscheme/benchmarks/common/auto.ss @@ -12,7 +12,8 @@ exec mzscheme -qu "$0" ${1+"$@"} mzlib/inflate mzlib/date dynext/file - syntax/toplevel) + syntax/toplevel + scheme/runtime-path) ;; Implementaton-specific control functions ------------------------------ @@ -343,19 +344,23 @@ exec mzscheme -qu "$0" ${1+"$@"} (process-command-line benchmarks (map impl-name impls) obsolte-impls 3)) + + (define-runtime-path bm-directory ".") ;; Benchmark-specific setup -------------------- - (when (memq 'dynamic actual-benchmarks-to-run ) - (unless (file-exists? "dynamic-input.txt") - (gunzip "dynamic-input.txt.gz"))) + (parameterize ([current-directory bm-directory]) + (when (memq 'dynamic actual-benchmarks-to-run) + (unless (file-exists? "dynamic-input.txt") + (gunzip "dynamic-input.txt.gz")))) ;; Run benchmarks ------------------------------- (rprintf "; ~a\n" (date->string (seconds->date (current-seconds)) #t)) - (for-each (lambda (impl) - (map (lambda (bm) - (run-benchmark impl bm)) - actual-benchmarks-to-run)) - actual-implementations-to-run)) + (parameterize ([current-directory bm-directory]) + (for-each (lambda (impl) + (map (lambda (bm) + (run-benchmark impl bm)) + actual-benchmarks-to-run)) + actual-implementations-to-run))) diff --git a/collects/tests/mzscheme/benchmarks/mz/comprehensions.ss b/collects/tests/mzscheme/benchmarks/mz/comprehensions.ss deleted file mode 100644 index 8c31d85f3b..0000000000 --- a/collects/tests/mzscheme/benchmarks/mz/comprehensions.ss +++ /dev/null @@ -1,44 +0,0 @@ -#lang scheme/base - -(require (planet schematics/schemeunit:3) - (planet schematics/benchmark:2)) - -;; Test that comprehensions are as fast as hand-written -;; loops - - -;; -;; Vector comprehensions -;; - -(define big-vector (make-vector 65536 1)) - -(test-case - "simplest vector comprehension" - (check-as-fast - "comprehension" - (lambda () - (for/fold ([sum 0]) ([x (in-vector big-vector)]) - (+ sum x))) - "hand-written loop" - (lambda () - (let ([end (vector-length big-vector)]) - (let loop ([i 0] [sum 0]) - (if (= i end) - sum - (loop (add1 i) (+ (vector-ref big-vector i) sum)))))))) - -(test-case - "vector comprehension with step" - (check-as-fast - "comprehension" - (lambda () - (for/fold ([sum 0]) ([x (in-vector big-vector 0 (vector-length big-vector) 2)]) - (+ sum x))) - "hand-written loop" - (lambda () - (let ([end (vector-length big-vector)]) - (let loop ([i 0] [sum 0]) - (if (= i end) - sum - (loop (+ i 2) (+ (vector-ref big-vector i) sum)))))))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/moments.ss b/collects/tests/mzscheme/benchmarks/shootout/moments.ss index 6f886935f5..640ee6199b 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/moments.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/moments.ss @@ -13,53 +13,54 @@ (let ((num (string->number line))) (set! sum (+ num sum)) (loop (read-line) (cons num numlist)))))))) - (let ((n (length numlist))) - (let ((mean (/ sum n)) - (average_deviation 0.0) - (standard_deviation 0.0) - (variance 0.0) - (skew 0.0) - (kurtosis 0.0) - (median 0.0) - (deviation 0.0)) - (let loop ((nums numlist)) - (if (not (null? nums)) - (begin - (set! deviation (- (car nums) mean)) - (set! average_deviation (+ average_deviation (abs deviation))) - (set! variance (+ variance (expt deviation 2.0))) - (set! skew (+ skew (expt deviation 3.0))) - (set! kurtosis (+ kurtosis (expt deviation 4))) - (loop (cdr nums))))) + (unless (null? numlist) + (let ((n (length numlist))) + (let ((mean (/ sum n)) + (average_deviation 0.0) + (standard_deviation 0.0) + (variance 0.0) + (skew 0.0) + (kurtosis 0.0) + (median 0.0) + (deviation 0.0)) + (let loop ((nums numlist)) + (if (not (null? nums)) + (begin + (set! deviation (- (car nums) mean)) + (set! average_deviation (+ average_deviation (abs deviation))) + (set! variance (+ variance (expt deviation 2.0))) + (set! skew (+ skew (expt deviation 3.0))) + (set! kurtosis (+ kurtosis (expt deviation 4))) + (loop (cdr nums))))) - (set! average_deviation (/ average_deviation (exact->inexact n))) - (set! variance (/ variance (- n 1))) - (set! standard_deviation (sqrt variance)) + (set! average_deviation (/ average_deviation (exact->inexact n))) + (set! variance (/ variance (- n 1))) + (set! standard_deviation (sqrt variance)) - (cond ((> variance 0.0) - (set! skew (/ skew (* n variance standard_deviation))) - (set! kurtosis (- (/ kurtosis (* n variance variance)) - 3.0)))) + (cond ((> variance 0.0) + (set! skew (/ skew (* n variance standard_deviation))) + (set! kurtosis (- (/ kurtosis (* n variance variance)) + 3.0)))) - (set! numlist (sort numlist (lambda (x y) (< x y)))) + (set! numlist (sort numlist (lambda (x y) (< x y)))) - (let ((mid (quotient n 2))) - (if (zero? (modulo n 2)) - (set! median (/ (+ (car (list-tail numlist mid)) - (car (list-tail numlist (- mid 1)))) - 2.0)) - (set! median (car (list-tail numlist mid))))) + (let ((mid (quotient n 2))) + (if (zero? (modulo n 2)) + (set! median (/ (+ (car (list-tail numlist mid)) + (car (list-tail numlist (- mid 1)))) + 2.0)) + (set! median (car (list-tail numlist mid))))) - (set! standard_deviation (/ (round (* standard_deviation 1000000)) - 1000000)) + (set! standard_deviation (/ (round (* standard_deviation 1000000)) + 1000000)) - (for-each display - `("n: " ,n "\n" - "median: " ,(to-str median) "\n" - "mean: " ,(to-str mean) "\n" - "average_deviation: " ,(to-str average_deviation ) "\n" - "standard_deviation: " ,(to-str standard_deviation) "\n" - "variance: " ,(to-str variance)"\n" - "skew: " ,(to-str skew) "\n" - "kurtosis: " ,(to-str kurtosis)"\n" )))))) + (for-each display + `("n: " ,n "\n" + "median: " ,(to-str median) "\n" + "mean: " ,(to-str mean) "\n" + "average_deviation: " ,(to-str average_deviation ) "\n" + "standard_deviation: " ,(to-str standard_deviation) "\n" + "variance: " ,(to-str variance)"\n" + "skew: " ,(to-str skew) "\n" + "kurtosis: " ,(to-str kurtosis)"\n" ))))))) diff --git a/collects/tests/mzscheme/benchmarks/shootout/run.ss b/collects/tests/mzscheme/benchmarks/shootout/run.ss index 39a822ab54..29365c64c7 100644 --- a/collects/tests/mzscheme/benchmarks/shootout/run.ss +++ b/collects/tests/mzscheme/benchmarks/shootout/run.ss @@ -85,8 +85,9 @@ (define iters (let ([len (vector-length (current-command-line-arguments))]) (unless (<= 1 len 2) - (error 'run "provide ~athe name of a benchmark on the command line and an optional iteration count" - (if (zero? len) "" "ONLY "))) + (printf "provide ~athe name of a benchmark on the command line and an optional iteration count\n" + (if (zero? len) "" "ONLY ")) + (exit)) (if (= len 2) (string->number (vector-ref (current-command-line-arguments) 1)) 1)))