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

Places: fix sending place channels over place channels

Browse Source
This commit is contained in:
Kevin Tew 2010-08-04 13:22:46 -06:00
parent be95805548
commit 3744e224b7
3 changed files with 27 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/racket/place.rkt
View File

@ -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)

30
collects/tests/racket/place-channel.rktl
View File

@ -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)
)

14
src/racket/src/places.c
View File

@ -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;
}