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

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

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

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)) {
+      if (mode == mzPDC_COPY) {
-        bad_place_message2(so, *fd_accumulators, can_raise_exn);
+        new_so = scheme_make_sized_offset_byte_string((char *)so, SCHEME_SYMSTR_OFFSET(so), SCHEME_SYM_LEN(so), 1);
-        if (invalid_object) *invalid_object = so;
+        if (SCHEME_SYM_UNINTERNEDP(so)) {
-        return NULL;
+          MZ_OPT_HASH_KEY(&((Scheme_Symbol*)new_so)->iso) = 0x1;
-      } else {
+        } else if (SCHEME_SYM_PARALLELP(so)) {
-        if (mode == mzPDC_COPY) {
+          MZ_OPT_HASH_KEY(&((Scheme_Symbol*)new_so)->iso) = 0x2;
-          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();
         }
+        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);
   }