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

Fix automated TS tests.

Browse Source 
svn: r11953
This commit is contained in:
Sam Tobin-Hochstadt 2008-10-06 19:41:30 +00:00
parent 499fc08d0d
commit c953007f63
3 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/tests/run-automated-tests.ss
View File

@ -32,7 +32,7 @@
;; ignored, and should only be used by the mzscheme tests.) ;; ignored, and should only be used by the mzscheme tests.)
(define tests (define tests
'([no-handler load "mzscheme/quiet.ss" (lib "scheme/init")] '([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 "match/plt-match-tests.ss"]
;; [require "stepper/automatic-tests.ss" (lib "scheme/base")] ;; [require "stepper/automatic-tests.ss" (lib "scheme/base")]
[require "lazy/main.ss"] [require "lazy/main.ss"]

13
collects/tests/typed-scheme/main.ss
View File

@ -4,7 +4,7 @@
(require (planet schematics/schemeunit:2/test) (require (planet schematics/schemeunit:2/test)
(planet schematics/schemeunit:2/text-ui) (planet schematics/schemeunit:2/text-ui)
mzlib/etc mzlib/etc scheme/port
compiler/compiler compiler/compiler
scheme/match scheme/match
"unit-tests/all-tests.ss" "unit-tests/all-tests.ss"
@ -31,7 +31,7 @@
(define (exn-pred p) (define (exn-pred p)
(let ([sexp (with-handlers (let ([sexp (with-handlers
([exn:fail? (lambda _ #f)]) ([exn:fail? (lambda _ #f)])
(call-with-input-file (call-with-input-file*
p p
(lambda (prt) (lambda (prt)
(read-line prt 'any) (read prt))))]) (read-line prt 'any) (read prt))))])
@ -54,7 +54,8 @@
(lambda () (lambda ()
(parameterize ([read-accept-reader #t] (parameterize ([read-accept-reader #t]
[current-load-relative-directory path] [current-load-relative-directory path]
[current-directory path]) [current-directory path]
[current-output-port (open-output-nowhere)])
(loader p))))))) (loader p)))))))
(apply test-suite dir (apply test-suite dir
tests))) tests)))
@ -87,9 +88,7 @@
(define (go) (test/gui tests)) (define (go) (test/gui tests))
(define (go/text) (test/text-ui tests)) (define (go/text) (test/text-ui tests))
(when (getenv "PLT_TESTS") (provide go go/text)
(unless (parameterize ([current-output-port (open-output-string)])
(= 0 (go/text)))
(error "Typed Scheme Tests did not pass.")))

6
collects/tests/typed-scheme/run.ss Normal file
View File

@ -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."))