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

Add script to update test files to new log formats.

Browse Source 
original commit: fc25b43293a88967825c9e9b70f9aca89070e0dc
This commit is contained in:
Vincent St-Amour 2011-06-15 17:56:38 -04:00
parent 4180449ead
commit 56279151a7
2 changed files with 60 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5,30 +5,26 @@
unstable/logging)
(provide optimization-tests missed-optimization-tests
test-opt test-missed-optimization)
test-opt test-missed-optimization test-file?
generate-log tests-dir missed-optimizations-dir)
(define (generate-log name dir)
;; some tests require other tests, so some fiddling is required
(let ([out-string
(with-output-to-string
(lambda ()
(with-intercepted-logging ; catch opt logs
(lambda (l)
(when (eq? (vector-ref l 2) ; look only for optimizer messages
optimization-log-key)
(displayln (vector-ref l 1)))) ; print log message
(lambda ()
(parameterize
([current-namespace (make-base-empty-namespace)]
[current-load-relative-directory dir])
(dynamic-require
(build-path (current-load-relative-directory) name)
#f)))
#:level 'warning)))])
;; have the log as an sexp, since that's what the expected log is
(with-input-from-string
(string-append "(" out-string ")")
read)))
(with-output-to-string
(lambda ()
(with-intercepted-logging ; catch opt logs
(lambda (l)
(when (eq? (vector-ref l 2) ; look only for optimizer messages
optimization-log-key)
(displayln (vector-ref l 1)))) ; print log message
(lambda ()
(parameterize
([current-namespace (make-base-empty-namespace)]
[current-load-relative-directory dir])
(dynamic-require
(build-path (current-load-relative-directory) name)
#f)))
#:level 'warning))))
;; we log optimizations and compare to an expected log to make sure that all
;; the optimizations we expected did indeed happen
@ -40,7 +36,9 @@
#t
(equal?
;; actual log
(generate-log name dir)
(with-input-from-string
(string-append "(" (generate-log name dir) ")")
read)
;; expected log
(with-input-from-file (build-path dir name)
(lambda () ; from the test file
@ -57,14 +55,17 @@
(define (test-missed-optimization name)
(list (compare-logs name missed-optimizations-dir)))
(define (test-file? name)
(and (regexp-match ".*rkt$" name)
;; skip emacs temp unsaved file backups
(not (regexp-match "^\\.#" name))))
;; proc returns the list of tests to be run on each file
(define (mk-suite suite-name dir proc)
(make-test-suite
suite-name
(for/list ([name (directory-list dir)]
#:when (and (regexp-match ".*rkt$" name)
;; skip emacs temp unsaved file backups
(not (regexp-match "^\\.#" name))))
#:when (test-file? name))
(make-test-suite
(path->string name)
(proc name)))))

34
collects/tests/typed-scheme/optimizer/transform.rkt Normal file
View File

@ -0,0 +1,34 @@
#lang racket
(require "run.rkt")
;; Assuming that only the log format changed, update test files to the
;; new format.
;; Running this after changes to the behavior of the optimizer is a
;; BAD idea, since in the case of regressions, the new broken behavior
;; would become the expected behavior.
;; Use this script with caution.
(define (transform file dir)
;; generate the new log, that will become the expected log
(define new-log (generate-log file dir))
(define in (open-input-file (build-path dir file)))
(read-line in) ; drop the #;
(read in) ; drop the old expected log
(let ([rest (port->string in)])
(with-output-to-file (build-path dir file) #:exists 'truncate
(lambda ()
(displayln "#;")
(displayln "(")
(display new-log)
(display ")")
(display rest)))))
;; proc returns the list of tests to be run on each file
(define (transform-dir dir)
(for/list ([name (directory-list dir)]
#:when (test-file? name))
(transform name dir)))
(transform-dir tests-dir)
(transform-dir missed-optimizations-dir)