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

Fix `array-set!' for arrays of more than 2 dimensions.

Browse Source 
Closes PR 12765.
This commit is contained in:
Eli Barzilay 2012-05-11 06:17:57 -04:00
parent 621fd87b51
commit 7f940de6f9
2 changed files with 18 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/ffi/unsafe.rkt
View File

@ -996,11 +996,11 @@
(define-struct array (ptr type length)) (define-struct array (ptr type length))
(define array-ref (define array-ref
(case-lambda (case-lambda
[(a i) [(a i)
(let ([len (array-length a)]) (define len (array-length a))
(if (< -1 i len) (if (< -1 i len)
(ptr-ref (array-ptr a) (array-type a) i) (ptr-ref (array-ptr a) (array-type a) i)
(raise-mismatch-error 'array-ref "index out of bounds: " i)))] (raise-mismatch-error 'array-ref "index out of bounds: " i))]
[(a . is) [(a . is)
(let loop ([a a] [is is]) (let loop ([a a] [is is])
(if (null? is) (if (null? is)
@ -1009,15 +1009,15 @@
(define array-set! (define array-set!
(case-lambda (case-lambda
[(a i v) [(a i v)
(let ([len (array-length a)]) (define len (array-length a))
(if (< -1 i len) (if (< -1 i len)
(ptr-set! (array-ptr a) (array-type a) i v) (ptr-set! (array-ptr a) (array-type a) i v)
(raise-mismatch-error 'array-ref "index out of bounds: " i)))] (raise-mismatch-error 'array-ref "index out of bounds: " i))]
[(a i i1 . is+v) [(a i i1 . is+v)
(let ([is+v (reverse (list* i i1 is+v))]) (let ([is+v (reverse (list* i i1 is+v))])
(define v (car is+v)) (define v (car is+v))
(define i (cadr is+v)) (define i (cadr is+v))
(let loop ([a a] [is (cddr is+v)]) (let loop ([a a] [is (reverse (cddr is+v))])
(if (null? is) (if (null? is)
(array-set! a i v) (array-set! a i v)
(loop (array-ref a (car is)) (cdr is)))))])) (loop (array-ref a (car is)) (cdr is)))))]))

8
collects/tests/racket/foreign-test.rktl
View File

@ -430,6 +430,14 @@
0)) 0))
(test 44 values (cast d _gcpointer _intptr)))) (test 44 values (cast d _gcpointer _intptr))))
;; test multi-dimension arrays
(let ([_t (_array _int 20 10 5)])
(define ar (ptr-ref (malloc _t) _t))
(define (t n)
(test (void) array-set! ar 19 9 4 n)
(test n array-ref ar 19 9 4))
(for-each t '(1 2 3)))
(delete-test-files) (delete-test-files)
(report-errs) (report-errs)