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

fix untagged cpointer as place-channel message

Browse Source 
(repair by Kevin)

Closes PR 13282
This commit is contained in:
Matthew Flatt 2012-11-23 07:03:55 -07:00
parent 50c03c3622
commit 961f5e40bf
2 changed files with 20 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/tests/racket/place-channel-ffi.rkt
View File

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

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

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