5240fe5 · streamly · git.iko.soy

git.iko.soy/streamly

add array test cases

commit5240fe541f921d7cd683754943efc8ab570d55ab authorHarendra Kumar <harendra.kumar@gmail.com> dateFri 10 May 2019, 13:36 (7 years ago) parentfd7bd71

5 files changed+100−40

compare with master

unifiedsplit

Changelog.md+1−1 src/Streamly/Array/Types.hs+19−17 streamly.cabal+1−1 test/Arrays.hs+71−16 test/Prop.hs+8−5

Changelog.md+1−1

@@ -14,7 +14,7 @@

1414* Add the following to "Streamly.Prelude":

1515 * `foldrS` to fold a stream to a stream

1616 * `foldrT` to fold a stream to an arbitrary transformer monad

17− * `toRevList` to fold a stream to a reverse list

17+ * `reverse'` a several times faster reverse using Storable instance

1818

1919### Deprecations

2020

src/Streamly/Array/Types.hs+19−17

@@ -388,63 +388,65 @@ fromStreamDArraysOf n str = D.groupsOf n (toArrayN n) str

388388

389389-- XXX concatMap does not seem to have the best possible performance so we have

390390-- a custom way to concat arrays.

391−data CAState s a = CAParent s | CANested s (ForeignPtr a) (Ptr a) (Ptr a)

391+data FlattenState s a =

392+ OuterLoop s

393+ | InnerLoop s (ForeignPtr a) (Ptr a) (Ptr a)

392394

393395{-# INLINE_NORMAL flattenArrays #-}

394396flattenArrays :: forall m a. (Monad m, Storable a)

395397 => D.Stream m (Array a) -> D.Stream m a

396−flattenArrays (D.Stream step state) = D.Stream step' (CAParent state)

398+flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)

397399

398400 where

399401

400402 {-# INLINE_LATE step' #-}

401− step' gst (CAParent st) = do

403+ step' gst (OuterLoop st) = do

402404 r <- step (adaptState gst) st

403405 return $ case r of

404406 D.Yield Array{..} s ->

405407 let p = unsafeForeignPtrToPtr aStart

406− in D.Skip (CANested s aStart p aEnd)

407− D.Skip s -> D.Skip (CAParent s)

408+ in D.Skip (InnerLoop s aStart p aEnd)

409+ D.Skip s -> D.Skip (OuterLoop s)

408410 D.Stop -> D.Stop

409411

410− step' _ (CANested st _ p end) | p == end =

411− return $ D.Skip $ CAParent st

412+ step' _ (InnerLoop st _ p end) | p == end =

413+ return $ D.Skip $ OuterLoop st

412414

413− step' _ (CANested st startf p end) = do

415+ step' _ (InnerLoop st startf p end) = do

414416 let !x = unsafeInlineIO $ do

415417 r <- peek p

416418 touchForeignPtr startf

417419 return r

418− return $ D.Yield x (CANested st startf

420+ return $ D.Yield x (InnerLoop st startf

419421 (p `plusPtr` (sizeOf (undefined :: a))) end)

420422

421423{-# INLINE_NORMAL flattenArraysRev #-}

422424flattenArraysRev :: forall m a. (Monad m, Storable a)

423425 => D.Stream m (Array a) -> D.Stream m a

424−flattenArraysRev (D.Stream step state) = D.Stream step' (CAParent state)

426+flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)

425427

426428 where

427429

428430 {-# INLINE_LATE step' #-}

429− step' gst (CAParent st) = do

431+ step' gst (OuterLoop st) = do

430432 r <- step (adaptState gst) st

431433 return $ case r of

432434 D.Yield Array{..} s ->

433435 let p = aEnd `plusPtr` negate (sizeOf (undefined :: a))

434436 -- XXX we do not need aEnd

435− in D.Skip (CANested s aStart p aEnd)

436− D.Skip s -> D.Skip (CAParent s)

437+ in D.Skip (InnerLoop s aStart p aEnd)

438+ D.Skip s -> D.Skip (OuterLoop s)

437439 D.Stop -> D.Stop

438440

439− step' _ (CANested st start p _) | p < unsafeForeignPtrToPtr start =

440− return $ D.Skip $ CAParent st

441+ step' _ (InnerLoop st start p _) | p < unsafeForeignPtrToPtr start =

442+ return $ D.Skip $ OuterLoop st

441443

442− step' _ (CANested st startf p end) = do

444+ step' _ (InnerLoop st startf p end) = do

443445 let !x = unsafeInlineIO $ do

444446 r <- peek p

445447 touchForeignPtr startf

446448 return r

447− return $ D.Yield x (CANested st startf

449+ return $ D.Yield x (InnerLoop st startf

448450 (p `plusPtr` negate (sizeOf (undefined :: a))) end)

449451

450452-- CAUTION: a very large number (millions) of arrays can degrade performance

streamly.cabal+1−1

@@ -346,7 +346,7 @@ test-suite properties

346346 transformers >= 0.4 && < 0.6

347347 default-language: Haskell2010

348348

349−test-suite arrays

349+test-suite array-test

350350 type: exitcode-stdio-1.0

351351 main-is: Arrays.hs

352352 js-sources: jsbits/clock.js

test/Arrays.hs+71−16

@@ -4,10 +4,11 @@

44module Main (main) where

66import Data.Functor.Identity (runIdentity)

7−import GHC.Word (Word8)

7+import Foreign.Storable (Storable(..))

99import Test.Hspec.QuickCheck

10−import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, (===))

10+import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, (===),

11+ choose)

1112

1213import Test.Hspec as H

1314

@@ -22,19 +23,70 @@ maxTestCount = 100

2223maxTestCount = 10

2324#endif

2425

25−randomLengthArray :: Word8 -> Property

26−randomLengthArray len =

27− forAll (vectorOf (fromIntegral len) (arbitrary :: Gen Int)) $ \list ->

28− let arr = runIdentity $ A.fromStreamN (fromIntegral len)

29− $ S.fromList list

30− in A.length arr === fromIntegral len

26+allocOverhead :: Int

27+allocOverhead = 2 * sizeOf (undefined :: Int)

3128

32−randomArrayRoundTrip :: Word8 -> Property

33−randomArrayRoundTrip len =

34− forAll (vectorOf (fromIntegral len) (arbitrary :: Gen Int)) $ \list ->

35− let arr = runIdentity $ A.fromStreamN (fromIntegral len)

36− $ S.fromList list

37− in runIdentity (S.toList (A.toStream arr)) === list

29+-- XXX this should be in sync with the defaultChunkSize in Array code, or we

30+-- should expose that and use that. For fast testing we could reduce the

31+-- defaultChunkSize under CPP conditionals.

32+--

33+defaultChunkSize :: Int

34+defaultChunkSize = 32 * k - allocOverhead

35+ where k = 1024

36+

37+maxArrLen :: Int

38+maxArrLen = defaultChunkSize * 8

39+

40+testLength :: Property

41+testLength =

42+ forAll (choose (0, maxArrLen)) $ \len ->

43+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

44+ let arr = runIdentity $ A.fromStreamN len

45+ $ S.fromList list

46+ in A.length arr === len

47+

48+testFromToStreamN :: Property

49+testFromToStreamN =

50+ forAll (choose (0, maxArrLen)) $ \len ->

51+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

52+ let arr = runIdentity $ A.fromStreamN len

53+ $ S.fromList list

54+ in runIdentity (S.toList (A.toStream arr)) === list

55+

56+testArraysOf :: Property

57+testArraysOf =

58+ forAll (choose (0, maxArrLen)) $ \len ->

59+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

60+ let xs = runIdentity

61+ $ S.toList

62+ $ S.concatMap A.toStream

63+ $ A.arraysOf 240

64+ $ S.fromList list

65+ in xs === list

66+

67+testFlattenArrays :: Property

68+testFlattenArrays =

69+ forAll (choose (0, maxArrLen)) $ \len ->

70+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

71+ let xs = runIdentity

72+ $ S.toList

73+ $ A.flattenArrays

74+ $ A.arraysOf 240

75+ $ S.fromList list

76+ in xs === list

77+

78+{-

79+testFromToStream :: Property

80+testFromToStream =

81+ forAll (choose (0, maxArrLen)) $ \len ->

82+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \list ->

83+ let xs = runIdentity

84+ $ S.toList

85+ $ A.toStream

86+ $ runIdentity. A.fromStream

87+ $ S.fromList list

88+ in xs === list

89+-}

3890

3991main :: IO ()

4092main = hspec

@@ -42,5 +94,8 @@ main = hspec

4294 $ modifyMaxSuccess (const maxTestCount)

4395 $ do

4496 describe "Construction" $ do

45− prop "length . fromStreamN n === n" $ randomLengthArray

46− prop "fromStreamN n . toStream === id" $ randomArrayRoundTrip

97+ prop "length . fromStreamN n === n" $ testLength

98+ prop "toStream . fromStreamN n === id" $ testFromToStreamN

99+ prop "arraysOf concats to original" $ testArraysOf

100+ prop "flattenArrays concats to original" $ testFlattenArrays

101+ -- prop "toStream . fromStream === id" $ testFromToStream

test/Prop.hs+8−5

@@ -467,6 +467,9 @@ transformCombineOpsCommon constr desc eq t = do

467467 transform (concatMap (const [1..n]))

468468 t (S.concatMap (const (S.fromList [1..n])))

469469

470+toListFL :: Monad m => FL.Fold m a [a]

471+toListFL = fmap reverse FL.toListRev

472+

470473groupSplitOps :: String -> Spec

471474groupSplitOps desc = do

472475 -- splitting

@@ -476,14 +479,14 @@ groupSplitOps desc = do

476479 forAll listWithZeroes $ \xs -> do

477480 withMaxSuccess maxTestCount $

478481 monadicIO $ do

479− ys <- S.toList $ FL.splitOn [] FL.toList (S.fromList xs)

482+ ys <- S.toList $ FL.splitOn [] toListFL (S.fromList xs)

480483 listEquals (==) (intercalate [] ys) xs

481484

482485 prop (desc <> " intercalate . splitOn == id (single element separator)") $

483486 forAll listWithZeroes $ \xs -> do

484487 withMaxSuccess maxTestCount $

485488 monadicIO $ do

486− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

489+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

487490 listEquals (==) (intercalate [0] ys) xs

488491

489492 prop (desc <> " concat . splitOn . intercalate == concat (nil separator/possibly empty list)") $

@@ -491,7 +494,7 @@ groupSplitOps desc = do

491494 withMaxSuccess maxTestCount $

492495 monadicIO $ do

493496 let xs = intercalate [] xss

494− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

497+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

495498 listEquals (==) (concat ys) (concat xss)

496499

497500 prop (desc <> " concat . splitOn . intercalate == concat (non-nil separator/possibly empty list)") $

@@ -499,7 +502,7 @@ groupSplitOps desc = do

499502 withMaxSuccess maxTestCount $

500503 monadicIO $ do

501504 let xs = intercalate [0] xss

502− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

505+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

503506 listEquals (==) (concat ys) (concat xss)

504507

505508 prop (desc <> " splitOn . intercalate == id (exclusive separator/non-empty list)") $

@@ -507,7 +510,7 @@ groupSplitOps desc = do

507510 withMaxSuccess maxTestCount $

508511 monadicIO $ do

509512 let xs = intercalate [0] xss

510− ys <- S.toList $ FL.splitOn [0] FL.toList (S.fromList xs)

513+ ys <- S.toList $ FL.splitOn [0] toListFL (S.fromList xs)

511514 listEquals (==) ys xss

512515

513516 where