test fixups

This commit is contained in:
Matthew Flatt 2013-02-16 08:56:21 -07:00
parent fbeecdc1aa
commit 72c39ca7ff
2 changed files with 21 additions and 13 deletions

View File

@ -1387,6 +1387,7 @@ path/s is either such a string or a list of them.
"collects/tests/racket/place-channel-ffi.rkt" responsible (tewk) "collects/tests/racket/place-channel-ffi.rkt" responsible (tewk)
"collects/tests/racket/place-channel-socket.rkt" responsible (tewk) "collects/tests/racket/place-channel-socket.rkt" responsible (tewk)
"collects/tests/racket/place-channel.rkt" responsible (tewk) drdr:timeout 300 "collects/tests/racket/place-channel.rkt" responsible (tewk) drdr:timeout 300
"collects/tests/racket/place-parallel.rkt" drdr:command-line #f
"collects/tests/racket/place.rktl" responsible (tewk) "collects/tests/racket/place.rktl" responsible (tewk)
"collects/tests/racket/places.rkt" responsible (tewk) "collects/tests/racket/places.rkt" responsible (tewk)
"collects/tests/racket/port.rktl" drdr:command-line #f "collects/tests/racket/port.rktl" drdr:command-line #f

View File

@ -8,18 +8,24 @@
(define (main) (define (main)
(define-syntax-rule (with-stderr e)
(parameterize ([current-error-port (current-output-port)])
e))
(test-exn (test-exn
"using a closed port with place*" "output port is closed"
(lambda (x) (void)) (lambda (x) (void))
(let () (lambda ()
(define op (open-output-bytes)) (define op (open-output-bytes))
(call-with-output-file "foo.foo" #:exists 'replace (lambda (op) (call-with-output-file "foo.foo" #:exists 'replace
(close-output-port op) (lambda (op)
(let-values ([(p pin pout perr) (place* #:out op ch (printf "Hello3\n"))]) (close-output-port op)
(place-wait p)))))) (let-values ([(p pin pout perr) (place* #:out op ch (printf "Hello3\n"))])
(place-wait p))))))
(place-wait (place ch (printf "Hello1\n"))) (place-wait (place ch (printf "Hello1\n")))
(place-wait (place ch (eprintf "Hello2\n"))) (with-stderr
(place-wait (place ch (eprintf "Hello2\n"))))
(place-wait (place ch (printf "~a\n" (read)))) ; #<eof> (place-wait (place ch (printf "~a\n" (read)))) ; #<eof>
(let-values ([(p pin pout perr) (place* ch (printf "Hello3\n"))]) (let-values ([(p pin pout perr) (place* ch (printf "Hello3\n"))])
@ -31,9 +37,10 @@
(let-values ([(p pin pout perr) (place* #:out (current-output-port) ch (printf "Hello5\n"))]) (let-values ([(p pin pout perr) (place* #:out (current-output-port) ch (printf "Hello5\n"))])
(place-wait p)) (place-wait p))
(let-values ([(p pin pout perr) (place* #:err (current-error-port) ch (eprintf "Hello6\n") (with-stderr
(flush-output (current-error-port)))]) (let-values ([(p pin pout perr) (place* #:err (current-error-port) ch (eprintf "Hello6\n")
(place-wait p)) (flush-output (current-error-port)))])
(place-wait p)))
(let-values ([(p pin pout perr) (place* #:out (current-output-port) ch (printf "Hello7 ~a\n" (read)))]) (let-values ([(p pin pout perr) (place* #:out (current-output-port) ch (printf "Hello7 ~a\n" (read)))])
(write "Again" pin) (write "Again" pin)
(flush-output pin) (flush-output pin)