Merge pull request #815 from hellerve/veit/fix-776

Make Array.range safe
This commit is contained in:
Erik Svedäng 2020-05-26 20:55:16 +02:00 committed by GitHub
commit bbb7920332
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 90 additions and 41 deletions

View File

@ -216,20 +216,6 @@ If the element is not found, returns `Nothing`")
(aset! a i y)
(aset! a j x)))
; cannot use for, because we want also be able to go downwards
(doc range "creates an array from `start` to `end` with `step` between them (the elements must support `<`, `<=`, `>=`, and `to-int`).")
(defn range [start end step]
(let-do [x (allocate (Int.inc (Int.abs (to-int (/ (- end start) step)))))
e start
i 0
op (if (< start end) <= >=)]
(while (op e end)
(do
(aset! &x i e)
(set! i (Int.inc i))
(set! e (+ e step))))
x))
(doc repeat "repeats the function `f` `n` times and stores the results in an array.")
(defn repeat [n f]
(let-do [a (allocate n)]

31
core/ArrayExt.carp Normal file
View File

@ -0,0 +1,31 @@
; we extend the array module, now that we have strings
(defmodule Array
(doc range "creates an array from `start` to `end` with `step` between them
(the elements must support `<`, `<=`, `>=`, and `to-int`).
It returns a `Result.Success` if the input was right, and a `Result.Error` if
the input given was wrong, containing an error message.")
(defn range [start end step]
(cond
(= step (zero))
(Result.Error @"`Array.range` cannot be called with step size `0`.")
(and (< start end) (< step (zero)))
(Result.Error @"`Array.range` cannot be called with a step size `< 0` and `start < end`.")
(and (> start end) (> step (zero)))
(Result.Error @"`Array.range` cannot be called with a step size `> 0` and `start > end`.")
(let-do [x (allocate (Int.inc (Int.abs (to-int (/ (- end start) step)))))
e start
i 0
op (if (< start end) <= >=)]
(while (op e end)
(do
(aset! &x i e)
(set! i (Int.inc i))
(set! e (+ e step))))
(Result.Success x))))
(doc range-or-default "is a version of [`range`](#range) that returns an empty
array on failure.")
(defn range-or-default [start end step]
(Result.from-success (range start end step) []))
)

View File

@ -36,6 +36,7 @@
(load-once "Array.carp")
(load-once "Char.carp")
(load-once "String.carp")
(load-once "ArrayExt.carp")
(load-once "StdInt.carp")
(load-once "System.carp")
(load-once "IO.carp")

View File

@ -967,13 +967,37 @@ For example:
defn
</div>
<p class="sig">
(Fn [a, a, a] (Array a))
(Fn [a, a, a] (Result (Array a) String))
</p>
<pre class="args">
(range start end step)
</pre>
<p class="doc">
<p>creates an array from <code>start</code> to <code>end</code> with <code>step</code> between them (the elements must support <code>&lt;</code>, <code>&lt;=</code>, <code>&gt;=</code>, and <code>to-int</code>).</p>
<p>creates an array from <code>start</code> to <code>end</code> with <code>step</code> between them
(the elements must support <code>&lt;</code>, <code>&lt;=</code>, <code>&gt;=</code>, and <code>to-int</code>).</p>
<p>It returns a <code>Result.Success</code> if the input was right, and a <code>Result.Error</code> if
the input given was wrong, containing an error message.</p>
</p>
</div>
<div class="binder">
<a class="anchor" href="#range-or-default">
<h3 id="range-or-default">
range-or-default
</h3>
</a>
<div class="description">
defn
</div>
<p class="sig">
(Fn [a, a, a] (Array a))
</p>
<pre class="args">
(range-or-default start end step)
</pre>
<p class="doc">
<p>is a version of <a href="#range"><code>range</code></a> that returns an empty
array on failure.</p>
</p>
</div>

View File

@ -45,7 +45,7 @@
ff2 @&ff1
to-copy @to
upper (to-copy)]
(endo-map &(fn [x] (Int.pow x exponent)) (range 0 upper 1))))
(endo-map &(fn [x] (Int.pow x exponent)) (range-or-default 0 upper 1))))
(defn twenty [] 20)

View File

@ -1,7 +1,5 @@
(use Array)
(load "Test.carp")
(use Test)
(use-all Array Test Result)
(defn nested []
[[1 2 3]
@ -16,7 +14,7 @@
(defn make-zero [] 0)
(defn make-idx [i] i)
(def a (range 0 9 1))
(def a (range-or-default 0 9 1))
(def b (Array.replicate 5 "Hi"))
(deftest test
@ -75,11 +73,11 @@
"reverse works as expected")
(assert-ref-equal test
(Maybe.Just 10)
(maximum &(range 1 10 1))
(maximum &(unsafe-from-success (range 1 10 1)))
"maximum works as expected")
(assert-ref-equal test
(Maybe.Just 1)
(minimum &(range 1 10 1))
(minimum &(range-or-default 1 10 1))
"minimum works as expected")
(assert-ref-equal test
(Maybe.Just (Pair.init 2 1))
@ -98,19 +96,19 @@
"index-of works as expected when element is not in the array")
(assert-equal test
55
(sum &(range 1 10 1))
(sum &(range-or-default 1 10 1))
"sum works as expected")
(assert-ref-equal test
[2 3]
(slice &(range 1 10 1) 1 3)
(slice &(range-or-default 1 10 1) 1 3)
"slice works as expected")
(assert-ref-equal test
[1 2 3]
(prefix &(range 1 10 1) 3)
(prefix &(range-or-default 1 10 1) 3)
"prefix works as expected")
(assert-ref-equal test
[8 9 10]
(suffix &(range 1 10 1) 7)
(suffix &(range-or-default 1 10 1) 7)
"suffix works as expected")
(assert-nothing test
&(nth &a 100)
@ -128,25 +126,34 @@
(unsafe-nth &(nested) 0)
"unsafe-nth works as expected")
(assert-ref-equal test
[10 11 12 13 14 15]
(Success [10 11 12 13 14 15])
(range 10 15 1)
"range works as expected")
(assert-ref-equal test
[10.0 10.5 11.0 11.5 12.0]
(Success [10.0 10.5 11.0 11.5 12.0])
(range 10.0 12.0 0.5)
"range works as expected on non-integers")
(assert-ref-equal test
[10 9 8 7 6 5 4 3 2 1 0]
(Success [10 9 8 7 6 5 4 3 2 1 0])
(range 10 0 -1)
"range backwards works as expected")
(assert-ref-equal test
[1 3 5 7 9]
(Success [1 3 5 7 9])
(range 1 10 2)
"range works as expected if we dont exactly hit")
(assert-ref-equal test
[10 8 6 4 2]
(Success [10 8 6 4 2])
(range 10 1 -2)
"range backwards works as expected if we dont exactly hit")
(assert-error test
&(range 10 1 2)
"range backwards works as expected if we go forwards instead")
(assert-error test
&(range 1 10 -2)
"range forwards works as expected if we go backwarss instead")
(assert-error test
&(range 10 1 0)
"range works as expected if we use a step size of 0")
(assert-ref-equal test
[@"Hi!" @"Hi!" @"Hi!" @"Hi!" @"Hi!"]
(copy-map &excl-ref &b)
@ -237,7 +244,7 @@
"Array.pop-back! works as expected"))
(assert-ref-equal test
[1 2 3 4 5 6 7 8 9]
(sort (range 9 1 -1))
(sort (range-or-default 9 1 -1))
"sort works as expected")
(let-do [arr [3 2 5]
exp [2 3 5]]
@ -257,23 +264,23 @@
(empty? &[1])
"empty? works as expected II")
(assert-true test
(any? &(fn [x] (= 0 @x)) &(range 0 10 1))
(any? &(fn [x] (= 0 @x)) &(range-or-default 0 10 1))
"any? works as expected I")
(assert-false test
(any? &(fn [x] (= 0 @x)) &(range 1 10 1))
(any? &(fn [x] (= 0 @x)) &(range-or-default 1 10 1))
"any? works as expected II")
(assert-true test
(all? &(fn [x] (< 0 @x)) &(range 1 10 1))
(all? &(fn [x] (< 0 @x)) &(range-or-default 1 10 1))
"all? works as expected I")
(assert-false test
(all? &(fn [x] (= 0 @x)) &(range 10 1 -1))
(all? &(fn [x] (= 0 @x)) &(range-or-default 10 1 -1))
"all? works as expected II")
(assert-ref-equal test
(Maybe.Just 3)
(find &(fn [x] (= 3 @x)) &(range 1 10 1))
(find &(fn [x] (= 3 @x)) &(range-or-default 1 10 1))
"find works as expected I")
(assert-nothing test
&(find &(fn [x] (= 0 @x)) &(range 1 10 1))
&(find &(fn [x] (= 0 @x)) &(range-or-default 1 10 1))
"find works as expected II")
(assert-nothing test
&(find-index &(fn [i] (Int.even? @i)) &[1 3 5])

View File

@ -224,7 +224,7 @@
; minimal case from bug #343
(let-do [arr [20 0 10 21 11 1 2 22 12 24 23 13 3 14 4 25 5 15 16 6 17 7 8 18 19 9]
exp (Array.range 0 25 1)]
exp (Array.range-or-default 0 25 1)]
(Array.sort! &arr)
(assert-equal test
&exp

View File

@ -284,7 +284,7 @@
(assert (= &[@"c" @"b" @"a"] &xs)))))
(defn array-range []
(let [xs (Array.range 0 5 1)]
(let [xs (Array.range-or-default 0 5 1)]
(assert (= &[0 1 2 3 4 5] &xs))))
(defmodule ArrayCompareExtension