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

fix `for/flvector', etc. unsafety

Browse Source 
Closes PR 13675

Merge to v5.3.4
(cherry picked from commit 8b5523bd10)
This commit is contained in:
Matthew Flatt 2013-04-08 17:45:02 -06:00 committed by Ryan Culpepper
parent 547bb7a56e
commit 8818f8af68
3 changed files with 16 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/private/vector-wraps.rkt
View File

@ -67,7 +67,7 @@
(let ([new-vec (if (eq? i (unsafe-fXvector-length vec))
(grow-fXvector vec)
vec)])
(unsafe-fXvector-set! new-vec i (let () last-body ...))
(fXvector-set! new-vec i (let () last-body ...))
(values new-vec (unsafe-fx+ i 1))))])
(shrink-fXvector vec i))))]
[(for*/fXvector #:length length-expr #:fill fill-expr (for-clause ...) body ...)

8
collects/tests/racket/fixnum.rktl
View File

@ -215,4 +215,12 @@
(test-sequence [(2 4 6)] (in-fxvector (fxvector 1 2 3 4 5 6 7 8) 1 6 2))
(test-sequence [(8 6 4)] (in-fxvector (fxvector 1 2 3 4 5 6 7 8) 7 2 -2))
;; Check safety:
(err/rt-test (for/fxvector ([i 5]) 8.0))
(err/rt-test (for/fxvector #:length 5 ([i 5]) 8.0))
(err/rt-test (for/fxvector #:length 5 #:fill 0 ([i 5]) 8.0))
(err/rt-test (for/fxvector #:length 5 #:fill 0.0 ([i 5]) 8))
(err/rt-test (for/fxvector #:length 10 #:fill 0.0 ([i 5]) 8))
(report-errs)

7
collects/tests/racket/flonum.rktl
View File

@ -157,6 +157,13 @@
(test-sequence [(2.0 4.0 6.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 1 6 2))
(test-sequence [(8.0 6.0 4.0)] (in-flvector (flvector 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0) 7 2 -2))
;; Check safety:
(err/rt-test (for/flvector ([i 5]) 8))
(err/rt-test (for/flvector #:length 5 ([i 5]) 8))
(err/rt-test (for/flvector #:length 5 #:fill 0.0 ([i 5]) 8))
(err/rt-test (for/flvector #:length 5 #:fill 0 ([i 5]) 8.0))
(err/rt-test (for/flvector #:length 10 #:fill 0 ([i 5]) 8.0))
;; ----------------------------------------
;; Check corners of `flexpt':
;; Tests by Neil T.: