test-project-port: connect to server to verify that it's up
parent
b8000c08c0
commit
e7be028dc0
@ -1,36 +1,51 @@
|
|||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require rackunit
|
(require racket/port
|
||||||
racket/port
|
racket/runtime-path
|
||||||
racket/runtime-path)
|
racket/tcp
|
||||||
|
rackunit)
|
||||||
|
|
||||||
(define-runtime-path project-port-dir "data/project-port")
|
(define-runtime-path project-port-dir "data/project-port")
|
||||||
|
|
||||||
(define thd #f)
|
(define the-port
|
||||||
(define-values (in out) (make-pipe))
|
(dynamic-require
|
||||||
(parameterize ([exit-handler (lambda (code)
|
`(submod ,(build-path project-port-dir "pollen.rkt") setup)
|
||||||
(fail (format "abnormal exit from raco command~n code: ~a" code))
|
'project-server-port))
|
||||||
(kill-thread thd))])
|
|
||||||
(set! thd
|
|
||||||
(parameterize ([current-output-port out]
|
|
||||||
[current-error-port out]
|
|
||||||
[current-directory project-port-dir]
|
|
||||||
[current-command-line-arguments (vector "start")])
|
|
||||||
(thread
|
|
||||||
(lambda ()
|
|
||||||
(dynamic-require '(submod pollen/private/command raco) #f)))))
|
|
||||||
|
|
||||||
(dynamic-wind
|
(define-values (in out)
|
||||||
void
|
(make-pipe))
|
||||||
(lambda ()
|
|
||||||
(sync
|
(define thd
|
||||||
(handle-evt
|
(parameterize ([current-output-port out]
|
||||||
(regexp-match-evt #rx"project server is http://localhost:9876" in)
|
[current-error-port out]
|
||||||
void)
|
[current-directory project-port-dir]
|
||||||
(handle-evt
|
[current-command-line-arguments (vector "start")]
|
||||||
(alarm-evt (+ (current-inexact-milliseconds) 5000))
|
[exit-handler (lambda (code)
|
||||||
(lambda (_)
|
(fail (format "abnormal exit from raco command~n code: ~a" code))
|
||||||
(fail "timed out while waiting for server to start")))))
|
(kill-thread thd))])
|
||||||
(lambda ()
|
(thread
|
||||||
(break-thread thd)
|
(lambda ()
|
||||||
(thread-wait thd))))
|
(dynamic-require '(submod pollen/private/command raco) #f)))))
|
||||||
|
|
||||||
|
(dynamic-wind
|
||||||
|
void
|
||||||
|
(lambda ()
|
||||||
|
(sync
|
||||||
|
(handle-evt
|
||||||
|
(regexp-match-evt #rx"ready to rock" in)
|
||||||
|
void)
|
||||||
|
(handle-evt
|
||||||
|
(alarm-evt (+ (current-inexact-milliseconds) 5000))
|
||||||
|
(lambda (_)
|
||||||
|
(fail "timed out while waiting for server to start"))))
|
||||||
|
|
||||||
|
(with-handlers ([exn:fail?
|
||||||
|
(lambda (e)
|
||||||
|
(fail (format "failed to connect to server: ~a" (exn-message e))))])
|
||||||
|
(define-values (cin cout)
|
||||||
|
(tcp-connect "127.0.0.1" the-port))
|
||||||
|
(close-output-port cout)
|
||||||
|
(close-input-port cin)))
|
||||||
|
(lambda ()
|
||||||
|
(break-thread thd)
|
||||||
|
(thread-wait thd)))
|
||||||
|
Loading…
Reference in New Issue