suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fixed Typed Scheme's optimizer's test harness to work with drdr.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-06-25 13:24:29 -04:00
parent f58b58383f
commit 28acece484
2 changed files with 5 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
collects/meta/props
View File

@ -1861,6 +1861,7 @@ path/s is either such a string or a list of them.
"collects/tests/typed-scheme/fail" drdr:command-line #f "collects/tests/typed-scheme/fail" drdr:command-line #f
"collects/tests/typed-scheme/fail/with-type3.rkt" responsible (sstrickl) "collects/tests/typed-scheme/fail/with-type3.rkt" responsible (sstrickl)
"collects/tests/typed-scheme/nightly-run.rkt" drdr:command-line #f "collects/tests/typed-scheme/nightly-run.rkt" drdr:command-line #f
"collects/tests/typed-scheme/optimizer" responsible (stamourv)
"collects/tests/typed-scheme/run.rkt" drdr:command-line (racket "-t" * "--" "--nightly") drdr:timeout 1200 "collects/tests/typed-scheme/run.rkt" drdr:command-line (racket "-t" * "--" "--nightly") drdr:timeout 1200
"collects/tests/typed-scheme/xfail" drdr:command-line #f "collects/tests/typed-scheme/xfail" drdr:command-line #f
"collects/tests/units" responsible (sstrickl) "collects/tests/units" responsible (sstrickl)

5
collects/tests/typed-scheme/optimizer/run.rkt
View File

@ -1,4 +1,5 @@
#lang racket #lang racket
(require racket/runtime-path)
;; since Typed Scheme's optimizer does source to source transformations, ;; since Typed Scheme's optimizer does source to source transformations,
;; we compare the expansion of automatically optimized and hand optimized ;; we compare the expansion of automatically optimized and hand optimized
@ -20,13 +21,15 @@
(begin (printf "~a failed\n\n" name) (begin (printf "~a failed\n\n" name)
#f)))) #f))))
(define-runtime-path here ".")
(let ((n-failures (let ((n-failures
(if (> (vector-length (current-command-line-arguments)) 0) (if (> (vector-length (current-command-line-arguments)) 0)
(if (test (format "generic/~a.rkt" (if (test (format "generic/~a.rkt"
(vector-ref (current-command-line-arguments) 0))) (vector-ref (current-command-line-arguments) 0)))
0 1) 0 1)
(for/fold ((n-failures 0)) (for/fold ((n-failures 0))
((gen (in-directory "generic"))) ((gen (in-directory (build-path here "generic"))))
(+ n-failures (if (test gen) 0 1)))))) (+ n-failures (if (test gen) 0 1))))))
(unless (= n-failures 0) (unless (= n-failures 0)
(error (format "~a tests failed." n-failures)))) (error (format "~a tests failed." n-failures))))