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

pkg-build/thread: fix test

Browse Source
This commit is contained in:
Matthew Flatt 2014-07-08 07:11:41 +01:00
parent 7dde0e98cf
commit 87c34b1023
1 changed files with 48 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
pkgs/plt-services/meta/pkg-build/thread.rkt
View File

@ -89,21 +89,51 @@
;; -------------------------------------------------- ;; --------------------------------------------------
(module+ test (module test racket/base
(define t1 (thread/chunk-output (define o (open-output-bytes))
(lambda () (parameterize ([current-output-port o]
(printf "hi\n") [current-error-port o])
(eprintf "bye\n") (define-syntax-rule (def id)
(flush-chunk-output) (define id
(sleep) (dynamic-require (module-path-index-join
(printf "HI\n") `(submod "..")
(eprintf "BYE\n")))) (variable-reference->module-path-index
(define t2 (thread/chunk-output (#%variable-reference)))
(lambda () 'id)))
(printf "hola\n") (def thread/chunk-output)
(eprintf "adios\n") (def flush-chunk-output)
(flush-chunk-output) (def wait-chunk-output)
(sleep) (define t1 (thread/chunk-output
(printf "HOLA\n") (lambda ()
(eprintf "ADIOS\n")))) (printf "hi\n")
(wait-chunk-output)) (eprintf "bye\n")
(flush-chunk-output)
(sleep)
(printf "HI\n")
(eprintf "BYE\n"))))
(define t2 (thread/chunk-output
(lambda ()
(printf "hola\n")
(eprintf "adios\n")
(flush-chunk-output)
(sleep)
(printf "HOLA\n")
(eprintf "ADIOS\n"))))
(wait-chunk-output))
(let ([l '("hi\nbye" "hola\nadios")]
[s (get-output-string o)]
[sa (lambda (a b) (string-append (car a)
"\n"
(cadr a)
"\n"
(car b)
"\n"
(cadr b)
"\n"))]
[r reverse]
[u (lambda (l) (map string-upcase l))])
(unless (or (equal? s (sa l (u l)))
(equal? s (sa (r l) (u l)))
(equal? s (sa (r l) (u (r l))))
(equal? s (sa l (u (r l)))))
(error "mismatch: " s))))