From 4f3bec1792782e91a4364414b870d2678af2b2bc Mon Sep 17 00:00:00 2001 From: Kevin Tew Date: Wed, 8 Feb 2012 10:20:30 -0700 Subject: [PATCH] pr# 12542 fixed - All symbol types are now allowed across place channels. --- collects/scribblings/reference/places.scrbl | 2 +- collects/tests/racket/place.rktl | 47 +++++++++++++++++++-- src/racket/src/place.c | 42 ++++++++++++------ 3 files changed, 73 insertions(+), 18 deletions(-) diff --git a/collects/scribblings/reference/places.scrbl b/collects/scribblings/reference/places.scrbl index d05f49de8b..7095204d2b 100644 --- a/collects/scribblings/reference/places.scrbl +++ b/collects/scribblings/reference/places.scrbl @@ -303,7 +303,7 @@ messages: @item{@tech{numbers}, @tech{characters}, @tech{booleans}, and @|void-const|;} - @item{@tech{symbols} that are @tech{interned};} + @item{@tech{symbols};} @item{@tech{strings} and @tech{byte strings}, where mutable strings and byte strings are automatically replaced by immutable diff --git a/collects/tests/racket/place.rktl b/collects/tests/racket/place.rktl index c471fda84a..3673f99bb3 100644 --- a/collects/tests/racket/place.rktl +++ b/collects/tests/racket/place.rktl @@ -7,9 +7,47 @@ (let () (define-values (in out) (place-channel)) - (err/rt-test (place-channel-put in (string->uninterned-symbol "invalid")))) + (struct ts (a)) + (err/rt-test (place-channel-put in (ts "k"))) + (define us (string->uninterned-symbol "foo")) + (define us2 (string->uninterned-symbol "foo")) + (place-channel-put in (cons us us)) + (let () + (define r (place-channel-get out)) + (test #t equal? (car r) (cdr r)) + (test #f equal? us (car r)) + (test #f equal? us (cdr r)) + (test #f symbol-interned? (car r)) + (test #f symbol-interned? (cdr r)) + (place-channel-put in (cons us us2)) + (define r2 (place-channel-get out)) + (test #f symbol-interned? (car r2)) + (test #f symbol-interned? (cdr r2)) + (test #f equal? (car r2) (cdr r2)) + (test #f equal? us (car r2)) + (test #f equal? us2 (cdr r2))) + (let () + (define us (string->unreadable-symbol "foo2")) + (define us2 (string->unreadable-symbol "foo3")) + (place-channel-put in (cons us us)) + (define r (place-channel-get out)) + (test #t equal? (car r) (cdr r)) + (test #t equal? us (car r)) + (test #t equal? us (cdr r)) + (test #t symbol-unreadable? (car r)) + (test #t symbol-unreadable? (cdr r)) + (place-channel-put in (cons us us2)) + (define r2 (place-channel-get out)) + (test #t symbol-unreadable? (car r2)) + (test #t symbol-unreadable? (cdr r2)) + (test #f equal? (car r2) (cdr r2)) + ;interned into the same table as us and us2 + ;because the same place sends and receives + (test #t equal? us (car r2)) + (test #t equal? us2 (cdr r2)))) + (let ([p (place/base (p1 ch) (printf "Hello form place 2\n") (exit 99))]) @@ -48,12 +86,13 @@ (for ([v (list #t #f null 'a #\a 1 1/2 1.0 (expt 2 100) "apple" (make-string 10) #"apple" (make-bytes 10) - (void))]) + (void) (gensym) (string->uninterned-symbol "apple") + (string->unreadable-symbol "grape"))]) (test #t place-message-allowed? v) (test #t place-message-allowed? (list v)) (test #t place-message-allowed? (vector v))) -(for ([v (list (gensym) (string->uninterned-symbol "apple") - (lambda () 10) + +(for ([v (list (lambda () 10) add1)]) (test (not (place-enabled?)) place-message-allowed? v) (test (not (place-enabled?)) place-message-allowed? (list v)) diff --git a/src/racket/src/place.c b/src/racket/src/place.c index f781cb515b..4bcd6109cd 100644 --- a/src/racket/src/place.c +++ b/src/racket/src/place.c @@ -1251,23 +1251,30 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h SCHEME_TYPE(so)); break; case scheme_symbol_type: - if (SCHEME_SYM_UNINTERNEDP(so)) { - bad_place_message2(so, *fd_accumulators, can_raise_exn); - if (invalid_object) *invalid_object = so; - return NULL; - } else { - if (mode == mzPDC_COPY) { - new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1); - new_so->type = scheme_serialized_symbol_type; - } else if (mode != mzPDC_CHECK) { - scheme_log_abort("encountered symbol in bad mode"); - abort(); + if (mode == mzPDC_COPY) { + new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1); + if (SCHEME_SYM_UNINTERNEDP(so)) { + MZ_OPT_HASH_KEY(&((Scheme_Symbol*)new_so)->iso) = 0x1; + } else if (SCHEME_SYM_PARALLELP(so)) { + MZ_OPT_HASH_KEY(&((Scheme_Symbol*)new_so)->iso) = 0x2; } + new_so->type = scheme_serialized_symbol_type; + } else if (mode != mzPDC_CHECK) { + scheme_log_abort("encountered symbol in bad mode"); + abort(); } break; case scheme_serialized_symbol_type: if ((mode == mzPDC_UNCOPY) || (mode == mzPDC_DESER)) - new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so)); + if (SCHEME_SYM_UNINTERNEDP(so)) { + new_so = scheme_make_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so)); + } + else if (SCHEME_SYM_PARALLELP(so)) { + new_so = scheme_intern_exact_parallel_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so)); + } + else { + new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so)); + } else if (mode != mzPDC_CLEAN) { scheme_log_abort("encountered serialized symbol in bad mode"); abort(); @@ -2719,7 +2726,16 @@ static void place_async_send(Scheme_Place_Async_Channel *ch, Scheme_Object *uo) o = places_serialize(uo, &msg_memory, &master_chain, &invalid_object); if (!o) { - if (invalid_object) bad_place_message(invalid_object); + if (invalid_object) { + char *s; + intptr_t slen; + char *s1; + intptr_t slen1; + s = scheme_make_provided_string(invalid_object, 1, &slen); + s1 = scheme_make_provided_string(uo, 1, &slen1); + scheme_raise_exn(MZEXN_FAIL_CONTRACT, "place-channel-put: value %t not allowed in a message: %t", + s, slen, s1, slen1); + } else bad_place_message(uo); }