From 3744e224b79be94c3223061b94cef2be0f70f17c Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Wed, 4 Aug 2010 13:22:46 -0600 Subject: [PATCH] Places: fix sending place channels over place channels --- collects/racket/place.rkt | 4 +++- collects/tests/racket/place-channel.rktl | 30 +++++++++++------------- src/racket/src/places.c | 14 +++++++---- 3 files changed, 27 insertions(+), 21 deletions(-) diff --git a/collects/racket/place.rkt b/collects/racket/place.rkt index 10180369be..5c7b07df3c 100644 --- a/collects/racket/place.rkt +++ b/collects/racket/place.rkt @@ -8,8 +8,10 @@ (provide place place-sleep place-wait + place-channel place-channel-send place-channel-recv place-channel? place? - place-channel-send/recv) + place-channel-send/recv + place-channel->receiver-channel) diff --git a/collects/tests/racket/place-channel.rktl b/collects/tests/racket/place-channel.rktl index 8442c5dfdd..12d9722168 100644 --- a/collects/tests/racket/place-channel.rktl +++ b/collects/tests/racket/place-channel.rktl @@ -21,9 +21,7 @@ (let ([x (place-channel-recv ch)]) body)))])) - (define-syntax pcrss - (syntax-rules () - [(_ ch body ...) (begin (pcrs ch body) ...)])) + (define-syntax-rule (pcrss ch body ...) (begin (pcrs ch body) ...)) (define (place-main ch) (pcrss ch @@ -32,33 +30,33 @@ (cons (car x) 'b) (list (car x) 'b (cadr x)) (vector (vector-ref x 0) 'b (vector-ref x 1)) - #s((bozo 1 building 2) 6 'gubber 'no) - )) + #s((abuilding 1 building 2) 6 'utah 'no)) + (define pc1 (place-channel->receiver-channel (place-channel-recv ch))) + (pcrss pc1 (string-append x "-ok"))) ) END "pct1.ss") -(define (pcsr ch x) - (place-channel-send ch x) - (place-channel-recv ch)) - -(define-syntax pcsrs - (syntax-rules () - [(_ ch (send expect) ...) (begin (test expect pcsr ch send) ...)])) +(define-syntax-rule (pc-send-recv-test ch (send expect) ...) + (begin (test expect place-channel-send/recv ch send) ...)) (define-struct building (rooms location) #:prefab) (define-struct (house building) (occupied ) #:prefab) -(define h1 (make-house 5 'factory 'no)) +(define h1 (make-house 5 'factory 'yes)) (let ([pl (place "pct1.ss" 'place-main)]) - (pcsrs pl + (pc-send-recv-test pl (1 2 ) ("Hello" "Hello-ok") ((cons 'a 'a) (cons 'a 'b)) ((list 'a 'a) (list 'a 'b 'a)) (#(a a) #(a b a)) - (h1 #s((bozo 1 building 2) 6 'gubber 'no)) -)) + (h1 #s((abuilding 1 building 2) 6 'utah 'no))) + (define pc1 (place-channel)) + (place-channel-send pl pc1) + (test "Testing-ok" place-channel-send/recv pc1 "Testing") + (place-wait pl) +) diff --git a/src/racket/src/places.c b/src/racket/src/places.c index b2e2290ed6..4ac4d8f1ac 100644 --- a/src/racket/src/places.c +++ b/src/racket/src/places.c @@ -1221,7 +1221,10 @@ Scheme_Object *scheme_place_bi_peer_channel_create(Scheme_Object *orig) { static Scheme_Object *scheme_place_channel(int argc, Scheme_Object *args[]) { if (argc == 0) { - return scheme_place_bi_channel_create(); + Scheme_Place_Bi_Channel *ch; + ch = scheme_place_bi_channel_create(); + scheme_place_bi_channel_set_signal((Scheme_Object *) ch); + return ch; } else { scheme_wrong_count_m("place-channel", 0, 0, argc, args, 0); @@ -1232,14 +1235,17 @@ static Scheme_Object *scheme_place_channel(int argc, Scheme_Object *args[]) { static Scheme_Object *scheme_place_channel_receiver_channel(int argc, Scheme_Object *args[]) { if (argc == 1) { if (SAME_TYPE(SCHEME_TYPE(args[0]), scheme_place_bi_channel_type)) { - return scheme_place_bi_peer_channel_create(args[0]); + Scheme_Place_Bi_Channel *ch; + ch = scheme_place_bi_peer_channel_create(args[0]); + scheme_place_bi_channel_set_signal((Scheme_Object *) ch); + return ch; } else { - scheme_wrong_type("place-channel->receive-channel", "place-channel?", 0, argc, args); + scheme_wrong_type("place-channel->receiver-channel", "place-channel?", 0, argc, args); } } else { - scheme_wrong_count_m("place-channel-send", 1, 1, argc, args, 0); + scheme_wrong_count_m("place-channel->receiver-channel", 1, 1, argc, args, 0); } return scheme_true; }