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

Better error reporting by the optimizer's test harness.

Browse Source
This commit is contained in:
Vincent St-Amour 2010-07-13 17:35:44 -04:00
parent 7fb1b41a28
commit 566aeedb59
1 changed files with 17 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -28,23 +28,25 @@
(or (regexp-match ".*~" name) ; we ignore backup files
;; machine optimized and hand optimized versions must expand to the
;; same code
(and (equal? (parameterize ([current-load-relative-directory
(build-path here "generic")])
(read-and-expand gen))
(let ((hand-opt-dir (build-path here "hand-optimized")))
(parameterize ([current-load-relative-directory hand-opt-dir])
(read-and-expand (build-path hand-opt-dir name)))))
(and (or (equal? (parameterize ([current-load-relative-directory
(build-path here "generic")])
(read-and-expand gen))
(let ((hand-opt-dir (build-path here "hand-optimized")))
(parameterize ([current-load-relative-directory hand-opt-dir])
(read-and-expand (build-path hand-opt-dir name)))))
(begin (printf "~a failed: expanded code mismatch\n\n" name)
#f))
;; optimized and non-optimized versions must evaluate to the
;; same thing
(equal? (with-output-to-string
(lambda ()
(dynamic-require gen #f)))
(with-output-to-string
(lambda ()
(let ((non-opt-dir (build-path here "non-optimized")))
(dynamic-require (build-path non-opt-dir name) #f))))))
(begin (printf "~a failed\n\n" name)
#f))))
(or (equal? (with-output-to-string
(lambda ()
(dynamic-require gen #f)))
(with-output-to-string
(lambda ()
(let ((non-opt-dir (build-path here "non-optimized")))
(dynamic-require (build-path non-opt-dir name) #f)))))
(begin (printf "~a failed: result mismatch\n\n" name)
#f))))))
(define-runtime-path here ".")