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

fix `unsafe-struct-{ref,set}' for chaperones

Browse Source
This commit is contained in:
Matthew Flatt 2011-07-06 15:07:19 -06:00
parent 5b0fd72f7a
commit 6b4b95c569
2 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
collects/tests/racket/unsafe.rktl
View File

@ -307,15 +307,24 @@
#:literal-ok? #f))
(test-bin 65535 'unsafe-u16vector-ref (u16vector 10 65535 187) 1)
(for ([star (list values (add-star "star"))])
(let ()
(define-struct posn (x [y #:mutable] z))
(test-bin 'a unsafe-struct-ref (make-posn 'a 'b 'c) 0 #:literal-ok? #f)
(test-bin 'b unsafe-struct-ref (make-posn 'a 'b 'c) 1 #:literal-ok? #f)
(let ([p (make-posn 100 200 300)])
(for ([star (list values (add-star "star"))])
(test-bin 'a unsafe-struct-ref (make-posn 'a 'b 'c) 0 #:literal-ok? #f)
(test-bin 'b unsafe-struct-ref (make-posn 'a 'b 'c) 1 #:literal-ok? #f)
(let ([p (make-posn 100 200 300)])
(test-tri 500 (star 'unsafe-struct-set!) p 1 500
#:pre (lambda () (set-posn-y! p 0))
#:post (lambda (x) (posn-y p))
#:literal-ok? #f)))
(let ([p (chaperone-struct (make-posn 100 200 300)
posn-y (lambda (p v) v)
set-posn-y! (lambda (p v) v))])
(test-tri 500 'unsafe-struct-set! p 1 500
#:pre (lambda () (set-posn-y! p 0))
#:post (lambda (x) (posn-y p))
#:literal-ok? #f)))
;; test unboxing:
(test-tri 5.4 '(lambda (x y z) (unsafe-fl+ x (unsafe-f64vector-ref y z))) 1.2 (f64vector 1.0 4.2 6.7) 1)
(test-tri 3.2 '(lambda (x y z)

10
src/racket/src/vector.c
View File

@ -887,12 +887,18 @@ static Scheme_Object *unsafe_vector_set (int argc, Scheme_Object *argv[])
static Scheme_Object *unsafe_struct_ref (int argc, Scheme_Object *argv[])
{
return ((Scheme_Structure *)argv[0])->slots[SCHEME_INT_VAL(argv[1])];
if (SCHEME_CHAPERONEP(argv[0]))
return scheme_struct_ref(argv[0], SCHEME_INT_VAL(argv[1]));
else
return ((Scheme_Structure *)argv[0])->slots[SCHEME_INT_VAL(argv[1])];
}
static Scheme_Object *unsafe_struct_set (int argc, Scheme_Object *argv[])
{
((Scheme_Structure *)argv[0])->slots[SCHEME_INT_VAL(argv[1])] = argv[2];
if (SCHEME_CHAPERONEP(argv[0]))
scheme_struct_set(argv[0], SCHEME_INT_VAL(argv[1]), argv[2]);
else
((Scheme_Structure *)argv[0])->slots[SCHEME_INT_VAL(argv[1])] = argv[2];
return scheme_void;
}