Hello community, here is the log from the commit of package ghc-hspec-core for openSUSE:Factory checked in at 2018-11-09 07:52:04 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hspec-core (Old) and /work/SRC/openSUSE:Factory/.ghc-hspec-core.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hspec-core" Fri Nov 9 07:52:04 2018 rev:10 rq:646355 version:2.6.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hspec-core/ghc-hspec-core.changes 2018-10-25 08:17:19.848044797 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hspec-core.new/ghc-hspec-core.changes 2018-11-09 07:52:16.815858499 +0100 @@ -1,0 +2,6 @@ +Sun Nov 4 03:01:36 UTC 2018 - psimons@suse.com + +- Update hspec-core to version 2.6.0. + Upstream does not provide a change log file. + +------------------------------------------------------------------- Old: ---- hspec-core-2.5.8.tar.gz New: ---- hspec-core-2.6.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hspec-core.spec ++++++ --- /var/tmp/diff_new_pack.zqOuqI/_old 2018-11-09 07:52:20.099854720 +0100 +++ /var/tmp/diff_new_pack.zqOuqI/_new 2018-11-09 07:52:20.103854716 +0100 @@ -19,7 +19,7 @@ %global pkg_name hspec-core %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.5.8 +Version: 2.6.0 Release: 0 Summary: A Testing Framework for Haskell License: MIT ++++++ hspec-core-2.5.8.tar.gz -> hspec-core-2.6.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/hspec-core.cabal new/hspec-core-2.6.0/hspec-core.cabal --- old/hspec-core-2.5.8/hspec-core.cabal 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/hspec-core.cabal 2018-11-04 02:37:12.000000000 +0100 @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.30.0. +-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- --- hash: 2816c495eba299470f8178ab0162b41c33ff43fdd8c7d53ed3743386b018f184 +-- hash: fef917dc0cb43c6da4719fb2d080d28e01d8bc888b679a3fa1c61559f02d9848 name: hspec-core -version: 2.5.8 +version: 2.6.0 license: MIT license-file: LICENSE copyright: (c) 2011-2018 Simon Hengel, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Example/Location.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Example/Location.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Example/Location.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Example/Location.hs 2018-11-04 02:37:12.000000000 +0100 @@ -26,7 +26,11 @@ } deriving (Eq, Show, Read) extractLocation :: SomeException -> Maybe Location -extractLocation e = locationFromErrorCall e <|> locationFromPatternMatchFail e <|> locationFromIOException e +extractLocation e = + locationFromErrorCall e + <|> locationFromPatternMatchFail e + <|> locationFromRecConError e + <|> locationFromIOException e locationFromErrorCall :: SomeException -> Maybe Location locationFromErrorCall e = case fromException e of @@ -44,6 +48,11 @@ Just (PatternMatchFail s) -> listToMaybe (words s) >>= parseSourceSpan Nothing -> Nothing +locationFromRecConError :: SomeException -> Maybe Location +locationFromRecConError e = case fromException e of + Just (RecConError s) -> listToMaybe (words s) >>= parseSourceSpan + Nothing -> Nothing + locationFromIOException :: SomeException -> Maybe Location locationFromIOException e = case fromException e of Just (IOError {ioe_type = UserError, ioe_description = xs}) -> fromPatternMatchFailureInDoExpression xs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Formatters/Internal.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Formatters/Internal.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Formatters/Internal.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Formatters/Internal.hs 2018-11-04 02:37:12.000000000 +0100 @@ -68,6 +68,7 @@ , environmentWithSuccessColor = withSuccessColor , environmentWithPendingColor = withPendingColor , environmentWithInfoColor = withInfoColor +, environmentUseDiff = gets (formatConfigUseDiff . stateConfig) , environmentExtraChunk = extraChunk , environmentMissingChunk = missingChunk , environmentLiftIO = liftIO diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Formatters/Monad.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Formatters/Monad.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Formatters/Monad.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Formatters/Monad.hs 2018-11-04 02:37:12.000000000 +0100 @@ -30,6 +30,7 @@ , withPendingColor , withFailColor +, useDiff , extraChunk , missingChunk @@ -97,6 +98,7 @@ | forall a. WithSuccessColor (FormatM a) (a -> next) | forall a. WithPendingColor (FormatM a) (a -> next) | forall a. WithInfoColor (FormatM a) (a -> next) + | UseDiff (Bool -> next) | ExtraChunk String next | MissingChunk String next | forall a. LiftIO (IO a) (a -> next) @@ -115,6 +117,7 @@ WithSuccessColor action next -> WithSuccessColor action (fmap f next) WithPendingColor action next -> WithPendingColor action (fmap f next) WithInfoColor action next -> WithInfoColor action (fmap f next) + UseDiff next -> UseDiff (fmap f next) ExtraChunk s next -> ExtraChunk s (f next) MissingChunk s next -> MissingChunk s (f next) LiftIO action next -> LiftIO action (fmap f next) @@ -137,6 +140,7 @@ , environmentWithSuccessColor :: forall a. m a -> m a , environmentWithPendingColor :: forall a. m a -> m a , environmentWithInfoColor :: forall a. m a -> m a +, environmentUseDiff :: m Bool , environmentExtraChunk :: String -> m () , environmentMissingChunk :: String -> m () , environmentLiftIO :: forall a. IO a -> m a @@ -161,6 +165,7 @@ WithSuccessColor inner next -> environmentWithSuccessColor (go inner) >>= go . next WithPendingColor inner next -> environmentWithPendingColor (go inner) >>= go . next WithInfoColor inner next -> environmentWithInfoColor (go inner) >>= go . next + UseDiff next -> environmentUseDiff >>= go . next ExtraChunk s next -> environmentExtraChunk s >> go next MissingChunk s next -> environmentMissingChunk s >> go next LiftIO inner next -> environmentLiftIO inner >>= go . next @@ -228,6 +233,10 @@ withInfoColor :: FormatM a -> FormatM a withInfoColor s = liftF (WithInfoColor s id) +-- | Return `True` if the user requested colorized diffs, `False` otherwise. +useDiff :: FormatM Bool +useDiff = liftF (UseDiff id) + -- | Output given chunk in red. extraChunk :: String -> FormatM () extraChunk s = liftF (ExtraChunk s ()) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Formatters.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Formatters.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Formatters.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Formatters.hs 2018-11-04 02:37:12.000000000 +0100 @@ -48,6 +48,7 @@ , withPendingColor , withFailColor +, useDiff , extraChunk , missingChunk @@ -94,6 +95,7 @@ , withPendingColor , withFailColor + , useDiff , extraChunk , missingChunk ) @@ -209,7 +211,11 @@ ExpectedButGot preface expected actual -> do mapM_ indent preface - let chunks = diff expected actual + b <- useDiff + let + chunks + | b = diff expected actual + | otherwise = [First expected, Second actual] withFailColor $ write (indentation ++ "expected: ") forM_ chunks $ \chunk -> case chunk of diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Runner.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Runner.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Runner.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Runner.hs 2018-11-04 02:37:12.000000000 +0100 @@ -47,24 +47,24 @@ -- | Filter specs by given predicate. -- -- The predicate takes a list of "describe" labels and a "requirement". -filterSpecs :: Config -> [SpecTree a] -> [SpecTree a] +filterSpecs :: Config -> [EvalTree] -> [EvalTree] filterSpecs c = go [] where p :: Path -> Bool p path = (fromMaybe (const True) (configFilterPredicate c) path) && not (fromMaybe (const False) (configSkipPredicate c) path) - go :: [String] -> [SpecTree a] -> [SpecTree a] + go :: [String] -> [EvalTree] -> [EvalTree] go groups = mapMaybe (goSpec groups) - goSpecs :: [String] -> [SpecTree a] -> ([SpecTree a] -> b) -> Maybe b + goSpecs :: [String] -> [EvalTree] -> ([EvalTree] -> b) -> Maybe b goSpecs groups specs ctor = case go groups specs of [] -> Nothing xs -> Just (ctor xs) - goSpec :: [String] -> SpecTree a -> Maybe (SpecTree a) + goSpec :: [String] -> EvalTree -> Maybe (EvalTree) goSpec groups spec = case spec of - Leaf item -> guard (p (groups, itemRequirement item)) >> return spec + Leaf item -> guard (p (groups, evalItemDescription item)) >> return spec Node group specs -> goSpecs (groups ++ [group]) specs (Node group) NodeWithCleanup action specs -> goSpecs groups specs (NodeWithCleanup action) @@ -159,7 +159,7 @@ let params = Params (configQuickCheckArgs config) (configSmallCheckDepth config) - filteredSpec <- map (toEvalTree params) . filterSpecs config . applyDryRun config <$> runSpecM spec + filteredSpec <- filterSpecs config . mapMaybe (toEvalTree params) . applyDryRun config <$> runSpecM (focus spec) (total, failures) <- withHiddenCursor useColor h $ do let @@ -181,13 +181,15 @@ dumpFailureReport config seed qcArgs failures return (Summary total (length failures)) -toEvalTree :: Params -> SpecTree () -> EvalTree +toEvalTree :: Params -> SpecTree () -> Maybe EvalTree toEvalTree params = go where + go :: Tree (() -> c) (Item ()) -> Maybe (Tree c EvalItem) go t = case t of - Node s xs -> Node s (map go xs) - NodeWithCleanup c xs -> NodeWithCleanup (c ()) (map go xs) - Leaf (Item requirement loc isParallelizable e) -> Leaf (EvalItem requirement loc (fromMaybe False isParallelizable) (e params $ ($ ()))) + Node s xs -> Just $ Node s (mapMaybe go xs) + NodeWithCleanup c xs -> Just $ NodeWithCleanup (c ()) (mapMaybe go xs) + Leaf (Item requirement loc isParallelizable isFocused e) -> + guard isFocused >> return (Leaf (EvalItem requirement loc (fromMaybe False isParallelizable) (e params $ ($ ())))) dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO () dumpFailureReport config seed qcArgs xs = do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Spec/Monad.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Spec/Monad.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Spec/Monad.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Spec/Monad.hs 2018-11-04 02:37:12.000000000 +0100 @@ -53,12 +53,7 @@ mapSpecTree f (SpecM specs) = SpecM (mapWriterT (fmap (second (map f))) specs) mapSpecItem :: (ActionWith a -> ActionWith b) -> (Item a -> Item b) -> SpecWith a -> SpecWith b -mapSpecItem g f = mapSpecTree go - where - go spec = case spec of - Node d xs -> Node d (map go xs) - NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs) - Leaf item -> Leaf (f item) +mapSpecItem g f = mapSpecTree (bimapTree g f) mapSpecItem_ :: (Item a -> Item a) -> SpecWith a -> SpecWith a mapSpecItem_ = mapSpecItem id diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Spec.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Spec.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Spec.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Spec.hs 2018-11-04 02:37:12.000000000 +0100 @@ -18,6 +18,13 @@ , xspecify , xdescribe , xcontext + +, focus +, fit +, fspecify +, fdescribe +, fcontext + , parallel , sequential @@ -92,6 +99,34 @@ xspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) xspecify = xit +-- | `focus` focuses all spec items of the given spec. +-- +-- Applying `focus` to a spec with focused spec items has no effect. +focus :: SpecWith a -> SpecWith a +focus spec = do + xs <- runIO (runSpecM spec) + let + ys + | any (any itemIsFocused) xs = xs + | otherwise = map (bimapTree id (\ item -> item {itemIsFocused = True})) xs + fromSpecList ys + +-- | @fit@ is an alias for @fmap focus . it@ +fit :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) +fit = fmap focus . it + +-- | @fspecify@ is an alias for `fit`. +fspecify :: (HasCallStack, Example a) => String -> a -> SpecWith (Arg a) +fspecify = fit + +-- | @fdescribe@ is an alias for @fmap focus . describe@ +fdescribe :: HasCallStack => String -> SpecWith a -> SpecWith a +fdescribe = fmap focus . describe + +-- | @fcontext@ is an alias for `fdescribe`. +fcontext :: HasCallStack => String -> SpecWith a -> SpecWith a +fcontext = fdescribe + -- | `parallel` marks all spec items of the given spec to be safe for parallel -- evaluation. parallel :: SpecWith a -> SpecWith a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/src/Test/Hspec/Core/Tree.hs new/hspec-core-2.6.0/src/Test/Hspec/Core/Tree.hs --- old/hspec-core-2.5.8/src/Test/Hspec/Core/Tree.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/src/Test/Hspec/Core/Tree.hs 2018-11-04 02:37:12.000000000 +0100 @@ -12,6 +12,7 @@ , Item (..) , specGroup , specItem +, bimapTree , location ) where @@ -28,12 +29,20 @@ Node String [Tree c a] | NodeWithCleanup c [Tree c a] | Leaf a - deriving (Functor, Foldable, Traversable) + deriving (Show, Eq, Functor, Foldable, Traversable) -- | A tree is used to represent a spec internally. The tree is parametrize -- over the type of cleanup actions and the type of the actual spec items. type SpecTree a = Tree (ActionWith a) (Item a) +bimapTree :: (a -> b) -> (c -> d) -> Tree a c -> Tree b d +bimapTree g f = go + where + go spec = case spec of + Node d xs -> Node d (map go xs) + NodeWithCleanup cleanup xs -> NodeWithCleanup (g cleanup) (map go xs) + Leaf item -> Leaf (f item) + -- | -- @Item@ is used to represent spec items internally. A spec item consists of: -- @@ -45,13 +54,20 @@ -- example, including QuickCheck properties, Hspec expectations and HUnit -- assertions. data Item a = Item { + -- | Textual description of behavior itemRequirement :: String + -- | Source location of the spec item , itemLocation :: Maybe Location + -- | A flag that indicates whether it is safe to evaluate this spec item in -- parallel with other spec items , itemIsParallelizable :: Maybe Bool + + -- | A flag that indicates whether this spec item is focused. +, itemIsFocused :: Bool + -- | Example for behavior , itemExample :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result } @@ -67,7 +83,7 @@ -- | The @specItem@ function creates a spec item. specItem :: (HasCallStack, Example a) => String -> a -> SpecTree (Arg a) -specItem s e = Leaf $ Item requirement location Nothing (safeEvaluateExample e) +specItem s e = Leaf $ Item requirement location Nothing False (safeEvaluateExample e) where requirement :: HasCallStack => String requirement diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/test/Test/Hspec/Core/Example/LocationSpec.hs new/hspec-core-2.6.0/test/Test/Hspec/Core/Example/LocationSpec.hs --- old/hspec-core-2.5.8/test/Test/Hspec/Core/Example/LocationSpec.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/test/Test/Hspec/Core/Example/LocationSpec.hs 2018-11-04 02:37:12.000000000 +0100 @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -fno-warn-missing-fields #-} module Test.Hspec.Core.Example.LocationSpec (spec) where import Helper @@ -8,6 +9,11 @@ import Test.Hspec.Core.Example import Test.Hspec.Core.Example.Location +data Person = Person { + name :: String +, age :: Int +} deriving (Eq, Show) + spec :: Spec spec = do describe "extractLocation" $ do @@ -46,14 +52,14 @@ extractLocation e `shouldBe` location context "with PatternMatchFail" $ do - context "with single-line source space" $ do + context "with single-line source span" $ do it "extracts Location" $ do let location = Just $ Location __FILE__ (__LINE__ + 1) 40 Left e <- try (evaluate (let Just n = Nothing in (n :: Int))) extractLocation e `shouldBe` location - context "with multi-line source space" $ do + context "with multi-line source span" $ do it "extracts Location" $ do let location = Just $ Location __FILE__ (__LINE__ + 1) 36 Left e <- try (evaluate (case Nothing of @@ -61,6 +67,13 @@ )) extractLocation e `shouldBe` location + context "with RecConError" $ do + it "extracts Location" $ do + let + location = Just $ Location __FILE__ (__LINE__ + 1) 39 + Left e <- try $ evaluate (age Person {name = "foo"}) + extractLocation e `shouldBe` location + describe "parseCallStack" $ do it "parses Location from call stack" $ do let input = unlines [ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/test/Test/Hspec/Core/FormattersSpec.hs new/hspec-core-2.6.0/test/Test/Hspec/Core/FormattersSpec.hs --- old/hspec-core-2.5.8/test/Test/Hspec/Core/FormattersSpec.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/test/Test/Hspec/Core/FormattersSpec.hs 2018-11-04 02:37:12.000000000 +0100 @@ -73,6 +73,7 @@ , environmentWithSuccessColor = \action -> let (a, r) = runWriter action in tell (colorize Succeeded r) >> return a , environmentWithPendingColor = \action -> let (a, r) = runWriter action in tell (colorize Pending r) >> return a , environmentWithInfoColor = \action -> let (a, r) = runWriter action in tell (colorize Info r) >> return a +, environmentUseDiff = return True , environmentExtraChunk = tell . return . Extra , environmentMissingChunk = tell . return . Missing , environmentLiftIO = undefined diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-core-2.5.8/test/Test/Hspec/Core/SpecSpec.hs new/hspec-core-2.6.0/test/Test/Hspec/Core/SpecSpec.hs --- old/hspec-core-2.5.8/test/Test/Hspec/Core/SpecSpec.hs 2018-09-30 20:45:10.000000000 +0200 +++ new/hspec-core-2.6.0/test/Test/Hspec/Core/SpecSpec.hs 2018-11-04 02:37:12.000000000 +0100 @@ -10,6 +10,9 @@ import qualified Test.Hspec.Core.Spec as H +ignoreCleanup :: Tree c a -> Tree () a +ignoreCleanup = H.bimapTree (const ()) id + runSpec :: H.Spec -> IO [String] runSpec = captureLines . H.hspecResult @@ -86,6 +89,22 @@ H.pendingWith "for some reason" r `shouldSatisfy` any (== " # PENDING: for some reason") + describe "focus" $ do + it "focuses spec items" $ do + items <- runSpecM $ H.focus $ do + H.it "is focused and will run" True + H.it "is also focused and will also run" True + map (ignoreCleanup . fmap itemIsFocused) items + `shouldBe` [Leaf True, Leaf True] + + context "when applied to a spec with focused spec items" $ do + it "has no effect" $ do + items <- runSpecM $ H.focus $ do + H.focus $ H.it "is focused and will run" True + H.it "is not focused and will not run" True + map (ignoreCleanup . fmap itemIsFocused) items + `shouldBe` [Leaf True, Leaf False] + describe "parallel" $ do it "marks examples for parallel execution" $ do [Leaf item] <- runSpecM . H.parallel $ H.it "whatever" H.pending