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

pr# 12542 fixed - All symbol types are now allowed across place channels.

Browse Source
This commit is contained in:
Kevin Tew 2012-02-08 10:20:30 -07:00
parent 55b3d99d78
commit 4f3bec1792
3 changed files with 73 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/scribblings/reference/places.scrbl
View File

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

47
collects/tests/racket/place.rktl
View File

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

42
src/racket/src/place.c
View File

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