From 7b149b7f5ac74c71da5914568def5d92df051cee Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Wed, 24 Oct 2012 13:25:09 -0600 Subject: [PATCH] Revert "Change thread test to use fake tcp with same structure" This reverts commit d39780a130923b59169f0f6fe7b046b7ba73b6cf. Matthew says this test is really about TCP, so it should not be changed. Although perhaps we can use a more basic TCP test to check if this should be done. --- collects/tests/racket/thread.rktl | 33 +++++-------------------------- 1 file changed, 5 insertions(+), 28 deletions(-) diff --git a/collects/tests/racket/thread.rktl b/collects/tests/racket/thread.rktl index 3e8d9a1c40..1f0744802f 100644 --- a/collects/tests/racket/thread.rktl +++ b/collects/tests/racket/thread.rktl @@ -613,36 +613,13 @@ (test #f semaphore-try-wait? s) (test #f semaphore-try-wait? s2)))) -(struct ftcp-listener (sema sr sw cr cw) - #:property prop:evt - (λ (l) - (handle-evt (semaphore-peek-evt (ftcp-listener-sema l)) - (λ (_) - l)))) -(define (ftcp-listen _0 _1 _2) - (define-values (cr sw) (make-pipe 4098)) - (define-values (sr cw) (make-pipe 4098)) - (ftcp-listener (make-semaphore 0) sr sw cr cw)) -(define (ftcp-addresses l _1) - (values #f l #f #f)) -(define (ftcp-connect h l) - (semaphore-post (ftcp-listener-sema l)) - (values (ftcp-listener-cr l) - (ftcp-listener-cw l))) -(define (ftcp-accept l) - (semaphore-wait (ftcp-listener-sema l)) - (values (ftcp-listener-sr l) - (ftcp-listener-sw l))) -(define (ftcp-close l) - (void)) - (define (listen-port x) - (let-values ([(la lp pa pp) (ftcp-addresses x #t)]) + (let-values ([(la lp pa pp) (tcp-addresses x #t)]) lp)) (let ([s (make-semaphore)] [s-t (make-semaphore)] - [l (ftcp-listen 0 5 #t)]) + [l (tcp-listen 0 5 #t)]) (let ([t (thread (lambda () (sync s-t)))] @@ -691,11 +668,11 @@ (set! t (thread (lambda () (semaphore-wait (make-semaphore))))) - (let-values ([(cr cw) (ftcp-connect "localhost" portnum)]) + (let-values ([(cr cw) (tcp-connect "localhost" portnum)]) (test l sync s t l r) (test l sync s t l r) - (let-values ([(sr sw) (ftcp-accept l)]) + (let-values ([(sr sw) (tcp-accept l)]) (try-all-blocked) (close-output-port w) @@ -743,7 +720,7 @@ (close-output-port cw) (test sr sync s t l sr)))) - (ftcp-close l))) + (tcp-close l))) ;; Test limited pipe output waiting: (let-values ([(r w) (make-pipe 5000)])