80daa14 · streamly · git.iko.soy

git.iko.soy/streamly

Refactor WSerial ops into a separate test suite.

commit80daa14f61bd5966a421227ee17d92e0a1deb5d5 authorPranay Sashank <pranaysashank@composewell.com> dateFri 24 Jul 2020, 19:27 (6 years ago) parent397d167

6 files changed+142−116

compare with master

unifiedsplit

streamly.cabal+8 test/Prop.hs+1−71 test/Streamly/Test/Common.hs+3 test/Streamly/Test/Prelude.hs+48−14 test/Streamly/Test/Prelude/Serial.hs+3−31 test/Streamly/Test/Prelude/WSerial.hs+79

streamly.cabal+8

@@ -592,6 +592,14 @@ test-suite Prelude.Serial

592592 other-modules: Streamly.Test.Common

593593 , Streamly.Test.Prelude

594594

595+test-suite Prelude.WSerial

596+ import: test-options, prelude-test-options

597+ type: exitcode-stdio-1.0

598+ main-is: Streamly/Test/Prelude/WSerial.hs

599+ ghc-options: -main-is Streamly.Test.Prelude.WSerial.main

600+ other-modules: Streamly.Test.Common

601+ , Streamly.Test.Prelude

602+

595603test-suite array-test

596604 import: test-options

597605 type: exitcode-stdio-1.0

test/Prop.hs+1−71

@@ -9,7 +9,6 @@ import Control.Exception

99 BlockedIndefinitelyOnSTM(..), Handler(..))

1010import Control.Monad (when, forM_, replicateM_)

1111import Data.IORef (readIORef, modifyIORef, newIORef)

12−import Data.List (sort)

1312import GHC.Word (Word8)

1413

1514import Test.Hspec.QuickCheck

@@ -20,15 +19,11 @@ import Test.QuickCheck.Monadic (monadicIO, run)

2019import Test.Hspec as H

2120

2221import Streamly

23−import Streamly as S

2422import qualified Streamly.Prelude as S

2523

2624import Streamly.Test.Common

2725import Streamly.Test.Prelude

2826

29−sortEq :: Ord a => [a] -> [a] -> Bool

30−sortEq a b = sort a == sort b

31−

3227-------------------------------------------------------------------------------

3328-- Concurrent generation

3429-------------------------------------------------------------------------------

@@ -259,10 +254,6 @@ zipAsyncMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $

259254 listEquals eq stream1 list

260255 listEquals eq stream2 list

261256

262−-------------------------------------------------------------------------------

263−-- Tests for S.groupsBy

264−-------------------------------------------------------------------------------

265−

266257main :: IO ()

267258main = hspec

268259 $ H.parallel

@@ -270,34 +261,6 @@ main = hspec

270261 $ modifyMaxSuccess (const 10)

271262#endif

272263 $ do

273− let folded :: IsStream t => [a] -> t IO a

274− folded = serially . (\xs ->

275− case xs of

276− [x] -> return x -- singleton stream case

277− _ -> S.foldMapWith (<>) return xs

278− )

279−

280− let makeCommonOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]

281− makeCommonOps t =

282− [ ("default", t)

283−#ifndef COVERAGE_BUILD

284− , ("rate AvgRate 10000", t . avgRate 10000)

285− , ("rate Nothing", t . rate Nothing)

286− , ("maxBuffer 0", t . maxBuffer 0)

287− , ("maxThreads 0", t . maxThreads 0)

288− , ("maxThreads 1", t . maxThreads 1)

289− , ("maxThreads -1", t . maxThreads (-1))

290−#endif

291− ]

292−

293− let makeOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]

294− makeOps t = makeCommonOps t ++

295− [

296−#ifndef COVERAGE_BUILD

297− ("maxBuffer 1", t . maxBuffer 1)

298−#endif

299− ]

300−

301264 -- For concurrent application test we need a buffer of at least size 2 to

302265 -- allow two threads to run.

303266 let makeConcurrentAppOps :: IsStream t

@@ -309,19 +272,6 @@ main = hspec

309272#endif

310273 ]

311274

312− let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)

313− let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec

314− serialOps spec = mapOps spec $ makeOps serially

315−#ifndef COVERAGE_BUILD

316− <> [("rate AvgRate 0.00000001", serially . avgRate 0.00000001)]

317− <> [("maxBuffer -1", serially . maxBuffer (-1))]

318−#endif

319− let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec

320− wSerialOps spec = mapOps spec $ makeOps wSerially

321−#ifndef COVERAGE_BUILD

322− <> [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]

323− <> [("maxBuffer (-1)", wSerially . maxBuffer (-1))]

324−#endif

325275 let asyncOps :: IsStream t => ((AsyncT IO a -> t IO a) -> Spec) -> Spec

326276 asyncOps spec = mapOps spec $ makeOps asyncly

327277#ifndef COVERAGE_BUILD

@@ -365,7 +315,6 @@ main = hspec

365315 zipAsyncOps spec = mapOps spec $ makeOps zipAsyncly

366316

367317 describe "Construction" $ do

368− wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM

369318 aheadOps $ prop "aheadly replicateM" . constructWithReplicateM

370319 asyncOps $ prop "asyncly replicateM" . constructWithReplicateM

371320 wAsyncOps $ prop "wAsyncly replicateM" . constructWithReplicateM

@@ -381,8 +330,6 @@ main = hspec

381330 -- XXX add tests for fromIndices

382331

383332 describe "Functor operations" $ do

384− wSerialOps $ functorOps S.fromFoldable "wSerially" (==)

385− wSerialOps $ functorOps folded "wSerially folded" (==)

386333 aheadOps $ functorOps S.fromFoldable "aheadly" (==)

387334 aheadOps $ functorOps folded "aheadly folded" (==)

388335 asyncOps $ functorOps S.fromFoldable "asyncly" sortEq

@@ -397,7 +344,6 @@ main = hspec

397344 zipAsyncOps $ functorOps folded "zipAsyncly folded" (==)

398345

399346 describe "Semigroup operations" $ do

400− wSerialOps $ semigroupOps "wSerially" (==)

401347 aheadOps $ semigroupOps "aheadly" (==)

402348 asyncOps $ semigroupOps "asyncly" sortEq

403349 wAsyncOps $ semigroupOps "wAsyncly" sortEq

@@ -406,8 +352,6 @@ main = hspec

406352 zipAsyncOps $ semigroupOps "zipAsyncly" (==)

407353

408354 describe "Applicative operations" $ do

409− wSerialOps $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq

410− wSerialOps $ prop "wSerially applicative folded" . applicativeOps folded sortEq

411355 aheadOps $ prop "aheadly applicative" . applicativeOps S.fromFoldable (==)

412356 aheadOps $ prop "aheadly applicative folded" . applicativeOps folded (==)

413357 asyncOps $ prop "asyncly applicative" . applicativeOps S.fromFoldable sortEq

@@ -426,8 +370,6 @@ main = hspec

426370 -- We test only the serial zip with serial streams and the parallel

427371 -- stream, because the rate setting in these streams can slow down

428372 -- zipAsync.

429− wSerialOps $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)

430− wSerialOps $ prop "zip monadic wSerially folded" . zipMonadic folded (==)

431373 aheadOps $ prop "zip monadic aheadly" . zipAsyncMonadic S.fromFoldable (==)

432374 aheadOps $ prop "zip monadic aheadly folded" . zipAsyncMonadic folded (==)

433375 asyncOps $ prop "zip monadic asyncly" . zipAsyncMonadic S.fromFoldable (==)

@@ -443,25 +385,21 @@ main = hspec

443385 -- describe "Merge operations" $ do

444386

445387 describe "Monad operations" $ do

446− wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq

447388 aheadOps $ prop "aheadly monad then" . monadThen S.fromFoldable (==)

448389 asyncOps $ prop "asyncly monad then" . monadThen S.fromFoldable sortEq

449390 wAsyncOps $ prop "wAsyncly monad then" . monadThen S.fromFoldable sortEq

450391 parallelOps $ prop "parallely monad then" . monadThen S.fromFoldable sortEq

451392

452− wSerialOps $ prop "wSerially monad then folded" . monadThen folded sortEq

453393 aheadOps $ prop "aheadly monad then folded" . monadThen folded (==)

454394 asyncOps $ prop "asyncly monad then folded" . monadThen folded sortEq

455395 wAsyncOps $ prop "wAsyncly monad then folded" . monadThen folded sortEq

456396 parallelOps $ prop "parallely monad then folded" . monadThen folded sortEq

457397

458− wSerialOps $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq

459398 aheadOps $ prop "aheadly monad bind" . monadBind S.fromFoldable (==)

460399 asyncOps $ prop "asyncly monad bind" . monadBind S.fromFoldable sortEq

461400 wAsyncOps $ prop "wAsyncly monad bind" . monadBind S.fromFoldable sortEq

462401 parallelOps $ prop "parallely monad bind" . monadBind S.fromFoldable sortEq

463402

464− wSerialOps $ prop "wSerially monad bind folded" . monadBind folded sortEq

465403 aheadOps $ prop "aheadly monad bind folded" . monadBind folded (==)

466404 asyncOps $ prop "asyncly monad bind folded" . monadBind folded sortEq

467405 wAsyncOps $ prop "wAsyncly monad bind folded" . monadBind folded sortEq

@@ -493,7 +431,7 @@ main = hspec

493431 forOps (mkOps parallely) $ concurrentOps folded "parallely folded" sortEq

494432

495433 describe "Concurrent application" $ do

496− serialOps $ prop "serial" . concurrentApplication (==)

434+-- serialOps $ prop "serial" . concurrentApplication (==)

497435 asyncOps $ prop "async" . concurrentApplication sortEq

498436 aheadOps $ prop "ahead" . concurrentApplication (==)

499437 parallelConcurrentAppOps $

@@ -505,7 +443,6 @@ main = hspec

505443 concurrentFoldlApplication

506444

507445 describe "Stream transform and combine operations" $ do

508− wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq

509446 aheadOps $ transformCombineOpsCommon S.fromFoldable "aheadly" (==)

510447 asyncOps $ transformCombineOpsCommon S.fromFoldable "asyncly" sortEq

511448 wAsyncOps $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq

@@ -513,7 +450,6 @@ main = hspec

513450 zipSerialOps $ transformCombineOpsCommon S.fromFoldable "zipSerially" (==)

514451 zipAsyncOps $ transformCombineOpsCommon S.fromFoldable "zipAsyncly" (==)

515452

516− wSerialOps $ transformCombineOpsCommon folded "wSerially" sortEq

517453 aheadOps $ transformCombineOpsCommon folded "aheadly" (==)

518454 asyncOps $ transformCombineOpsCommon folded "asyncly" sortEq

519455 wAsyncOps $ transformCombineOpsCommon folded "wAsyncly" sortEq

@@ -530,7 +466,6 @@ main = hspec

530466 zipAsyncOps $ transformCombineOpsOrdered folded "zipAsyncly" (==)

531467

532468 describe "Stream elimination operations" $ do

533− wSerialOps $ eliminationOps S.fromFoldable "wSerially"

534469 aheadOps $ eliminationOps S.fromFoldable "aheadly"

535470 asyncOps $ eliminationOps S.fromFoldable "asyncly"

536471 wAsyncOps $ eliminationOps S.fromFoldable "wAsyncly"

@@ -538,7 +473,6 @@ main = hspec

538473 zipSerialOps $ eliminationOps S.fromFoldable "zipSerially"

539474 zipAsyncOps $ eliminationOps S.fromFoldable "zipAsyncly"

540475

541− wSerialOps $ eliminationOps folded "wSerially folded"

542476 aheadOps $ eliminationOps folded "aheadly folded"

543477 asyncOps $ eliminationOps folded "asyncly folded"

544478 wAsyncOps $ eliminationOps folded "wAsyncly folded"

@@ -546,7 +480,6 @@ main = hspec

546480 zipSerialOps $ eliminationOps folded "zipSerially folded"

547481 zipAsyncOps $ eliminationOps folded "zipAsyncly folded"

548482

549− wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"

550483 aheadOps $ eliminationOpsWord8 S.fromFoldable "aheadly"

551484 asyncOps $ eliminationOpsWord8 S.fromFoldable "asyncly"

552485 wAsyncOps $ eliminationOpsWord8 S.fromFoldable "wAsyncly"

@@ -554,7 +487,6 @@ main = hspec

554487 zipSerialOps $ eliminationOpsWord8 S.fromFoldable "zipSerially"

555488 zipAsyncOps $ eliminationOpsWord8 S.fromFoldable "zipAsyncly"

556489

557− wSerialOps $ eliminationOpsWord8 folded "wSerially folded"

558490 aheadOps $ eliminationOpsWord8 folded "aheadly folded"

559491 asyncOps $ eliminationOpsWord8 folded "asyncly folded"

560492 wAsyncOps $ eliminationOpsWord8 folded "wAsyncly folded"

@@ -565,12 +497,10 @@ main = hspec

565497 -- XXX Add a test where we chain all transformation APIs and make sure that

566498 -- the state is being passed through all of them.

567499 describe "Stream serial elimination operations" $ do

568− wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"

569500 aheadOps $ eliminationOpsOrdered S.fromFoldable "aheadly"

570501 zipSerialOps $ eliminationOpsOrdered S.fromFoldable "zipSerially"

571502 zipAsyncOps $ eliminationOpsOrdered S.fromFoldable "zipAsyncly"

572503

573− wSerialOps $ eliminationOpsOrdered folded "wSerially folded"

574504 aheadOps $ eliminationOpsOrdered folded "aheadly folded"

575505 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"

576506 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"

test/Streamly/Test/Common.hs+3

@@ -15,6 +15,9 @@ module Streamly.Test.Common

1515import Control.Monad (when)

1616import Control.Monad.IO.Class (MonadIO(..))

1717import Data.List ((\\))

18+#if __GLASGOW_HASKELL__ < 808

19+import Data.Semigroup ((<>))

20+#endif

1821import Test.QuickCheck (counterexample)

1922import Test.QuickCheck.Monadic (PropertyM, assert, monitor)

2023

test/Streamly/Test/Prelude.hs+48−14

@@ -43,12 +43,18 @@ module Streamly.Test.Prelude

4343 -- * Default values

4444 , maxTestCount

4545 , maxStreamLen

46+ -- * Helper operations

47+ , folded

48+ , makeCommonOps

49+ , makeOps

50+ , mapOps

51+ , sortEq

4652 ) where

4753

4854import Control.Applicative (ZipList(..), liftA2)

4955import Control.Monad (replicateM)

5056import Data.Function ((&))

51−import Data.IORef (IORef, modifyIORef, modifyIORef', newIORef, readIORef)

57+import Data.IORef (IORef, modifyIORef', newIORef, readIORef)

5258import Data.List

5359 ( deleteBy

5460 , elemIndex

@@ -69,22 +75,14 @@ import Data.List

6975 , stripPrefix

7076 )

7177import Data.Maybe (mapMaybe)

78+#if __GLASGOW_HASKELL__ < 808

79+import Data.Semigroup ((<>))

80+#endif

7281import GHC.Word (Word8)

7382import Test.Hspec.QuickCheck

7483import Test.Hspec

75−import Test.QuickCheck

76− ( Gen

77− , Property

78− , arbitrary

79− , choose

80− , elements

81− , forAll

82− , frequency

83− , listOf

84− , vectorOf

85− , withMaxSuccess

86− )

87−import Test.QuickCheck.Monadic (PropertyM, assert, monadicIO, run)

84+import Test.QuickCheck (Property, choose, forAll, withMaxSuccess)

85+import Test.QuickCheck.Monadic (assert, monadicIO, run)

8886

8987import Streamly

9088import Streamly.Prelude ((.:), nil)

@@ -729,3 +727,39 @@ zipMonadic constr eq t (a, b) = withMaxSuccess maxTestCount $

729727 (S.zipWithM (curry return) (constr a) (constr b)))

730728 let list = getZipList $ (,) <$> ZipList a <*> ZipList b

731729 listEquals eq stream1 list

730+

731+-------------------------------------------------------------------------------

732+-- Helper operations

733+-------------------------------------------------------------------------------

734+

735+folded :: IsStream t => [a] -> t IO a

736+folded =

737+ serially .

738+ (\xs ->

739+ case xs of

740+ [x] -> return x -- singleton stream case

741+ _ -> S.foldMapWith (<>) return xs)

742+

743+makeCommonOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]

744+makeCommonOps t =

745+ [ ("default", t)

746+#ifndef COVERAGE_BUILD

747+ , ("rate AvgRate 10000", t . avgRate 10000)

748+ , ("rate Nothing", t . rate Nothing)

749+ , ("maxBuffer 0", t . maxBuffer 0)

750+ , ("maxThreads 0", t . maxThreads 0)

751+ , ("maxThreads 1", t . maxThreads 1)

752+ , ("maxThreads -1", t . maxThreads (-1))

753+#endif

754+ ]

755+

756+makeOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]

757+makeOps t = makeCommonOps t ++

758+ [

759+#ifndef COVERAGE_BUILD

760+ ("maxBuffer 1", t . maxBuffer 1)

761+#endif

762+ ]

763+

764+mapOps :: (a -> Spec) -> [(String, a)] -> Spec

765+mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)

test/Streamly/Test/Prelude/Serial.hs+3−31

@@ -10,6 +10,9 @@

1010module Streamly.Test.Prelude.Serial where

1111

1212import Data.List (intercalate)

13+#if __GLASGOW_HASKELL__ < 808

14+import Data.Semigroup ((<>))

15+#endif

1316import Test.Hspec.QuickCheck

1417import Test.QuickCheck

1518 ( Gen

@@ -27,10 +30,8 @@ import Test.QuickCheck.Monadic (assert, monadicIO, run)

2730import Test.Hspec as H

2831

2932import Streamly

30−import Streamly as S

3133import qualified Streamly.Prelude as S

3234import qualified Streamly.Data.Fold as FL

33−import qualified Streamly.Internal.Data.Fold as FL

3435

3536import Streamly.Test.Common

3637import Streamly.Test.Prelude

@@ -151,35 +152,6 @@ main = hspec

151152 $ modifyMaxSuccess (const 10)

152153#endif

153154 $ do

154− let folded :: IsStream t => [a] -> t IO a

155− folded = serially . (\xs ->

156− case xs of

157− [x] -> return x -- singleton stream case

158− _ -> S.foldMapWith (<>) return xs

159− )

160−

161− let makeCommonOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]

162− makeCommonOps t =

163− [ ("default", t)

164−#ifndef COVERAGE_BUILD

165− , ("rate AvgRate 10000", t . avgRate 10000)

166− , ("rate Nothing", t . rate Nothing)

167− , ("maxBuffer 0", t . maxBuffer 0)

168− , ("maxThreads 0", t . maxThreads 0)

169− , ("maxThreads 1", t . maxThreads 1)

170− , ("maxThreads -1", t . maxThreads (-1))

171−#endif

172− ]

173−

174− let makeOps :: IsStream t => (t m a -> c) -> [(String, t m a -> c)]

175− makeOps t = makeCommonOps t ++

176− [

177−#ifndef COVERAGE_BUILD

178− ("maxBuffer 1", t . maxBuffer 1)

179−#endif

180− ]

181−

182− let mapOps spec = mapM_ (\(desc, f) -> describe desc $ spec f)

183155 let serialOps :: IsStream t => ((SerialT IO a -> t IO a) -> Spec) -> Spec

184156 serialOps spec = mapOps spec $ makeOps serially

185157#ifndef COVERAGE_BUILD

test/Streamly/Test/Prelude/WSerial.hsnew file+79

@@ -0,0 +1,79 @@

1+-- |

2+-- Module : Streamly.Test.Prelude.WSerial

4+--

5+-- License : BSD-3-Clause

6+-- Maintainer : streamly@composewell.com

7+-- Stability : experimental

8+-- Portability : GHC

10+module Streamly.Test.Prelude.WSerial where

11+

12+#if __GLASGOW_HASKELL__ < 808

13+import Data.Semigroup ((<>))

14+#endif

15+import Test.Hspec.QuickCheck

16+import Test.Hspec as H

17+

18+import Streamly

19+import qualified Streamly.Prelude as S

20+

21+import Streamly.Test.Prelude

22+

23+main :: IO ()

24+main = hspec

25+ $ H.parallel

26+#ifdef COVERAGE_BUILD

27+ $ modifyMaxSuccess (const 10)

28+#endif

29+ $ do

30+ let wSerialOps :: IsStream t => ((WSerialT IO a -> t IO a) -> Spec) -> Spec

31+ wSerialOps spec = mapOps spec $ makeOps wSerially

32+#ifndef COVERAGE_BUILD

33+ <> [("rate AvgRate 0.00000001", wSerially . avgRate 0.00000001)]

34+ <> [("maxBuffer (-1)", wSerially . maxBuffer (-1))]

35+#endif

36+

37+ describe "Construction" $ do

38+ wSerialOps $ prop "wSerially replicateM" . constructWithReplicateM

39+

40+ describe "Functor operations" $ do

41+ wSerialOps $ functorOps S.fromFoldable "wSerially" (==)

42+ wSerialOps $ functorOps folded "wSerially folded" (==)

43+

44+ describe "Semigroup operations" $ do

45+ wSerialOps $ semigroupOps "wSerially" (==)

46+

47+ describe "Applicative operations" $ do

48+ wSerialOps $ prop "wSerially applicative" . applicativeOps S.fromFoldable sortEq

49+ wSerialOps $ prop "wSerially applicative folded" . applicativeOps folded sortEq

50+

51+ -- XXX add tests for indexed/indexedR

52+ describe "Zip operations" $ do

53+ -- We test only the serial zip with serial streams and the parallel

54+ -- stream, because the rate setting in these streams can slow down

55+ -- zipAsync.

56+ wSerialOps $ prop "zip monadic wSerially" . zipMonadic S.fromFoldable (==)

57+ wSerialOps $ prop "zip monadic wSerially folded" . zipMonadic folded (==)

58+

59+ describe "Monad operations" $ do

60+ wSerialOps $ prop "wSerially monad then" . monadThen S.fromFoldable sortEq

61+ wSerialOps $ prop "wSerially monad then folded" . monadThen folded sortEq

62+ wSerialOps $ prop "wSerially monad bind" . monadBind S.fromFoldable sortEq

63+ wSerialOps $ prop "wSerially monad bind folded" . monadBind folded sortEq

64+

65+ describe "Stream transform and combine operations" $ do

66+ wSerialOps $ transformCombineOpsCommon S.fromFoldable "wSerially" sortEq

67+ wSerialOps $ transformCombineOpsCommon folded "wSerially" sortEq

68+

69+ describe "Stream elimination operations" $ do

70+ wSerialOps $ eliminationOps S.fromFoldable "wSerially"

71+ wSerialOps $ eliminationOps folded "wSerially folded"

72+ wSerialOps $ eliminationOpsWord8 S.fromFoldable "wSerially"

73+ wSerialOps $ eliminationOpsWord8 folded "wSerially folded"

74+

75+ -- XXX Add a test where we chain all transformation APIs and make sure that

76+ -- the state is being passed through all of them.

77+ describe "Stream serial elimination operations" $ do

78+ wSerialOps $ eliminationOpsOrdered S.fromFoldable "wSerially"

79+ wSerialOps $ eliminationOpsOrdered folded "wSerially folded"