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

Remove redundant checks from TR's optimizer tests.

Browse Source 
Checking that the optimized and non-optimized versions return the same
results is unnecessary. Optimization logs, which are checked against
an expected log, already contain the results.
This commit is contained in:
Vincent St-Amour 2011-05-03 10:58:19 -04:00
parent 7b6edb452f
commit 4ea9b29d12
1 changed files with 6 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,42 +1,11 @@
#lang racket #lang racket
(require racket/runtime-path racket/sandbox (require racket/runtime-path
rackunit rackunit/text-ui) rackunit rackunit/text-ui)
(provide optimization-tests)
(define show-names? (make-parameter #f)) (define show-names? (make-parameter #f))
(define prog-rx
(pregexp (string-append "^\\s*"
"(#lang typed/(?:scheme|racket)(?:/base)?)"
"\\s+"
"#:optimize"
"\\s+")))
(define (evaluator file #:optimize [optimize? #f])
(call-with-trusted-sandbox-configuration
(lambda ()
(parameterize ([current-load-relative-directory tests-dir]
[sandbox-memory-limit #f] ; TR needs memory
[sandbox-output 'string]
[sandbox-namespace-specs
(list (car (sandbox-namespace-specs))
'typed/racket
'typed/scheme)])
;; drop the expected log
(let* ([prog (with-input-from-file file
(lambda ()
(read-line) ; drop #;
(read) ; drop expected log
(port->string)))] ; get the actual program
[m (or (regexp-match-positions prog-rx prog)
(error 'evaluator "bad program contents in ~e" file))]
[prog (string-append (substring prog (caadr m) (cdadr m))
(if (not optimize?) "\n#:no-optimize\n" "\n")
(substring prog (cdar m)))]
[evaluator (make-module-evaluator prog)]
[out (get-output evaluator)])
(kill-evaluator evaluator)
out)))))
(define (generate-log name dir flags) (define (generate-log name dir flags)
;; some tests require other tests, so some fiddling is required ;; some tests require other tests, so some fiddling is required
(parameterize ([current-load-relative-directory dir] (parameterize ([current-load-relative-directory dir]
@ -52,6 +21,8 @@
(with-input-from-string (string-append "(" log-string ")") (with-input-from-string (string-append "(" log-string ")")
read)))) read))))
;; we log optimizations and compare to an expected log to make sure that all
;; the optimizations we expected did indeed happen
(define (compare-logs name dir flags) (define (compare-logs name dir flags)
(test-suite "Log Comparison" (test-suite "Log Comparison"
(check-equal? (check-equal?
@ -72,15 +43,7 @@
;; these two return lists of tests to be run for that category of tests ;; these two return lists of tests to be run for that category of tests
(define (test-opt name) (define (test-opt name)
(let ([path (build-path tests-dir name)]) (list (compare-logs name tests-dir '#("--log-optimizations"))))
;; we log optimizations and compare to an expected log to make sure that
;; all the optimizations we expected did indeed happen
(list (compare-logs name tests-dir '#("--log-optimizations"))
(test-suite
;; optimized and non-optimized versions must give the same result
"Result Comparison"
(check-equal? (evaluator path #:optimize #t)
(evaluator path))))))
;; proc returns the list of tests to be run on each file ;; proc returns the list of tests to be run on each file
(define (mk-suite suite-name dir proc) (define (mk-suite suite-name dir proc)