racket/sequence: fix `sequence-ref' for a too-large index

This commit is contained in:
Matthew Flatt 2013-04-25 16:45:38 -06:00
parent d977a2c65d
commit 0f47ec4af7
2 changed files with 17 additions and 10 deletions

View File

@ -41,16 +41,19 @@
(unless (sequence? s) (raise-argument-error 'sequence-ref "sequence?" s)) (unless (sequence? s) (raise-argument-error 'sequence-ref "sequence?" s))
(unless (exact-nonnegative-integer? i) (unless (exact-nonnegative-integer? i)
(raise-argument-error 'sequence-ref "exact-nonnegative-integer?" i)) (raise-argument-error 'sequence-ref "exact-nonnegative-integer?" i))
(let ([v (for/fold ([c #f]) ([v (in-values-sequence s)] (let ([v (for/fold ([c #f]) ([v (in-values*-sequence s)]
[i (in-range (add1 i))]) [j (in-range (add1 i))]
v)]) #:unless (j . < . i))
(if (list? v) (or v '(#f)))])
(apply values v) (cond
[(not v)
(raise-arguments-error (raise-arguments-error
'sequence-ref 'sequence-ref
"sequence ended before index" "sequence ended before index"
"index" (add1 i) "index" i
"sequence" s)))) "sequence" s)]
[(list? v) (apply values v)]
[else v])))
(define (sequence-tail seq i) (define (sequence-tail seq i)
(unless (sequence? seq) (raise-argument-error 'sequence-tail "sequence?" seq)) (unless (sequence? seq) (raise-argument-error 'sequence-tail "sequence?" seq))

View File

@ -43,8 +43,12 @@
(test 0 'sequence-ref (sequence-ref (in-naturals) 0)) (test 0 'sequence-ref (sequence-ref (in-naturals) 0))
(test 1 'sequence-ref (sequence-ref (in-naturals) 1)) (test 1 'sequence-ref (sequence-ref (in-naturals) 1))
(test 25 'sequence-ref (sequence-ref (in-naturals) 25)) (test 25 'sequence-ref (sequence-ref (in-naturals) 25))
(test #f 'sequence-ref (sequence-ref '(#t #t #f) 2))
(when (sequence? 10) (when (sequence? 10)
(test 3 sequence-ref 10 3)) (test 3 sequence-ref 10 3))
(when (sequence? #hash())
(test-values '(a "a") (lambda () (sequence-ref (in-hash #hash((a . "a"))) 0))))
(err/rt-test (sequence-ref (in-string "a") 2) exn:fail?)
(arity-test sequence-tail 2 2) (arity-test sequence-tail 2 2)
(err/rt-test (sequence-tail (in-naturals) -1) exn:fail?) (err/rt-test (sequence-tail (in-naturals) -1) exn:fail?)