Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package hspec-discover for openSUSE:Factory checked in at 2021-08-25 20:57:38 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/hspec-discover (Old) and /work/SRC/openSUSE:Factory/.hspec-discover.new.1899 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "hspec-discover" Wed Aug 25 20:57:38 2021 rev:19 rq:912762 version:2.8.3 Changes: -------- --- /work/SRC/openSUSE:Factory/hspec-discover/hspec-discover.changes 2021-06-01 10:40:36.805134993 +0200 +++ /work/SRC/openSUSE:Factory/.hspec-discover.new.1899/hspec-discover.changes 2021-08-25 20:58:54.213106420 +0200 @@ -1,0 +2,6 @@ +Fri Aug 13 09:52:43 UTC 2021 - [email protected] + +- Update hspec-discover to version 2.8.3. + Upstream does not provide a change log file. + +------------------------------------------------------------------- Old: ---- hspec-discover-2.8.2.tar.gz New: ---- hspec-discover-2.8.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ hspec-discover.spec ++++++ --- /var/tmp/diff_new_pack.nD2joC/_old 2021-08-25 20:58:54.645105852 +0200 +++ /var/tmp/diff_new_pack.nD2joC/_new 2021-08-25 20:58:54.649105847 +0200 @@ -19,7 +19,7 @@ %global pkg_name hspec-discover %bcond_with tests Name: %{pkg_name} -Version: 2.8.2 +Version: 2.8.3 Release: 0 Summary: Automatically discover and run Hspec tests License: MIT @@ -34,6 +34,7 @@ %if %{with tests} BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-hspec-meta-devel +BuildRequires: ghc-mockery-devel %endif %description ++++++ hspec-discover-2.8.2.tar.gz -> hspec-discover-2.8.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-discover-2.8.2/hspec-discover.cabal new/hspec-discover-2.8.3/hspec-discover.cabal --- old/hspec-discover-2.8.2/hspec-discover.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-discover-2.8.3/hspec-discover.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: hspec-discover -version: 2.8.2 +version: 2.8.3 license: MIT license-file: LICENSE copyright: (c) 2012-2021 Simon Hengel @@ -22,10 +22,6 @@ <http://hspec.github.io/hspec-discover.html> extra-source-files: version.yaml - test-data/nested-spec/Foo/Bar/BazSpec.hs - test-data/nested-spec/Foo/BarSpec.hs - test-data/nested-spec/FooSpec.hs - test-data/empty-dir/Foo/Bar/Baz/.placeholder source-repository head type: git @@ -82,6 +78,7 @@ , filepath , hspec-discover , hspec-meta ==2.7.8 + , mockery build-tool-depends: hspec-meta:hspec-meta-discover default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-discover-2.8.2/src/Test/Hspec/Discover/Run.hs new/hspec-discover-2.8.3/src/Test/Hspec/Discover/Run.hs --- old/hspec-discover-2.8.2/src/Test/Hspec/Discover/Run.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-discover-2.8.3/src/Test/Hspec/Discover/Run.hs 2001-09-09 03:46:40.000000000 +0200 @@ -10,12 +10,13 @@ -- exported for testing , Spec(..) , importList -, fileToSpec -, findSpecs -, getFilesRecursive , driverWithFormatter , moduleNameFromId , pathToModule +, Tree(..) +, Forest(..) +, Hook(..) +, discover ) where import Control.Monad import Control.Applicative @@ -35,9 +36,8 @@ instance IsString ShowS where fromString = showString -data Spec = Spec { - specModule :: String -} deriving (Eq, Show) +data Spec = Spec String | Hook String [Spec] + deriving (Eq, Show) run :: [String] -> IO () run args_ = do @@ -57,7 +57,7 @@ hPutStrLn stderr (usage name) exitFailure -mkSpecModule :: FilePath -> Config -> [Spec] -> String +mkSpecModule :: FilePath -> Config -> Maybe [Spec] -> String mkSpecModule src conf nodes = ( "{-# LINE 1 " . shows src . " #-}\n" . showString "{-# LANGUAGE NoImplicitPrelude #-}\n" @@ -99,41 +99,57 @@ moduleNameFromId = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse -- | Generate imports for a list of specs. -importList :: [Spec] -> ShowS -importList = foldr (.) "" . map f +importList :: Maybe [Spec] -> ShowS +importList = foldr (.) "" . map f . maybe [] moduleNames where - f :: Spec -> ShowS - f spec = "import qualified " . showString (specModule spec) . "Spec\n" + f :: String -> ShowS + f spec = "import qualified " . showString spec . "\n" + +moduleNames :: [Spec] -> [String] +moduleNames = fromForest + where + fromForest :: [Spec] -> [String] + fromForest = concatMap fromTree + + fromTree :: Spec -> [String] + fromTree tree = case tree of + Spec name -> [name ++ "Spec"] + Hook name forest -> name : fromForest forest -- | Combine a list of strings with (>>). sequenceS :: [ShowS] -> ShowS sequenceS = foldr (.) "" . intersperse " >> " --- | Convert a list of specs to code. -formatSpecs :: [Spec] -> ShowS -formatSpecs xs - | null xs = "return ()" - | otherwise = sequenceS (map formatSpec xs) - --- | Convert a spec to code. -formatSpec :: Spec -> ShowS -formatSpec (Spec name) = "describe " . shows name . " " . showString name . "Spec.spec" - -findSpecs :: FilePath -> IO [Spec] -findSpecs src = do - let (dir, file) = splitFileName src - mapMaybe fileToSpec . filter (/= file) <$> getFilesRecursive dir - -fileToSpec :: FilePath -> Maybe Spec -fileToSpec file = case reverse $ splitDirectories file of - x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of - Just name | isValidModuleName name && all isValidModuleName xs -> - Just . Spec $ (intercalate "." . reverse) (name : xs) - _ -> Nothing - _ -> Nothing +formatSpecs :: Maybe [Spec] -> ShowS +formatSpecs specs = case specs of + Nothing -> "return ()" + Just xs -> fromForest xs where - stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] - stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str) + fromForest :: [Spec] -> ShowS + fromForest = sequenceS . map fromTree + + fromTree :: Spec -> ShowS + fromTree tree = case tree of + Spec name -> "describe " . shows name . " " . showString name . "Spec.spec" + Hook name forest -> "(" . showString name . ".hook $ " . fromForest forest . ")" + +findSpecs :: FilePath -> IO (Maybe [Spec]) +findSpecs = fmap (fmap toSpecs) . discover + +toSpecs :: Forest -> [Spec] +toSpecs = fromForest [] + where + fromForest :: [String] -> Forest -> [Spec] + fromForest names (Forest WithHook xs) = [Hook (mkModule ("SpecHook" : names)) $ concatMap (fromTree names) xs] + fromForest names (Forest WithoutHook xs) = concatMap (fromTree names) xs + + fromTree :: [String] -> Tree -> [Spec] + fromTree names spec = case spec of + Leaf name -> [Spec $ mkModule (name : names )] + Node name forest -> fromForest (name : names) forest + + mkModule :: [String] -> String + mkModule = intercalate "." . reverse -- See `Cabal.Distribution.ModuleName` (http://git.io/bj34) isValidModuleName :: String -> Bool @@ -143,13 +159,71 @@ isValidModuleChar :: Char -> Bool isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' -getFilesRecursive :: FilePath -> IO [FilePath] -getFilesRecursive baseDir = sortNaturally <$> go [] +data Tree = Leaf String | Node String Forest + deriving (Eq, Show) + +data Forest = Forest Hook [Tree] + deriving (Eq, Show) + +data Hook = WithHook | WithoutHook + deriving (Eq, Show) +sortKey :: Tree -> (String, Int) +sortKey tree = case tree of + Leaf name -> (name, 0) + Node name _ -> (name, 1) + +discover :: FilePath -> IO (Maybe Forest) +discover src = (>>= filterSrc) <$> specForest dir + where + filterSrc :: Forest -> Maybe Forest + filterSrc (Forest hook xs) = ensureForest hook $ maybe id (filter . (/=)) (toSpec file) xs + + (dir, file) = splitFileName src + +specForest :: FilePath -> IO (Maybe Forest) +specForest dir = do + files <- listDirectory dir + hook <- mkHook dir files + ensureForest hook . sortNaturallyBy sortKey . catMaybes <$> mapM toSpecTree files + where + toSpecTree :: FilePath -> IO (Maybe Tree) + toSpecTree name + | isValidModuleName name = do + doesDirectoryExist (dir </> name) `fallback` Nothing $ do + xs <- specForest (dir </> name) + return $ Node name <$> xs + | otherwise = do + doesFileExist (dir </> name) `fallback` Nothing $ do + return $ toSpec name + +mkHook :: FilePath -> [FilePath] -> IO Hook +mkHook dir files + | "SpecHook.hs" `elem` files = do + doesFileExist (dir </> "SpecHook.hs") `fallback` WithoutHook $ do + return WithHook + | otherwise = return WithoutHook + +fallback :: IO Bool -> a -> IO a -> IO a +fallback p def action = do + bool <- p + if bool then action else return def + +toSpec :: FilePath -> Maybe Tree +toSpec file = Leaf <$> (spec >>= ensure isValidModuleName) where - go :: FilePath -> IO [FilePath] - go dir = do - c <- map (dir </>) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir </> dir) - dirs <- filterM (doesDirectoryExist . (baseDir </>)) c >>= mapM go - files <- filterM (doesFileExist . (baseDir </>)) c - return (files ++ concat dirs) + spec :: Maybe String + spec = stripSuffix "Spec.hs" file <|> stripSuffix "Spec.lhs" file + + stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] + stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str) + +ensure :: (a -> Bool) -> a -> Maybe a +ensure p a = guard (p a) >> Just a + +ensureForest :: Hook -> [Tree] -> Maybe Forest +ensureForest hook = fmap (Forest hook) . ensure (not . null) + +listDirectory :: FilePath -> IO [FilePath] +listDirectory path = filter f <$> getDirectoryContents path + where f filename = filename /= "." && filename /= ".." diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-discover-2.8.2/src/Test/Hspec/Discover/Sort.hs new/hspec-discover-2.8.3/src/Test/Hspec/Discover/Sort.hs --- old/hspec-discover-2.8.2/src/Test/Hspec/Discover/Sort.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-discover-2.8.3/src/Test/Hspec/Discover/Sort.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,5 +1,8 @@ +-- | +-- /NOTE:/ This module is not meant for public consumption. For user +-- documentation look at http://hspec.github.io/hspec-discover.html. module Test.Hspec.Discover.Sort ( - sortNaturally + sortNaturallyBy , NaturalSortKey , naturalSortKey ) where @@ -9,8 +12,8 @@ import Data.List import Data.Ord -sortNaturally :: [String] -> [String] -sortNaturally = sortBy (comparing naturalSortKey) +sortNaturallyBy :: (a -> (String, Int)) -> [a] -> [a] +sortNaturallyBy f = sortBy (comparing ((\ (k, t) -> (naturalSortKey k, t)) . f)) data NaturalSortKey = NaturalSortKey [Chunk] deriving (Eq, Ord) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-discover-2.8.2/test/Test/Hspec/Discover/RunSpec.hs new/hspec-discover-2.8.3/test/Test/Hspec/Discover/RunSpec.hs --- old/hspec-discover-2.8.2/test/Test/Hspec/Discover/RunSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-discover-2.8.3/test/Test/Hspec/Discover/RunSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,54 +1,71 @@ -module Test.Hspec.Discover.RunSpec (main, spec) where +module Test.Hspec.Discover.RunSpec (spec) where import Helper - -import System.IO -import System.Directory -import System.FilePath -import Data.List (sort) +import Test.Mockery.Directory import Test.Hspec.Discover.Run hiding (Spec) import qualified Test.Hspec.Discover.Run as Run -main :: IO () -main = hspec spec - -withTempFile :: (FilePath -> IO a) -> IO a -withTempFile action = do - dir <- getTemporaryDirectory - (file, h) <- openTempFile dir "" - hClose h - action file <* removeFile file - - spec :: Spec spec = do - describe "run" $ do - it "generates test driver" $ withTempFile $ \f -> do - run ["test-data/nested-spec/Spec.hs", "", f] - readFile f `shouldReturn` unlines [ - "{-# LINE 1 \"test-data/nested-spec/Spec.hs\" #-}" + describe "run" $ around_ inTempDirectory $ do + it "generates a test driver" $ do + touch "test/FooSpec.hs" + touch "test/Foo/Bar/BazSpec.hs" + touch "test/Foo/BarSpec.hs" + run ["test/Spec.hs", "", "out"] + readFile "out" `shouldReturn` unlines [ + "{-# LINE 1 \"test/Spec.hs\" #-}" , "{-# LANGUAGE NoImplicitPrelude #-}" , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}" , "module Main where" - , "import qualified Foo.Bar.BazSpec" - , "import qualified Foo.BarSpec" , "import qualified FooSpec" + , "import qualified Foo.BarSpec" + , "import qualified Foo.Bar.BazSpec" , "import Test.Hspec.Discover" , "main :: IO ()" , "main = hspec spec" , "spec :: Spec" , "spec = " ++ unwords [ - "describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec" + "describe \"Foo\" FooSpec.spec" , ">> describe \"Foo.Bar\" Foo.BarSpec.spec" - , ">> describe \"Foo\" FooSpec.spec" + , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec" + ] + ] + + it "generates a test driver with hooks" $ do + touch "test/FooSpec.hs" + touch "test/Foo/Bar/BazSpec.hs" + touch "test/Foo/BarSpec.hs" + touch "test/Foo/SpecHook.hs" + touch "test/SpecHook.hs" + run ["test/Spec.hs", "", "out"] + readFile "out" `shouldReturn` unlines [ + "{-# LINE 1 \"test/Spec.hs\" #-}" + , "{-# LANGUAGE NoImplicitPrelude #-}" + , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}" + , "module Main where" + , "import qualified SpecHook" + , "import qualified FooSpec" + , "import qualified Foo.SpecHook" + , "import qualified Foo.BarSpec" + , "import qualified Foo.Bar.BazSpec" + , "import Test.Hspec.Discover" + , "main :: IO ()" + , "main = hspec spec" + , "spec :: Spec" + , "spec = " ++ unwords [ + "(SpecHook.hook $ describe \"Foo\" FooSpec.spec" + , ">> (Foo.SpecHook.hook $ describe \"Foo.Bar\" Foo.BarSpec.spec" + , ">> describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec))" ] ] - it "generates test driver for an empty directory" $ withTempFile $ \f -> do - run ["test-data/empty-dir/Spec.hs", "", f] - readFile f `shouldReturn` unlines [ - "{-# LINE 1 \"test-data/empty-dir/Spec.hs\" #-}" + it "generates a test driver for an empty directory" $ do + touch "test/Foo/Bar/Baz/.placeholder" + run ["test/Spec.hs", "", "out"] + readFile "out" `shouldReturn` unlines [ + "{-# LINE 1 \"test/Spec.hs\" #-}" , "{-# LANGUAGE NoImplicitPrelude #-}" , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}" , "module Main where" @@ -63,47 +80,6 @@ it "derives module name from a given path" $ do pathToModule "test/Spec.hs" `shouldBe` "Spec" - describe "getFilesRecursive" $ do - it "recursively returns all file entries of a given directory" $ do - getFilesRecursive "test-data" `shouldReturn` sort [ - "empty-dir/Foo/Bar/Baz/.placeholder" - , "nested-spec/Foo/Bar/BazSpec.hs" - , "nested-spec/Foo/BarSpec.hs" - , "nested-spec/FooSpec.hs" - ] - - describe "fileToSpec" $ do - it "converts path to spec name" $ do - fileToSpec "FooSpec.hs" `shouldBe` Just (Run.Spec "Foo") - - it "rejects spec with empty name" $ do - fileToSpec "Spec.hs" `shouldBe` Nothing - - it "works for lhs files" $ do - fileToSpec "FooSpec.lhs" `shouldBe` Just (Run.Spec "Foo") - - it "returns Nothing for invalid spec name" $ do - fileToSpec "foo" `shouldBe` Nothing - - context "when spec does not have a valid module name" $ do - it "returns Nothing" $ do - fileToSpec "flycheck_Spec.hs" `shouldBe` Nothing - - context "when any component of a hierarchical module name is not valid"$ do - it "returns Nothing" $ do - fileToSpec ("Valid" </> "invalid" </>"MiddleNamesSpec.hs") `shouldBe` Nothing - - context "when path has directory component" $ do - it "converts path to spec name" $ do - fileToSpec ("Foo" </> "Bar" </> "BazSpec.hs") `shouldBe` Just (Run.Spec "Foo.Bar.Baz") - - it "rejects spec with empty name" $ do - fileToSpec ("Foo" </> "Bar" </> "Spec.hs") `shouldBe` Nothing - - describe "findSpecs" $ do - it "finds specs" $ do - findSpecs ("test-data" </> "nested-spec" </> "Spec.hs") `shouldReturn` [Run.Spec "Foo.Bar.Baz", Run.Spec "Foo.Bar", Run.Spec "Foo"] - describe "driverWithFormatter" $ do it "generates a test driver that uses a custom formatter" $ do driverWithFormatter "Some.Module.formatter" "" `shouldBe` unlines [ @@ -118,7 +94,56 @@ describe "importList" $ do it "generates imports for a list of specs" $ do - importList [Run.Spec "Foo", Run.Spec "Bar"] "" `shouldBe` unlines [ + importList (Just [Run.Spec "Foo", Run.Spec "Bar"]) "" `shouldBe` unlines [ "import qualified FooSpec" , "import qualified BarSpec" ] + + describe "discover" $ do + it "discovers spec files" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/FooSpec.hs" + touch "test/BarSpec.hs" + discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Leaf "Bar", Leaf "Foo"]) + + it "discovers nested spec files" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/Foo/BarSpec.hs" + touch "test/Foo/BazSpec.hs" + discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Node "Foo" (Forest WithoutHook [Leaf "Bar", Leaf "Baz"])]) + + it "discovers hooks" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/FooSpec.hs" + touch "test/BarSpec.hs" + touch "test/SpecHook.hs" + discover "test/Spec.hs" `shouldReturn` Just (Forest WithHook [Leaf "Bar", Leaf "Foo"]) + + it "discovers nested hooks" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/Foo/BarSpec.hs" + touch "test/Foo/BazSpec.hs" + touch "test/Foo/SpecHook.hs" + discover "test/Spec.hs" `shouldReturn` Just (Forest WithoutHook [Node "Foo" (Forest WithHook [Leaf "Bar", Leaf "Baz"])]) + + it "ignores invalid module names" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/barSpec.hs" + discover "test/Spec.hs" `shouldReturn` Nothing + + it "ignores empty directories" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/Foo/.keep" + discover "test/Spec.hs" `shouldReturn` Nothing + + it "ignores directories with extension" $ do + inTempDirectory $ do + touch "test/Spec.hs" + touch "test/Foo.hs/BarSpec.hs" + discover "test/Spec.hs" `shouldReturn` Nothing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-discover-2.8.2/test/Test/Hspec/Discover/SortSpec.hs new/hspec-discover-2.8.3/test/Test/Hspec/Discover/SortSpec.hs --- old/hspec-discover-2.8.2/test/Test/Hspec/Discover/SortSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-discover-2.8.3/test/Test/Hspec/Discover/SortSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,16 +1,16 @@ -module Test.Hspec.Discover.SortSpec (main, spec) where +module Test.Hspec.Discover.SortSpec (spec) where import Helper import Test.QuickCheck import Test.Hspec.Discover.Sort -main :: IO () -main = hspec spec - shuffleAndSort :: [String] -> IO [String] shuffleAndSort xs = sortNaturally <$> generate (shuffle xs) +sortNaturally :: [String] -> [String] +sortNaturally = sortNaturallyBy $ \ name -> (name, 0) + spec :: Spec spec = do describe "naturalSortKey" $ do diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hspec-discover-2.8.2/version.yaml new/hspec-discover-2.8.3/version.yaml --- old/hspec-discover-2.8.2/version.yaml 2001-09-09 03:46:40.000000000 +0200 +++ new/hspec-discover-2.8.3/version.yaml 2001-09-09 03:46:40.000000000 +0200 @@ -1 +1 @@ -&version 2.8.2 +&version 2.8.3
