on master help sign in
Merge pull request #221 from neongreen/inspection-testing

Add an inspection test for #214

commitc8a98dd1ed92e311d060678f1d6682e2a220a0ec authorHarendra Kumar <harendra.kumar@gmail.com> dateSun 28 Jul 2019, 18:47 (7 years ago) parentb7d0527bebdf08
4 files changed+57−7
src/Streamly/Streams/StreamD.hs+6−6 stack.yaml+1 streamly.cabal+17−1 test/inspection.hs+33
src/Streamly/Streams/StreamD.hs+6−6
@@ -275,7 +275,7 @@ import qualified Control.Monad.Catch as MC
275275import Streamly.Mem.Array.Types (Array(..))
276276import Streamly.Fold.Types (Fold(..))
277277import Streamly.Pipe.Types (Pipe(..), PipeState(..))
278−import Streamly.SVar (MonadAsync, defState, adaptState, State)
278+import Streamly.SVar (MonadAsync, defState, adaptState)
279279
280280import Streamly.Streams.StreamD.Type
281281
@@ -372,11 +372,11 @@ replicateM :: forall m a. Monad m => Int -> m a -> Stream m a
372372replicateM n p = Stream step n
373373 where
374374 {-# INLINE_LATE step #-}
375− step :: State K.Stream m a -> Int -> m (Step Int a)
376− step _ i | i <= 0 = return Stop
377− | otherwise = do
378− x <- p
379− return $ Yield x (i - 1)
375+ step _ (i :: Int)
376+ | i <= 0 = return Stop
377+ | otherwise = do
378+ x <- p
379+ return $ Yield x (i - 1)
380380
381381-- | For use with flatten
382382{-# INLINE replicateGen #-}
stack.yaml+1
@@ -6,6 +6,7 @@ extra-deps:
66 - Chart-1.9.1
77 - Chart-diagrams-1.9.2
88 - bench-show-0.2.2
9+ - inspection-testing-0.4.2.1
910
1011#allow-newer: true
1112flags: {}
streamly.cabal+17−1
@@ -343,7 +343,7 @@ test-suite test
343343-- , base >= 4.8 && < 5
344344-- , hspec >= 2.0 && < 3
345345-- default-language: Haskell2010
346−--
346+--
347347-- test-suite pure-streams-streamly
348348-- type: exitcode-stdio-1.0
349349-- main-is: PureStreams.hs
@@ -506,6 +506,22 @@ test-suite parallel-loops
506506 , base >= 4.8 && < 5
507507 , random >= 1.0.0 && < 2
508508
509+test-suite inspection
510+ type: exitcode-stdio-1.0
511+ default-language: Haskell2010
512+ main-is: inspection.hs
513+ hs-source-dirs: test
514+ ghc-options: -fno-ignore-asserts -O2 -Wall -threaded -with-rtsopts=-N
515+ build-Depends:
516+ streamly
517+ , base >= 4.8 && < 5
518+ , inspection-testing >= 0.4 && < 0.5
519+ if impl(ghc < 8.0)
520+ buildable: False
521+ -- On Windows we're getting "unknown symbol `clock_gettime'"
522+ if os(windows)
523+ buildable: False
524+
509525-------------------------------------------------------------------------------
510526-- Benchmarks
511527-------------------------------------------------------------------------------
test/inspection.hsnew file+33
@@ -0,0 +1,33 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE TemplateHaskell #-}
3+
4+{-# OPTIONS_GHC -O -fplugin Test.Inspection.Plugin #-}
5+
6+import Streamly
7+import qualified Streamly.Prelude as S
8+import Test.Inspection
9+
10+main :: IO ()
11+main = pure () -- If the test compiles, it passes
12+
13+-------------------------------------------------------------------------------
14+-- #214 regression test: 'concatMap (replicate n)' should be specialized
15+-------------------------------------------------------------------------------
16+
17+{-# INLINE concatMap1 #-}
18+concatMap1 :: MonadAsync m => SerialT m Int -> m ()
19+concatMap1 src = S.drain $ S.concatMap (S.replicate 3) src
20+
21+{-# INLINE sourceUnfoldrMN #-}
22+sourceUnfoldrMN :: MonadAsync m => Int -> Int -> SerialT m Int
23+sourceUnfoldrMN m n = S.unfoldrM step n
24+ where
25+ step cnt =
26+ if cnt > n + m
27+ then return Nothing
28+ else return (Just (cnt, cnt + 1))
29+
30+test214 :: IO ()
31+test214 = concatMap1 (sourceUnfoldrMN 1000000 5)
32+
33+inspect $ hasNoTypeClasses 'test214