Fix some errors with in-vector and derived forms:

- Range checking was inconsistent between the sequence and macro forms
- The macro form could crash due to unsafe vector refs

Fixes involved refactoring the range checks so they are shared between both versions, and changing the contract slightly so start and stop are checked before the sequence runs. This allows unsafe vector refs and earlier error notifications at the cost making some valid programs (e.g. those using some condition to stop a comprehension hitting an invalid index) now be invalid. Only crazy people would rely on the old behaviour, so it isn't a problem in practice.

collects/racket/fixnum.rkt

@@ -1,7 +1,9 @@
 #lang scheme/base
+
 (require '#%flfxnum
          "private/vector-wraps.rkt"
-         "unsafe/ops.rkt")
+         "unsafe/ops.rkt"
+         (for-syntax racket/base))
 
 (provide fx->fl fl->fx
          fxabs

collects/racket/flonum.rkt

@@ -1,7 +1,9 @@
 #lang racket/base
+
 (require '#%flfxnum 
          "private/vector-wraps.rkt"
-         "unsafe/ops.rkt")
+         "unsafe/ops.rkt"
+         (for-syntax racket/base))
 
 (provide fl+ fl- fl* fl/
          flabs flsqrt flexp fllog

collects/racket/private/for.rkt

@@ -64,7 +64,10 @@
 
              define-in-vector-like
              define-:vector-like-gen
-             (for-syntax make-in-vector-like))
+             (for-syntax make-in-vector-like)
+
+             normalise-inputs ;; Only exported to get around certificate problem
+             )
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; sequence transformers:
@@ -480,10 +483,16 @@
 
   ;; Vector-like sequences --------------------------------------------------
 
-  ;; (: check-ranges (Symbol Natural Natural Integer -> Void))
+  ;; (: check-ranges (Symbol Natural Integer Integer Natural -> Void))
-  (define (check-ranges who start stop step)
+  ;;
-    (unless (exact-nonnegative-integer? start) (raise-type-error who "exact non-negative integer" start))
+  ;; As no object can have more slots than can be indexed by
-    (unless (exact-nonnegative-integer? stop) (raise-type-error who "exact non-negative integer or #f" stop))
+  ;; the largest fixnum, after running these checks start,
+  ;; stop, and step are guaranteed to be fixnums.
+  (define (check-ranges who start stop step len)
+    (unless (and (exact-nonnegative-integer? start) (< start len))
+      (raise-type-error who (format "exact non-negative integer in [0,~a)" len) start))
+    (unless (and (integer? stop) (<= -1 stop) (<= stop len))
+      (raise-type-error who (format "exact integer in [-1,~a] or #f" len) stop))
     (unless (and (exact-integer? step) (not (zero? step)))
       (raise-type-error who "exact non-zero integer" step))
     (when (and (< start stop) (< step 0))
@@ -495,6 +504,20 @@
                                         start stop)
                             step)))
 
+  ;; (: normalise-inputs (A) (Symbol String (Any -> Boolean) (A -> Natural) Any Any Any Any -> (values Fixnum Fixnum Fixnum)))
+  ;;
+  ;; Checks all inputs are valid for an in-vector sequence,
+  ;; and if so returns the vector, start, stop, and
+  ;; step. Start, stop, and step are guaranteed to be Fixnum
+  (define (normalise-inputs who type-name vector? unsafe-vector-length
+                            vec start stop step)
+    (unless (vector? vec)
+      (raise-type-error who type-name vec))
+    (let* ([len (unsafe-vector-length vec)]
+           [stop* (if stop stop len)])
+      (check-ranges who start stop* step len)
+      (values vec start stop* step)))
+  
   (define-syntax define-in-vector-like
     (syntax-rules ()
       [(define-in-vector-like in-vector-name
@@ -505,9 +528,9 @@
           [(v start) (in-vector-name v start #f 1)]
           [(v start stop) (in-vector-name v start stop 1)]
           [(v start stop step)
-           (unless (vector?-id v) (raise-type-error (quote in-vector-name) type-name-str v))
+           (let-values (([v start stop step]
-           (let ([stop (or stop (vector-length-id v))])
+                         (normalise-inputs in-vector-name type-name-str vector?-id vector-length-id
-             (check-ranges (quote in-vector-name) start stop step)
+                                          v start stop step)))
              (make-do-sequence (lambda () (:vector-gen-id v start stop step))))]))]))
 
   (define-syntax define-:vector-like-gen
@@ -529,12 +552,16 @@
           void
           void))]))
 
-  (define-for-syntax (make-in-vector-like vector?-id
+  (define-for-syntax (make-in-vector-like in-vector-name
+                                          type-name-str
+                                          vector?-id
                                           unsafe-vector-length-id
                                           in-vector-id
                                           unsafe-vector-ref-id)
      (define (in-vector-like stx)
-       (with-syntax ([vector? vector?-id]
+       (with-syntax ([in-vector-name in-vector-name]
+                     [type-name type-name-str]
+                     [vector? vector?-id]
                      [in-vector in-vector-id]
                      [unsafe-vector-length unsafe-vector-length-id]
                      [unsafe-vector-ref unsafe-vector-ref-id])
@@ -572,24 +599,12 @@
               #`[(id)
                  (:do-in
                   ;; Outer bindings
-                  ;; Prevent multiple evaluation
+                  ;; start*, stop*, and step* are guaranteed to be exact integers
-                  ([(v* stop*) (let ([vec vec-expr]
+                  ([(v* start* stop* step*)
-                                     [stop* stop])
+                    (normalise-inputs (quote in-vector-name) type-name
-                                 (if (and (not stop*) (vector? vec))
+                                      vector? unsafe-vector-length vec-expr start stop step)])
-                                     (values vec (unsafe-vector-length vec))
+                  ;; Outer check is done by normalise-inputs
-                                     (values vec stop*)))]
+                  #t
-                   [(start*) start]
-                   [(step*) step])
-                  ;; Outer check
-                  (when (or (not (vector? v*))
-                            (not (exact-integer? start*))
-                            (not (exact-integer? stop*))
-                            (not (exact-integer? step*))
-                            (zero? step*)
-                            (and (< start* stop*) (< step* 0))
-                            (and (> start* stop*) (> step* 0)))
-                    ;; Let in-vector report the error
-                    (in-vector v* start* stop* step*))
                   ;; Loop bindings
                   ([idx start*])
                   ;; Pos guard
@@ -623,7 +638,9 @@
 
   (define-sequence-syntax *in-vector
     (lambda () #'in-vector)
-    (make-in-vector-like #'vector?
+    (make-in-vector-like 'in-vector
+                         "vector"
+                         #'vector?
                          #'unsafe-vector-length
                          #'in-vector
                          #'unsafe-vector-ref))
@@ -636,7 +653,9 @@
 
   (define-sequence-syntax *in-string
     (lambda () #'in-string)
-    (make-in-vector-like #'string?
+    (make-in-vector-like 'in-string
+                         "string"
+                         #'string?
                          #'string-length
                          #'in-string
                          #'string-ref))
@@ -649,7 +668,9 @@
 
   (define-sequence-syntax *in-bytes
     (lambda () #'in-bytes)
-    (make-in-vector-like #'bytes?
+    (make-in-vector-like 'in-bytes
+                         "bytes"
+                         #'bytes?
                          #'bytes-length
                          #'in-bytes
                          #'bytes-ref))

collects/racket/private/vector-wraps.rkt

@@ -1,4 +1,5 @@
 #lang racket/base
+
 (require '#%flfxnum
          (for-syntax racket/base))
 
@@ -22,7 +23,9 @@
 
      (define-sequence-syntax in-fXvector
        (lambda () #'in-fXvector*)
-       (make-in-vector-like #'fXvector?
+       (make-in-vector-like 'in-fXvector
+                            fXvector-str
+                            #'fXvector?
                             #'unsafe-fXvector-length
                             #'in-fXvector*
                             #'unsafe-fXvector-ref))

collects/racket/vector.rkt

@@ -208,7 +208,9 @@
   (let ([init-min-var (f (unsafe-vector-ref xs 0))])
     (unless (real? init-min-var)
       (raise-type-error name "procedure that returns real numbers" f))
-    (let-values ([(min* min-var*)
+    (if (unsafe-fx= (unsafe-vector-length xs) 1)
+        (unsafe-vector-ref xs 0)
+        (let-values ([(min* min-var*)
                   (for/fold ([min (unsafe-vector-ref xs 0)]
                              [min-var init-min-var])
                       ([e (in-vector xs 1)])
@@ -219,7 +221,7 @@
                       (cond [(cmp new-min min-var)
                              (values e new-min)]
                             [else (values min min-var)])))])
-      min*)))
+      min*))))
 
 (define (vector-argmin f xs) (mk-min < 'vector-argmin f xs))
 (define (vector-argmax f xs) (mk-min > 'vector-argmax f xs))

collects/scribblings/reference/fixnums.scrbl

@@ -157,29 +157,14 @@ elements of @racket[vec] from @racket[start] (inclusive) to
 
 @defproc[(in-fxvector [vec fxvector?]
                     [start exact-nonnegative-integer? 0]
-                    [stop (or/c exact-nonnegative-integer? #f) #f]
+                    [stop (or/c exact-integer? #f) #f]
                     [step (and/c exact-integer? (not/c zero?)) 1])
          sequence?]{
   Returns a sequence equivalent to @racket[vec] when no optional
   arguments are supplied.
 
   The optional arguments @racket[start], @racket[stop], and
-  @racket[step] are analogous to @racket[in-range], except that a
+  @racket[step] are as in @racket[in-vector].
-  @racket[#f] value for @racket[stop] is equivalent to
-  @racket[(vector-length vec)].  That is, the first element in the
-  sequence is @racket[(vector-ref vec start)], and each successive
-  element is generated by adding @racket[step] to index of the previous
-  element.  The sequence stops before an index that would be greater or
-  equal to @racket[end] if @racket[step] is non-negative, or less or
-  equal to @racket[end] if @racket[step] is negative.
-
-  If @racket[start] is less than @racket[stop] and @racket[step] is
-  negative, then the @exnraise[exn:fail:contract:mismatch].  Similarly,
-  if @racket[start] is more than @racket[stop] and @racket[step] is
-  positive, then the @exnraise[exn:fail:contract:mismatch].  The
-  @racket[start] and @racket[stop] values are @emph{not} checked against
-  the size of @racket[vec], so access can fail when an element is
-  demanded from the sequence.
 
   An @racket[in-fxvector] application can provide better
   performance for @tech{fxvector} iteration when it appears directly in a @racket[for] clause.

collects/scribblings/reference/flonums.scrbl

@@ -174,31 +174,16 @@ elements of @racket[vec] from @racket[start] (inclusive) to
 
 @defproc[(in-flvector [vec flvector?]
                     [start exact-nonnegative-integer? 0]
-                    [stop (or/c exact-nonnegative-integer? #f) #f]
+                    [stop (or/c exact-integer? #f) #f]
                     [step (and/c exact-integer? (not/c zero?)) 1])
          sequence?]{
   Returns a sequence equivalent to @racket[vec] when no optional
   arguments are supplied.
 
   The optional arguments @racket[start], @racket[stop], and
-  @racket[step] are analogous to @racket[in-range], except that a
+  @racket[step] are as in @racket[in-vector].
-  @racket[#f] value for @racket[stop] is equivalent to
-  @racket[(vector-length vec)].  That is, the first element in the
-  sequence is @racket[(vector-ref vec start)], and each successive
-  element is generated by adding @racket[step] to index of the previous
-  element.  The sequence stops before an index that would be greater or
-  equal to @racket[end] if @racket[step] is non-negative, or less or
-  equal to @racket[end] if @racket[step] is negative.
 
-  If @racket[start] is less than @racket[stop] and @racket[step] is
+  A @racket[in-flvector] application can provide better
-  negative, then the @exnraise[exn:fail:contract:mismatch].  Similarly,
-  if @racket[start] is more than @racket[stop] and @racket[step] is
-  positive, then the @exnraise[exn:fail:contract:mismatch].  The
-  @racket[start] and @racket[stop] values are @emph{not} checked against
-  the size of @racket[vec], so access can fail when an element is
-  demanded from the sequence.
-
-  An @racket[in-flvector] application can provide better
   performance for @tech{flvector} iteration when it appears directly in a @racket[for] clause.
 }
 

collects/scribblings/reference/sequences.scrbl

@@ -96,7 +96,7 @@ in the sequence.
 
 @defproc[(in-vector [vec vector?]
                     [start exact-nonnegative-integer? 0]
-                    [stop (or/c exact-nonnegative-integer? #f) #f]
+                    [stop (or/c exact-integer? #f) #f]
                     [step (and/c exact-integer? (not/c zero?)) 1])
          sequence?]{
   Returns a sequence equivalent to @scheme[vec] when no optional
@@ -114,19 +114,18 @@ in the sequence.
   equal to @scheme[end] if @scheme[step] is non-negative, or less or
   equal to @scheme[end] if @scheme[step] is negative.
 
+  If @racket[start] is not a valid index, or @racket[stop]
+  is not in [-1, @racket[(vector-length vec)]] then the @exnraise[exn:fail:contract].
   If @scheme[start] is less than @scheme[stop] and @scheme[step] is
   negative, then the @exnraise[exn:fail:contract:mismatch].  Similarly,
   if @scheme[start] is more than @scheme[stop] and @scheme[step] is
-  positive, then the @exnraise[exn:fail:contract:mismatch].  The
+  positive, then the @exnraise[exn:fail:contract:mismatch].
-  @scheme[start] and @scheme[stop] values are @emph{not} checked against
-  the size of @scheme[vec], so access can fail when an element is
-  demanded from the sequence.
 
   @speed[in-vector "vector"]}
 
 @defproc[(in-string [str string?]
                     [start exact-nonnegative-integer? 0]
-                    [stop (or/c exact-nonnegative-integer? #f) #f]
+                    [stop (or/c exact-integer? #f) #f]
                     [step (and/c exact-integer? (not/c zero?)) 1])
          sequence?]{
   Returns a sequence equivalent to @scheme[str] when no optional
@@ -141,7 +140,7 @@ in the sequence.
 
 @defproc[(in-bytes [bstr bytes?]
                    [start exact-nonnegative-integer? 0]
-                   [stop (or/c exact-nonnegative-integer? #f) #f]
+                   [stop (or/c exact-integer? #f) #f]
                    [step (and/c exact-integer? (not/c zero?)) 1])
          sequence?]{
   Returns a sequence equivalent to @scheme[bstr] when no optional

collects/tests/racket/for.rktl

@@ -24,6 +24,10 @@
 (test-generator [(h f d)] (in-vector #(a b c d e f g h) 7 1 -2))
 (test-generator [(b d f)] (in-vector #(a b c d e f g h) 1 6 2))
 (test-generator [(h f d)] (in-vector #(a b c d e f g h) 7 2 -2))
+(test-generator [(c b a)] (in-vector #(a b c) 2 -1 -1))
+;; Test indices out of bounds
+(err/rt-test (for/list ([x (in-vector #(a b c d) 0 6 2)]) x) exn:fail:contract?)
+(err/rt-test (for/list ([x (in-vector #(a b c d) 6 0 -2)]) x) exn:fail:contract?)
 (test-generator [(#\a #\b #\c)] "abc")
 (test-generator [(#\a #\u3bb #\c)] "a\u03BBc")
 (test-generator [(#\a #\b #\c)] (in-string "abc"))