Skip to content

Commit 02f2546

Browse files
konsumlammandrewthad
konsumlamm
authored and
andrewthad
committed
Fix setPrimArray for Float & Double
Add tests for `Float` & `Double`
1 parent 8ef2945 commit 02f2546

2 files changed

Lines changed: 42 additions & 28 deletions

File tree

‎cbits/primitive-memops.c‎

Lines changed: 28 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
#include <math.h>
12
#include <string.h>
23
#include "primitive-memops.h"
34

@@ -11,28 +12,32 @@ void hsprimitive_memmove( void *dst, ptrdiff_t doff, void *src, ptrdiff_t soff,
1112
memmove( (char *)dst + doff, (char *)src + soff, len );
1213
}
1314

14-
#define MEMSET(TYPE, ATYPE) \
15+
#define MEMSET(TYPE, ATYPE) \
1516
void hsprimitive_memset_ ## TYPE (Hs ## TYPE *p, ptrdiff_t off, size_t n, ATYPE x) \
16-
{ \
17-
p += off; \
18-
if (x == 0) \
19-
memset(p, 0, n * sizeof(Hs ## TYPE)); \
20-
else if (sizeof(Hs ## TYPE) == sizeof(int)*2) { \
21-
int *q = (int *)p; \
22-
const int *r = (const int *)(void *)&x; \
23-
while (n>0) { \
24-
q[0] = r[0]; \
25-
q[1] = r[1]; \
26-
q += 2; \
27-
--n; \
28-
} \
29-
} \
30-
else { \
31-
while (n>0) { \
32-
*p++ = x; \
33-
--n; \
34-
} \
35-
} \
17+
{ \
18+
p += off; \
19+
if (x == 0) { \
20+
memset(p, 0, n * sizeof(Hs ## TYPE)); \
21+
} else { \
22+
while (n > 0) { \
23+
*p++ = x; \
24+
--n; \
25+
} \
26+
} \
27+
}
28+
29+
#define MEMSET_FLOAT(TYPE, ATYPE) \
30+
void hsprimitive_memset_ ## TYPE (Hs ## TYPE *p, ptrdiff_t off, size_t n, ATYPE x) \
31+
{ \
32+
p += off; \
33+
if (x == 0.0 && !signbit(x)) \
34+
memset(p, 0, n * sizeof(Hs ## TYPE)); \
35+
else { \
36+
while (n > 0) { \
37+
*p++ = x; \
38+
--n; \
39+
} \
40+
} \
3641
}
3742

3843
int hsprimitive_memcmp( HsWord8 *s1, HsWord8 *s2, size_t n )
@@ -56,6 +61,6 @@ MEMSET(Word32, HsWord32)
5661
MEMSET(Word64, HsWord64)
5762
MEMSET(Word, HsWord)
5863
MEMSET(Ptr, HsPtr)
59-
MEMSET(Float, HsFloat)
60-
MEMSET(Double, HsDouble)
64+
MEMSET_FLOAT(Float, HsFloat)
65+
MEMSET_FLOAT(Double, HsDouble)
6166
MEMSET(Char, HsChar)

‎test/Main.hs‎

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,10 @@ main = do
110110
, TQC.testProperty "Word32" (setByteArrayProp (Proxy :: Proxy Word32))
111111
, TQC.testProperty "Word64" (setByteArrayProp (Proxy :: Proxy Word64))
112112
, TQC.testProperty "Word" (setByteArrayProp (Proxy :: Proxy Word))
113+
, TQC.testProperty "Float" (setByteArrayProp (Proxy :: Proxy Float))
114+
, TQC.testProperty "Double" (setByteArrayProp (Proxy :: Proxy Double))
115+
, TQC.testProperty "Float -0.0" (\n off len -> setByteArrayTest (Proxy :: Proxy Float) n off len 0.0 (-0.0))
116+
, TQC.testProperty "Double -0.0" (\n off len -> setByteArrayTest (Proxy :: Proxy Double) n off len 0.0 (-0.0))
113117
]
114118
]
115119
, testGroup "Resize"
@@ -175,6 +179,8 @@ main = do
175179
, renameLawsToTest "Int16" (primLaws (Proxy :: Proxy Int16))
176180
, renameLawsToTest "Int32" (primLaws (Proxy :: Proxy Int32))
177181
, renameLawsToTest "Int64" (primLaws (Proxy :: Proxy Int64))
182+
, renameLawsToTest "Float" (primLaws (Proxy :: Proxy Float))
183+
, renameLawsToTest "Double" (primLaws (Proxy :: Proxy Double))
178184
, renameLawsToTest "Const" (primLaws (Proxy :: Proxy (Const Int16 Int16)))
179185
, renameLawsToTest "Down" (primLaws (Proxy :: Proxy (Down Int16)))
180186
, renameLawsToTest "Identity" (primLaws (Proxy :: Proxy (Identity Int16)))
@@ -207,22 +213,25 @@ int32 :: Proxy Int32
207213
int32 = Proxy
208214

209215

210-
setByteArrayProp :: forall a. (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> QC.Property
211-
setByteArrayProp _ = QC.property $ \(QC.NonNegative (n :: Int)) (QC.NonNegative (off :: Int)) (QC.NonNegative (len :: Int)) (x :: a) (y :: a) ->
216+
setByteArrayProp :: (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> QC.Property
217+
setByteArrayProp p = QC.property (setByteArrayTest p)
218+
219+
setByteArrayTest :: (Prim a, Eq a, Arbitrary a, Show a) => Proxy a -> QC.NonNegative Int -> QC.NonNegative Int -> QC.NonNegative Int -> a -> a -> QC.Property
220+
setByteArrayTest _ (QC.NonNegative (n :: Int)) (QC.NonNegative (off :: Int)) (QC.NonNegative (len :: Int)) (x :: a) (y :: a) =
212221
(off < n && off + len <= n) ==>
213222
-- We use PrimArray in this test because it makes it easier to
214223
-- get the element-vs-byte distinction right.
215-
let actual = runST $ do
224+
let !(PrimArray actual) = runST $ do
216225
m <- newPrimArray n
217226
forM_ (enumFromTo 0 (n - 1)) $ \ix -> writePrimArray m ix x
218227
setPrimArray m off len y
219228
unsafeFreezePrimArray m
220-
expected = runST $ do
229+
!(PrimArray expected) = runST $ do
221230
m <- newPrimArray n
222231
forM_ (enumFromTo 0 (n - 1)) $ \ix -> writePrimArray m ix x
223232
forM_ (enumFromTo off (off + len - 1)) $ \ix -> writePrimArray m ix y
224233
unsafeFreezePrimArray m
225-
in expected === actual
234+
in ByteArray expected === ByteArray actual -- compare as ByteArray, so that actual bytes are compared
226235

227236

228237
-- Tests that using resizeByteArray to shrink a byte array produces

0 commit comments

Comments
 (0)