diff --git a/collects/tests/racket/place-channel.rktl b/collects/tests/racket/place-channel.rktl index 473b33cfcd..933cdff3b3 100644 --- a/collects/tests/racket/place-channel.rktl +++ b/collects/tests/racket/place-channel.rktl @@ -104,10 +104,21 @@ END (place-channel-send pl pc5) (test "Ready5" sync pc6) + (let ([try-graph + (lambda (s) + (let ([v (read (open-input-string s))]) + (place-channel-send pc5 v) + (test v place-channel-receive pc6)))]) + (try-graph "#0=(#0# . #0#)") + (try-graph "#0=#(#0# 7 #0#)") + (try-graph "#0=#s(thing 7 #0#)")) + (check-exn exn:fail? (λ () (place-channel-send pl (open-output-string)))) (check-not-exn (λ () (place-channel-send pl "Test String"))) - (check-not-exn (λ () (place-channel-send pl (string->path "C:\\Windows")))) + (check-not-exn (λ () (place-channel-send pl (bytes->path #"/tmp/unix" 'unix)))) + (check-not-exn (λ () (place-channel-send pl (bytes->path #"C:\\Windows" 'windows)))) (place-wait pl) ) +(report-errs) diff --git a/collects/tests/racket/place.rktl b/collects/tests/racket/place.rktl index bc5ac9f662..6da052e9f9 100644 --- a/collects/tests/racket/place.rktl +++ b/collects/tests/racket/place.rktl @@ -34,3 +34,5 @@ (printf "Hello form place 2\n") (sync never-evt))]) (place-kill p)) + +(report-errs) \ No newline at end of file diff --git a/src/racket/src/places.c b/src/racket/src/places.c index 00b3fff29e..bed170e859 100644 --- a/src/racket/src/places.c +++ b/src/racket/src/places.c @@ -802,6 +802,7 @@ static Scheme_Object *trivial_copy(Scheme_Object *so) Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table **ht) { Scheme_Object *new_so = so; + int skip_hash; /* First, check for simple values that don't need to be hashed: */ new_so = trivial_copy(so); @@ -814,6 +815,14 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab } } + if (!*ht) { + Scheme_Hash_Table *_ht; + _ht = scheme_make_hash_table(SCHEME_hash_ptr); + *ht = _ht; + } + + skip_hash = 0; + switch (SCHEME_TYPE(so)) { case scheme_char_type: new_so = scheme_make_char(SCHEME_CHAR_VAL(so)); @@ -874,9 +883,17 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab Scheme_Object *car; Scheme_Object *cdr; Scheme_Object *pair; + + /* handle cycles: */ + pair = scheme_make_pair(scheme_false, scheme_false); + scheme_hash_set(*ht, so, pair); + skip_hash = 1; + car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht); cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht); - pair = scheme_make_pair(car, cdr); + SCHEME_CAR(pair) = car; + SCHEME_CDR(pair) = cdr; + new_so = pair; } break; @@ -886,6 +903,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab intptr_t i; intptr_t size = SCHEME_VEC_SIZE(so); vec = scheme_make_vector(size, 0); + + /* handle cycles: */ + scheme_hash_set(*ht, so, vec); + skip_hash = 1; + for (i = 0; i prefab_key, ht); nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size); + + /* handle cycles: */ + scheme_hash_set(*ht, so, (Scheme_Object *)nst); + skip_hash = 1; + for (i = 0; i slots[i], ht); @@ -964,6 +991,11 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab size = st->num_slots; stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size); nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype); + + /* handle cycles: */ + scheme_hash_set(*ht, so, (Scheme_Object *)nst); + skip_hash = 1; + for (i = 0; i slots[i], ht); @@ -979,12 +1011,8 @@ Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Tab break; } - if (!*ht) { - Scheme_Hash_Table *_ht; - _ht = scheme_make_hash_table(SCHEME_hash_ptr); - *ht = _ht; - } - scheme_hash_set(*ht, so, new_so); + if (!skip_hash) + scheme_hash_set(*ht, so, new_so); return new_so; } @@ -1296,7 +1324,7 @@ Scheme_Object *scheme_place_send(int argc, Scheme_Object *args[]) { else { scheme_wrong_count_m("place-channel-send", 2, 2, argc, args, 0); } - return scheme_true; + return scheme_void; } Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) { @@ -1317,7 +1345,7 @@ Scheme_Object *scheme_place_receive(int argc, Scheme_Object *args[]) { else { scheme_wrong_count_m("place-channel-receive", 1, 1, argc, args, 0); } - return scheme_true; + ESCAPED_BEFORE_HERE; } # ifdef MZ_PRECISE_GC