From c953007f633340d0f32ab6024bb297d64adc0cab Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 6 Oct 2008 19:41:30 +0000
Subject: [PATCH] Fix automated TS tests.

svn: r11953
---
 collects/tests/run-automated-tests.ss |  2 +-
 collects/tests/typed-scheme/main.ss   | 13 ++++++-------
 collects/tests/typed-scheme/run.ss    |  6 ++++++
 3 files changed, 13 insertions(+), 8 deletions(-)
 create mode 100644 collects/tests/typed-scheme/run.ss

diff --git a/collects/tests/run-automated-tests.ss b/collects/tests/run-automated-tests.ss
index a1ee31b382..fd485d9758 100755
--- a/collects/tests/run-automated-tests.ss
+++ b/collects/tests/run-automated-tests.ss
@@ -32,7 +32,7 @@
 ;;   ignored, and should only be used by the mzscheme tests.)
 (define tests
   '([no-handler load "mzscheme/quiet.ss" (lib "scheme/init")]
-    [require "typed-scheme/main.ss"]
+    [require "typed-scheme/run.ss"]
     [require "match/plt-match-tests.ss"]
     ;; [require "stepper/automatic-tests.ss" (lib "scheme/base")]
     [require "lazy/main.ss"]
diff --git a/collects/tests/typed-scheme/main.ss b/collects/tests/typed-scheme/main.ss
index b4fe5d20c1..78f7550d40 100644
--- a/collects/tests/typed-scheme/main.ss
+++ b/collects/tests/typed-scheme/main.ss
@@ -4,7 +4,7 @@
 
 (require (planet schematics/schemeunit:2/test)
          (planet schematics/schemeunit:2/text-ui)
-         mzlib/etc
+         mzlib/etc scheme/port
          compiler/compiler
          scheme/match
          "unit-tests/all-tests.ss"
@@ -31,7 +31,7 @@
 (define (exn-pred p)
   (let ([sexp (with-handlers
                   ([exn:fail? (lambda _ #f)])
-                (call-with-input-file
+                (call-with-input-file*
                  p
                  (lambda (prt) 
                    (read-line prt 'any) (read prt))))])
@@ -54,7 +54,8 @@
           (lambda ()
             (parameterize ([read-accept-reader #t]
                            [current-load-relative-directory path]
-                           [current-directory path])
+                           [current-directory path]
+                           [current-output-port (open-output-nowhere)])
               (loader p)))))))
     (apply test-suite dir
            tests)))
@@ -87,9 +88,7 @@
 (define (go) (test/gui tests))
 (define (go/text) (test/text-ui tests))
 
-(when (getenv "PLT_TESTS")
-  (unless (parameterize ([current-output-port (open-output-string)])
-            (= 0 (go/text)))
-    (error "Typed Scheme Tests did not pass.")))
+(provide go go/text)
+
 
 
diff --git a/collects/tests/typed-scheme/run.ss b/collects/tests/typed-scheme/run.ss
new file mode 100644
index 0000000000..d892dd3466
--- /dev/null
+++ b/collects/tests/typed-scheme/run.ss
@@ -0,0 +1,6 @@
+#lang scheme/base
+
+(require "main.ss")
+(current-namespace (make-base-namespace))
+(unless (= 0 (go/text))
+  (error "Typed Scheme Tests did not pass."))