From 961f5e40bf590b3cf953f53fe3eb6c42a93915a5 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 23 Nov 2012 07:03:55 -0700
Subject: [PATCH] fix untagged cpointer as place-channel message

(repair by Kevin)

Closes PR 13282
---
 collects/tests/racket/place-channel-ffi.rkt | 31 ++++++++-------------
 src/racket/src/place.c                      | 12 +++++---
 2 files changed, 20 insertions(+), 23 deletions(-)

diff --git a/collects/tests/racket/place-channel-ffi.rkt b/collects/tests/racket/place-channel-ffi.rkt
index 6bff4f31b7..907d214196 100644
--- a/collects/tests/racket/place-channel-ffi.rkt
+++ b/collects/tests/racket/place-channel-ffi.rkt
@@ -2,29 +2,13 @@
 
 (require racket/place
          ffi/unsafe
+         openssl/libcrypto
          racket/runtime-path
          rackunit
          (for-syntax racket/base))
 
-(define-runtime-path libcrypto-so
-  (case (system-type)
-    [(windows) '(so "libeay32")]
-    [else '(so "libcrypto")]))
-
-(define libcrypto
-  (with-handlers ([exn:fail? (lambda (exn) 
-                               (log-warning (format "warning: couldn't load OpenSSL library: ~a"
-                                                    (if (exn? exn)
-                                                        (exn-message exn)
-                                                        exn)))
-                               #f)])
-    (ffi-lib libcrypto-so '("" "0.9.8b" "0.9.8" "0.9.7"))))
-
 (define-syntax-rule (define-crypto-func name func-signature)
-  (begin
-    (define name (and libcrypto (get-ffi-obj (quote name) libcrypto func-signature (lambda () #f))))
-    (provide name)))
-
+  (define name (and libcrypto (get-ffi-obj (quote name) libcrypto func-signature (lambda () #f)))))
 
 (define-cstruct _BN ([j1 _long] [top _int] [dmax _int] [neg _int] [flags _int]))
 (define-crypto-func BN_new (_fun -> _BN-pointer))
@@ -43,6 +27,15 @@
   (define p (place ch
                    (define b (place-channel-get ch))
                    (printf "Got it ~a\n" (BN-j1 b))
-                   (check-equal? (BN-j1 b) 1334)))
+                   (check-equal? (BN-j1 b) 1334)
+                   
+                   (place-channel-put ch (place-channel-get ch))))
   (place-channel-put p bn)
+
+  (define-cstruct _S ([a _int]))
+  (define s (malloc _S 'raw))
+  (check-equal? #t (place-message-allowed? s))
+  (place-channel-put p s)
+  (check-equal? s (place-channel-get p))
+
   (place-wait p))
diff --git a/src/racket/src/place.c b/src/racket/src/place.c
index d4f5046608..645eaea89a 100644
--- a/src/racket/src/place.c
+++ b/src/racket/src/place.c
@@ -1393,14 +1393,18 @@ static Scheme_Object *shallow_types_copy(Scheme_Object *so, Scheme_Hash_Table *h
           o->type = scheme_cpointer_type;
           SCHEME_CPTR_FLAGS(o) |= 0x1;
           SCHEME_CPTR_VAL(o) = SCHEME_CPTR_VAL(so);
-          o2 = shallow_types_copy(SCHEME_CPTR_TYPE(so), NULL, fd_accumulators, delayed_errno, mode, 
-                                  can_raise_exn, master_chain, invalid_object);
+          o2 = SCHEME_CPTR_TYPE(so);
+          if (o2)
+            o2 = shallow_types_copy(o2, NULL, fd_accumulators, delayed_errno, mode, 
+                                    can_raise_exn, master_chain, invalid_object);
           SCHEME_CPTR_TYPE(o) = o2;
 
           new_so = o;
         } else {
-          (void)shallow_types_copy(SCHEME_CPTR_TYPE(so), NULL, fd_accumulators, delayed_errno, mode, 
-                                   can_raise_exn, master_chain, invalid_object);
+          if (SCHEME_CPTR_TYPE(so)) {
+            (void)shallow_types_copy(SCHEME_CPTR_TYPE(so), NULL, fd_accumulators, delayed_errno, mode, 
+                                     can_raise_exn, master_chain, invalid_object);
+          }
         }
       }
       else {