From 56279151a743df6607e401ee390b9ada45691430 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 15 Jun 2011 17:56:38 -0400
Subject: [PATCH] Add script to update test files to new log formats.

original commit: fc25b43293a88967825c9e9b70f9aca89070e0dc
---
 collects/tests/typed-scheme/optimizer/run.rkt | 51 ++++++++++---------
 .../typed-scheme/optimizer/transform.rkt      | 34 +++++++++++++
 2 files changed, 60 insertions(+), 25 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/transform.rkt

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index fdea4c71..cda41cb0 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -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)))))
diff --git a/collects/tests/typed-scheme/optimizer/transform.rkt b/collects/tests/typed-scheme/optimizer/transform.rkt
new file mode 100644
index 00000000..a1aa2bd9
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/transform.rkt
@@ -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)